Import of Perl 5.003 into the tree. Makefile.bsd-wrapper and

config.sh.OpenBSD are the only local changes.

602 files changed, 200546 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/Artistic b/gnu/usr.bin/perl/Artistic
new file mode 100644
index 00000000000..11f4d82d972
--- /dev/null
+++ b/gnu/usr.bin/perl/Artistic
@@ -0,0 +1,131 @@
+
+
+
+
+			 The "Artistic License"
+
+				Preamble
+
+The intent of this document is to state the conditions under which a
+Package may be copied, such that the Copyright Holder maintains some
+semblance of artistic control over the development of the package,
+while giving the users of the package the right to use and distribute
+the Package in a more-or-less customary fashion, plus the right to make
+reasonable modifications.
+
+Definitions:
+
+	"Package" refers to the collection of files distributed by the
+	Copyright Holder, and derivatives of that collection of files
+	created through textual modification.
+
+	"Standard Version" refers to such a Package if it has not been
+	modified, or has been modified in accordance with the wishes
+	of the Copyright Holder as specified below.
+
+	"Copyright Holder" is whoever is named in the copyright or
+	copyrights for the package.
+
+	"You" is you, if you're thinking about copying or distributing
+	this Package.
+
+	"Reasonable copying fee" is whatever you can justify on the
+	basis of media cost, duplication charges, time of people involved,
+	and so on.  (You will not be required to justify it to the
+	Copyright Holder, but only to the computing community at large
+	as a market that must bear the fee.)
+
+	"Freely Available" means that no fee is charged for the item
+	itself, though there may be fees involved in handling the item.
+	It also means that recipients of the item may redistribute it
+	under the same conditions they received it.
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications
+derived from the Public Domain or from the Copyright Holder.  A Package
+modified in such a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided
+that you insert a prominent notice in each changed file stating how and
+when you changed that file, and provided that you do at least ONE of the
+following:
+
+    a) place your modifications in the Public Domain or otherwise make them
+    Freely Available, such as by posting said modifications to Usenet or
+    an equivalent medium, or placing the modifications on a major archive
+    site such as uunet.uu.net, or by allowing the Copyright Holder to include
+    your modifications in the Standard Version of the Package.
+
+    b) use the modified Package only within your corporation or organization.
+
+    c) rename any non-standard executables so the names do not conflict
+    with standard executables, which must also be provided, and provide
+    a separate manual page for each non-standard executable that clearly
+    documents how it differs from the Standard Version.
+
+    d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or
+executable form, provided that you do at least ONE of the following:
+
+    a) distribute a Standard Version of the executables and library files,
+    together with instructions (in the manual page or equivalent) on where
+    to get the Standard Version.
+
+    b) accompany the distribution with the machine-readable source of
+    the Package with your modifications.
+
+    c) give non-standard executables non-standard names, and clearly
+    document the differences in manual pages (or equivalent), together
+    with instructions on where to get the Standard Version.
+
+    d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package.  You may charge any fee you choose for support of this
+Package.  You may not charge a fee for this Package itself.  However,
+you may distribute this Package in aggregate with other (possibly
+commercial) programs as part of a larger (possibly commercial) software
+distribution provided that you do not advertise this Package as a
+product of your own.  You may embed this Package's interpreter within
+an executable of yours (by linking); this shall be construed as a mere
+form of aggregation, provided that the complete Standard Version of the
+interpreter is so embedded.
+
+6. The scripts and library files supplied as input to or produced as
+output from the programs of this Package do not automatically fall
+under the copyright of this Package, but belong to whomever generated
+them, and may be sold commercially, and may be aggregated with this
+Package.  If such scripts or library files are aggregated with this
+Package via the so-called "undump" or "unexec" methods of producing a
+binary executable image, then distribution of such an image shall
+neither be construed as a distribution of this Package nor shall it
+fall under the restrictions of Paragraphs 3 and 4, provided that you do
+not represent such an executable image as a Standard Version of this
+Package.
+
+7. C subroutines (or comparably compiled subroutines in other
+languages) supplied by you and linked into this Package in order to
+emulate subroutines and variables of the language defined by this
+Package shall not be considered part of this Package, but are the
+equivalent of input as in Paragraph 6, provided these subroutines do
+not change the language in any way that would cause it to fail the
+regression tests for the language.
+
+8. Aggregation of this Package with a commercial distribution is always
+permitted provided that the use of this Package is embedded; that is,
+when no overt attempt is made to make this Package's interfaces visible
+to the end user of the commercial distribution.  Such use shall not be
+construed as a distribution of this Package.
+
+9. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+				The End
diff --git a/gnu/usr.bin/perl/Changes b/gnu/usr.bin/perl/Changes
new file mode 100644
index 00000000000..64b93987701
--- /dev/null
+++ b/gnu/usr.bin/perl/Changes
@@ -0,0 +1,2882 @@
+-------------
+Version 5.002
+-------------
+
+The main enhancement to the Perl core was the addition of prototypes.
+Many of the modules that come with Perl have been extensively upgraded.
+
+Other than that, nearly all the changes for 5.002 were bug fixes of one
+variety or another, so here's the bug list, along with the "resolution"
+for each of them.  If you wish to correspond about any of them, please
+include the bug number (if any).
+
+Added APPLLIB_EXP for embedded perl library support.
+Files patched: perl.c
+
+Couldn't define autoloaded routine by assignment to typeglob.
+Files patched: pp_hot.c sv.c
+
+NETaa13525: Tiny patch to fix installman -n
+From: Larry Wall
+Files patched: installman
+
+NETaa13525: de-documented \v
+Files patched: pod/perlop.pod pod/perlre.pod
+
+NETaa13525: doc changes
+Files patched: pod/perlop.pod pod/perltrap.pod
+
+NETaa13525: perlxs update from Dean Roehrich
+Files patched: pod/perlxs.pod
+
+NETaa13525: rename powerunix to powerux
+Files patched: MANIFEST hints/powerux.sh
+
+NETaa13540: VMS uses CLK_TCK for HZ
+Files patched: pp_sys.c
+
+NETaa13721: pad_findlex core dumps on bad CvOUTSIDE()
+From: Carl Witty
+Files patched: op.c sv.c toke.c
+ Each CV has a reference to the CV containing it lexically.  Unfortunately,
+ it didn't reference-count this reference, so when the outer CV was freed,
+ we ended up with a pointer to memory that got reused later as some other kind
+ of SV.
+
+NETaa13721: warning suppression
+Files patched: toke.c
+ (same)
+
+NETaa13722: walk.c had inconsistent static declarations
+From: Tim Bunce
+Files patched: x2p/walk.c
+ Consolidated the various declarations and made them consistent with
+ the actual definitions.
+
+NETaa13724: -MPackage=args patch
+From: Tim Bunce
+Files patched: perl.c pod/perlrun.pod
+ Added in the -MPackage=args patch too.
+
+NETaa13729: order-of-evaluation dependency in scope.c on leaving REGCONTEXT
+From: "Jason Shirk"
+Files patched: scope.c
+ Did
+ 
+                 I32 delta = SSPOPINT;
+                 savestack_ix -= delta;  /* regexp must have croaked */
+ 
+ instead.
+
+NETaa13731: couldn't assign external lexical array to itself
+From: oneill@cs.sfu.ca
+Files patched: op.c
+ The pad_findmy routine was only checking previous statements for previous
+ mention of external lexicals, so the fact that the current statement
+ already mentioned @list was not noted.  It therefore allocated another
+ reference to the outside lexical, and this didn't compare equal when
+ the assigment parsing code was trying to determine whether there was a
+ common variable on either side of the equals.  Since it didn't see the
+ same variable, it thought it could avoid making copies of the values on
+ the stack during list assignment.  Unfortunately, before using those
+ values, the list assignment has to zero out the target array, which
+ destroys the values.
+ 
+ The fix was to make pad_findmy search the current statement as well.  This
+ was actually a holdover from some old code that was trying to delay
+ introduction of "my" variables until the next statement.  This is now
+ done with a different mechanism, so the fix should not adversely affect
+ that.
+
+NETaa13733: s/// doesn't free old string when using copy mode
+From: Larry Wall
+Files patched: pp_ctl.c pp_hot.c
+ When I removed the use of sv_replace(), I simply forgot to free the old char*.
+
+NETaa13736: closures leaked memory
+From: Carl Witty
+Files patched: op.c pp.c
+ This is a specific example of a more general bug, fixed as NETaa13760, having
+ to do with reference counts on comppads.
+
+NETaa13739: XSUB interface caches gimme in case XSUB clobbers it
+From: Dean Roehrich
+Files patched: pp_hot.c
+ Applied suggest patch.  Also deleted second gimme declaration as redundant.
+
+NETaa13760: comppad reference counts were inconsistent
+From: Larry Wall
+Files patched: op.c perl.c pp_ctl.c toke.c
+ All official references to comppads are supposed to be through compcv now,
+ but the transformation was not complete, resulting in memory leakage.
+
+NETaa13761: sv_2pv() wrongly preferred IV to NV when SV was readonly
+From: "Jack R. Lawler"
+Files patched: sv.c
+ Okay, I understand how this one happened.  This is a case where a
+ beneficial fix uncovered a bug elsewhere.  I changed the constant
+ folder to prefer integer results over double if the numbers are the
+ same.  In this case, they aren't, but it leaves the integer value there
+ anyway because the storage is already allocated for it, and it *might*
+ be used in an integer context.  And since it's producing a constant, it
+ sets READONLY.  Unfortunately, sv_2pv() bogusly preferred the integer
+ value to the double when READONLY was set.  This never showed up if you
+ just said
+ 
+     print 1.4142135623731;
+ 
+ because in that case, there was already a string value.
+ 
+
+NETaa13772: shmwrite core dumps consistently
+From: Gabe Schaffer
+Files patched: opcode.h opcode.pl
+ The shmwrite operator is a list operator but neglected to push a stack
+ mark beforehand, because an 'm' was missing from opcode.pl.
+
+NETaa13773: $. was misdocumented as read-only.
+From: Inaba Hiroto
+Files patched: pod/perlvar.pod
+     <1.array-element-read-only>
+     % perl -le '$,=", "; $#w=5; for (@w) { $_=1; } print @w' 
+     Modification of a read-only value attempted at -e line 1.
+     % perl4 -le '$,=", "; $#w=5; for (@w) { $_=1; } print @w'   
+     1, 1, 1, 1, 1, 1
+ 
+ This one may stay the way it is for performance reasons.
+ 
+     <2.begin-local-RS>
+     % cat abc
+     a
+     b
+     c
+     % perl -e 'BEGIN { local $/ = ""; } print "$.:$_" while <>;' abc
+     1:a
+     b
+     c
+     % perl -e '{ local $/ = ""; } print "$.:$_" while <>;' abc
+     1:a
+     2:b
+     3:c
+ 
+ $/ wasn't initialized early enough, so local set it back to permanently
+ undefined on exit from the block.
+ 
+     <3.grep-x0-bug>
+     % perl -le 'print grep(/^-/ ? ($x=$_) x 0 : 1, "a", "-b", "c");'
+     a
+ 
+     % perl4 -le 'print grep(/^-/ ? ($x=$_) x 0 : 1, "a", "-b", "c");'
+     ac
+ 
+ An extra mark was left on the stack if (('x') x $repeat) was used in a scalar
+ context.
+ 
+     <4.input-lineno-assign>
+     # perl -w does not complain about assignment to $. (Is this just a feature?)
+     # perlvar.pod says "This variable should be considered read-only."
+     % cat abc
+     a
+     b
+     c
+     % perl -wnle '$. = 10 if $. == 2; print "$.:$_"' abc
+     1:a
+     10:b
+     11:c
+ 
+ Fixed doc.
+ 
+     <5.local-soft-ref.bug>
+     % perl -e 'local ${"a"}=1;'
+     zsh: 529 segmentation fault  perl -e 'local ${"a"}=1;'
+ 
+ Now says
+     Can't localize a reference at -e line 1.
+ 
+     <6.package-readline>
+     % perl -e 'package foo; sub foo { 1; } package main; $_ = foo::foo(); print'
+     1
+     % perl -e '
+       package readline; sub foo { 1; } package main; $_ = readline::foo(); print'
+     Undefined subroutine &main::foo called at -e line 1.
+     % perl -e '
+       package readline; sub foo { 1; } package main; $_ = &readline::foo(); print'
+     1
+ 
+ Now treats foo::bar correctly even if foo is a keyword.
+ 
+     <7.page-head-set-to-null-string>
+     % cat page-head
+     #From: russell@ccu1.auckland.ac.nz (Russell Fulton)
+     #Newsgroups: comp.lang.perl
+     #Subject: This script causes Perl 5.00 to sementation fault
+     #Date: 15 Nov 1994 00:11:37 GMT
+     #Message-ID: <3a8ubp$jrj@net.auckland.ac.nz>
+ 
+     select((select(STDOUT),  $^='')[0]);  #this is the critical line
+     $a = 'a';
+     write ;
+     exit;
+ 
+     format STDOUT =
+     @<<<<<<
+     $a
+     .
+ 
+     % perl page-head
+     zsh: 1799 segmentation fault  perl /tmp/page-head
+ 
+ Now says
+     Undefined top format "main::" called at ./try line 11.
+ 
+     <8.sub-as-index>
+     # parser bug?
+     % perl -le 'sub foo {0}; $x[0]=0;$x[foo]<=0'
+     Unterminated <> operator at -e line 1.
+     % perl -le 'sub foo {0}; $x[0]=0;$x[foo()]<=0'
+ 
+ A right square bracket now forces expectation of an operator.
+ 
+     <9.unary-minus-to-regexp-var>
+     % cat minus-reg
+     #From: Michael Cook <mcook@cognex.com>
+     #Newsgroups: comp.lang.perl
+     #Subject: bug: print -$1
+     #Date: 01 Feb 1995 15:31:25 GMT
+     #Message-ID: <MCOOK.95Feb1103125@erawan.cognex.com>
+ 
+     $_ = "123";
+     /\d+/;
+     print $&, "\n";
+     print -$&, "\n";
+     print 0-$&, "\n";
+ 
+     % perl minus-reg
+     123
+     123
+     -123
+ 
+ Apparently already fixed in my copy.
+ 
+     <10.vec-segv>
+     % cat vec-bug
+     ## Offset values are changed for my machine.
+ 
+     #From: augustin@gdstech.grumman.com (Conrad Augustin)
+     #Subject: perl5 vec() bug?
+     #Message-ID: <1994Nov22.193728.25762@gdstech.grumman.com>
+     #Date: Tue, 22 Nov 1994 19:37:28 GMT
+ 
+     #The following two statements each produce a segmentation fault in perl5:
+ 
+     #vec($a, 21406, 32) = 1;  # seg fault
+     vec($a, 42813, 16) = 1;  # seg fault
+ 
+     #When the offset values are one less, all's well:
+     #vec($a, 21405, 32) = 1;  # ok
+     #vec($a, 42812, 16) = 1;  # ok
+ 
+     #Interestingly, this is ok for all high values of N:
+     #$N=1000000; vec($a, $N, 8) = 1;
+ 
+     % perl vec-bug
+     zsh: 1806 segmentation fault  perl vec-bug
+ 
+ Can't reproduce this one.
+ 
+
+NETaa13773: $/ not correctly localized in BEGIN
+Files patched: perl.c
+ (same)
+
+NETaa13773: foo::bar was misparsed if foo was a reserved word
+Files patched: toke.c toke.c
+ (same)
+
+NETaa13773: right square bracket didn't force expectation of operator
+Files patched: toke.c
+ (same)
+
+NETaa13773: scalar ((x) x $repeat) left stack mark
+Files patched: op.c
+ (same)
+
+NETaa13778: -w coredumps on <$>
+From: Hans Mulder
+Files patched: pp_hot.c toke.c
+ Now produces suggested error message.  Also installed guard in warning code
+ that coredumped.
+
+NETaa13779: foreach didn't use savestack mechanism
+From: Hans Mulder
+Files patched: cop.h pp_ctl.c
+ The foreach mechanism saved the old scalar value on the context stack
+ rather than the savestack.  It could consequently get out of sync if
+ unexpectedly unwound.
+
+NETaa13785: GIMME sometimes used wrong context frame
+From: Greg Earle
+Files patched: embed.h global.sym op.h pp_ctl.c proto.h
+ The expression inside the return was taking its context from the immediately
+ surrounding block rather than the innermost surrounding subroutine call.
+
+NETaa13797: could modify sv_undef through auto-vivification
+From: Ilya Zakharevich
+Files patched: pp.c
+ Inserted the missing check for readonly values on auto-vivification.
+
+NETaa13798: if (...) {print} treats print as quoted
+From: Larry Wall
+Files patched: toke.c
+ The trailing paren of the condition was setting expectations to XOPERATOR
+ rather than XBLOCK, so it was being treated like ${print}.
+
+NETaa13926: commonality was not detected in assignments using COND_EXPR
+From: Mark Hanson
+Files patched: opcode.h opcode.pl
+ The assignment compiler didn't check the 2nd and 3rd args of a ?:
+ for commonality.  It still doesn't, but I made ?: into a "dangerous"
+ operator so it is forced to treat it as common.
+
+NETaa13957: was marking the PUSHMARK as modifiable rather than the arg
+From: David Couture
+Files patched: op.c sv.c
+ It was marking the PUSHMARK as modifiable rather than the arg.
+
+NETaa13962: documentation of behavior of scalar <*> was unclear
+From: Tom Christiansen
+Files patched: pod/perlop.pod
+ Added the following to perlop:
+ 
+ A glob only evaluates its (embedded) argument when it is starting a new
+ list.  All values must be read before it will start over.  In a list
+ context this isn't important, because you automatically get them all
+ anyway.  In a scalar context, however, the operator returns the next value
+ each time it is called, or a FALSE value if you've just run out.  Again,
+ FALSE is returned only once.  So if you're expecting a single value from
+ a glob, it is much better to say
+ 
+     ($file) = <blurch*>;
+ 
+ than
+ 
+     $file = <blurch*>;
+ 
+ because the latter will alternate between returning a filename and
+ returning FALSE.
+ 
+
+NETaa13986: split ignored /m pattern modifier
+From: Winfried Koenig
+Files patched: pp.c
+ Fixed to work like m// and s///.
+
+NETaa13992: regexp comments not seen after + in non-extended regexp
+From: Mark Knutsen
+Files patched: regcomp.c
+ The code to skip regexp comments was guarded by a conditional that only
+ let it work when /x was in effect.
+
+NETaa14014: use subs should not count as definition, only as declaration
+From: Keith Thompson
+Files patched: sv.c
+ On *foo = \&bar, doesn't set GVf_IMPORTED if foo and bar are in same package.
+
+NETaa14021: sv_inc and sv_dec "upgraded" magical SV to non-magical
+From: Paul A Sand
+Also: Andreas Koenig
+Files patched: sv.c
+ The sv_inc() and sv_dec() routines "upgraded" null magical SVs to non-magical.
+
+NETaa14086: require should check tainting
+From: Karl Simon Berg
+Files patched: pp_ctl.c
+ Since we shouldn't allow tainted requires anyway, it now says:
+ 
+   Insecure dependency in require while running with -T switch at tst.pl line 1.
+
+NETaa14104: negation fails on magical variables like $1
+From: tim
+Files patched: pp.c
+ Negation was failing on magical values like $1.  It was testing the wrong
+ bits and also failed to provide a final "else" if none of the bits matched.
+
+NETaa14107: deep sort return leaked contexts
+From: Quentin Fennessy
+Files patched: pp_ctl.c
+ Needed to call dounwind() appropriately.
+
+NETaa14129: attempt to localize via a reference core dumps
+From: Michele Sardo
+Files patched: op.c pod/perldiag.pod
+ Now produces an error "Can't localize a reference", with explanation in
+ perldiag.
+
+NETaa14138: substr() and s/// can cause core dump
+From: Andrew Vignaux
+Files patched: pp_hot.c
+ Forgot to call SvOOK_off() on the SV before freeing its string.
+
+NETaa14145: ${@INC}[0] dumped core in debugger
+From: Hans Mulder
+Files patched: sv.c
+ Now croaks "Bizarre copy of ARRAY in block exit", which is better than
+ a core dump.  The fact that ${@INC}[0] means $INC[0] outside the debugger
+ is a different bug.
+
+NETaa14147: bitwise assignment ops wipe out byte of target string
+From: Jim Richardson
+Files patched: doop.c
+ The code was assuming that the target was not either of the two operands,
+ which is false for an assignment operator.
+
+NETaa14153: lexing of lexicals in patterns fooled by character class
+From: Dave Bianchi
+Files patched: toke.c
+ It never called the dwimmer, which is how it fooled it.
+
+NETaa14154: allowed autoloaded methods by recognizing sub method; declaration
+From: Larry Wall
+Files patched: gv.c
+ Made sub method declaration sufficient for autoloader to stop searching on.
+
+NETaa14156: shouldn't optimize block scope on tainting
+From: Pete Peterson
+Files patched: op.c toke.c
+ I totally disabled the block scope optimization when running tainted.
+
+NETaa14157: -T and -B only allowed 1/30 "odd" characters--changed to 1/3
+From: Tor Lillqvist
+Files patched: pp_sys.c
+ Applied suggested patch.
+
+NETaa14160: deref of null symbol should produce null list
+From: Jared Rhine
+Files patched: pp_hot.c
+ It didn't check for list context before returning undef.
+
+NETaa14162: POSIX::gensym now returns a symbol reference
+From: Josh N. Pritikin
+Also: Tim Bunce
+Files patched: ext/POSIX/POSIX.pm
+ Applied suggested patch.
+
+NETaa14164: POSIX autoloader now distinguishes non-constant "constants"
+From: Tim Bunce <Tim.Bunce@ig.co.uk>
+Files patched: ext/POSIX/POSIX.pm ext/POSIX/POSIX.xs
+ The .xs file now distinguishes non-constant "constants" by setting EAGAIN.
+ This will also let us use #ifdef within the .xs file to de-constantify
+ any other macros that happen not to be constants even if they don't use
+ an argument.
+
+NETaa14166: missing semicolon after "my" induces core dump
+From: Thomas Kofler
+Files patched: toke.c
+ The parser was left thinking it was still processing a "my", and flubbed.
+ I made it wipe out the "in_my" variable on a syntax error.
+
+NETaa14166: missing semicolon after "my" induces core dump"
+Files patched: toke.c
+ (same)
+
+NETaa14206: can now use English and strict at the same time
+From: Andrew Wilcox
+Files patched: sv.c
+ It now counts imported symbols as okay under "use strict".
+
+NETaa14206: can now use English and strict at the same time 
+Files patched: gv.c pod/perldiag.pod
+ (same)
+
+NETaa14265: elseif now produces severe warning
+From: Yutao Feng
+Files patched: pod/perldiag.pod toke.c
+ Now complains explicitly about "elseif".
+
+NETaa14279: list assignment propagated taintedness to independent scalars
+From: Tim Freeman
+Files patched: pp_hot.c
+ List assignment needed to be modified so that tainting didn't propagate
+ between independent scalar values.
+
+NETaa14312: undef in @EXPORTS core dumps
+From: William Setzer
+Files patched: lib/Exporter.pm
+ Now says:
+ 
+     Unable to create sub named "t::" at lib/Exporter.pm line 159.
+     Illegal null symbol in @t::EXPORT at -e line 1
+     BEGIN failed--compilation aborted at -e line 1.
+ 
+
+NETaa14312: undef in @EXPORTS core dumps     
+Files patched: pod/perldiag.pod sv.c
+ (same)
+
+NETaa14321: literal @array check shouldn't happen inside embedded expressions
+From: Mark H. Nodine
+Files patched: toke.c
+ The general solution to this is to disable the literal @array check within
+ any embedded expression.  For instance, this also failed bogusly:
+ 
+     print "$foo{@foo}";
+ 
+ The reason fixing this also fixes the s///e problem is that the lexer
+ effectively puts the RHS into a do {} block, making the expression
+ embedded within curlies, as far as the error message is concerned.
+
+NETaa14322: now localizes $! during POSIX::AUTOLOAD
+From: Larry Wall
+Files patched: ext/POSIX/POSIX.pm
+ Added local $! = 0.
+
+NETaa14324: defined() causes spurious sub existence
+From: "Andreas Koenig"
+Files patched: op.c pp.c
+ It called pp_rv2cv which wrongly assumed it could add any sub it referenced.
+
+NETaa14336: use Module () forces import of nothing
+From: Tim Bunce
+Files patched: op.c
+ use Module () now refrains from calling import at all.
+
+NETaa14353: added special HE allocator
+From: Larry Wall
+Files patched: global.sym
+
+NETaa14353: added special HE allocator 
+Files patched: hv.c perl.h
+
+NETaa14353: array extension now converts old memory to SV storage.
+Files patched: av.c av.h sv.c
+
+NETaa14353: hashes now convert old storage into SV arenas.
+Files patched: global.sym
+
+NETaa14353: hashes now convert old storage into SV arenas.  
+Files patched: hv.c perl.h
+
+NETaa14353: upgraded SV arena allocation
+Files patched: proto.h
+
+NETaa14353: upgraded SV arena allocation            
+Files patched: perl.c sv.c
+
+NETaa14422: added rudimentary prototypes
+From: Gisle Aas
+Files patched: Makefile.SH op.c op.c perly.c perly.c.diff perly.h perly.y proto.h sv.c toke.c
+ Message-Id: <9509290018.AA21548@scalpel.netlabs.com>
+ To: doughera@lafcol.lafayette.edu (Andy Dougherty)
+ Cc: perl5-porters@africa.nicoh.com
+ Subject: Re: Jumbo Configure patch vs. 1m. 
+ Date: Thu, 28 Sep 95 17:18:54 -0700
+ From: lwall@scalpel.netlabs.com (Larry Wall)
+ 
+ : No.  Larry's currently got the patch pumpkin for all such core perl topics.
+ 
+ I dunno whether you should let me have the patch pumpkin or not.  To fix
+ a Sev 2 I just hacked in rudimentary prototypes.  :-)
+ 
+ We can now define true unary subroutines, as well as argumentless
+ subroutines:
+ 
+     sub baz () { 12; }			# Must not have argument
+     sub bar ($) { $_[0] * 7 }		# Must have exactly one argument
+     sub foo ($@) { print "@_\n" }	# Must have at least one argument
+     foo bar baz / 2 || "oops", "is the answer";
+ 
+ This prints "42 is the answer" on my machine.  That is, it's the same as
+ 
+     foo( bar( baz() / 2) || "oops", "is the answer");
+ 
+ Attempting to compile
+ 
+     foo;
+ 
+ results in
+ 
+     Too few arguments for main::foo at ./try line 8, near "foo;"
+ 
+ Compiling
+ 
+     bar 1,2,3;
+ 
+ results in
+ 
+     Too many arguments for main::bar at ./try line 8, near "foo;"
+     
+ But
+ 
+     @array = ('a','b','c');
+     foo @array, @array;
+     
+ prints "3 a b c" because the $ puts the first arg of foo into scalar context.
+ 
+ The main win at this point is that we can say
+ 
+     sub AAA () { 1; }
+     sub BBB () { 2; }
+ 
+ and the user can say AAA + BBB and get 3.
+ 
+ I'm not quite sure how this interacts with autoloading though.  I fear
+ POSIX.pm will need to say
+ 
+     sub E2BIG ();
+     sub EACCES ();
+     sub EAGAIN ();
+     sub EBADF ();
+     sub EBUSY ();
+     ...
+     sub _SC_STREAM_MAX ();
+     sub _SC_TZNAME_MAX ();
+     sub _SC_VERSION ();
+ 
+ unless we can figure out how to efficiently declare a default prototype
+ at import time.  Meaning, not using eval.  Currently
+ 
+     *foo = \&bar;
+ 
+ (the ordinary import mechanism) implicitly stubs &bar with no prototype if
+ &bar is not yet declared.  It's almost like you want an AUTOPROTO to
+ go with your AUTOLOAD.
+ 
+ Another thing to rub one's 5 o'clock shadow over is that there's no way
+ to apply a prototype to a method call at compile time.
+ 
+ And no, I don't want to have the
+ 
+     sub howabout ($formal, @arguments) { ... }
+ 
+ argument right now.
+ 
+ Larry
+
+NETaa14422: couldn't take reference of a prototyped function
+Files patched: op.c
+ (same)
+
+NETaa14423: use didn't allow expressions involving the scratch pad
+From: Graham Barr
+Files patched: op.c perly.c perly.c.diff perly.y proto.h vms/perly_c.vms
+ Applied suggested patch.
+
+NETaa14444: lexical scalar didn't autovivify
+From: Gurusamy Sarathy
+Files patched: op.c pp_hot.c
+ It didn't have code in pp_padsv to do the right thing.
+
+NETaa14448: caller could dump core when used within an eval or require
+From: Danny R. Faught
+Files patched: pp_ctl.c
+ caller() was incorrectly assuming the context stack contained a subroutine
+ context when it in fact contained an eval context.
+
+NETaa14451: improved error message on bad pipe filehandle
+From: Danny R. Faught
+Files patched: pp_sys.c
+ Now says the slightly more informative
+ 
+     Can't use an undefined value as filehandle reference at ./try line 3.
+
+NETaa14462: pp_dbstate had a scope leakage on recursion suppression
+From: Tim Bunce
+Files patched: pp_ctl.c
+ Swapped the code in question around.
+
+NETaa14482: sv_unref freed ref prematurely at times
+From: Gurusamy Sarathy
+Files patched: sv.c
+ Made sv_unref() mortalize rather than free the old reference.
+
+NETaa14484: appending string to array produced bizarre results
+From: Greg Ward
+Also: Malcolm Beattie
+Files patched: pp_hot.c
+ Will now say, "Can't coerce ARRAY to string".
+
+NETaa14525: assignment to globs didn't reset them correctly
+From: Gurusamy Sarathy
+Files patched: sv.c
+ Applied parts of patch not overridden by subsequent patch.
+
+NETaa14529: a partially matching subpattern could spoof infinity detector
+From: Wayne Berke
+Files patched: regexec.c
+ A partial match on a subpattern could fool the infinite regress detector
+ into thinking progress had been made.
+ The previous workaround prevented another bug (NETaa14529) from being fixed,
+ so I've backed it out.  I'll need to think more about how to detect failure
+ to progress.  I'm still hopeful it's not equivalent to the halting problem.
+
+NETaa14535: patches from Gurusamy Sarathy
+From: Gurusamy Sarathy
+Files patched: op.c pp.c pp_hot.c regexec.c sv.c toke.c
+ Applied most recent suggested patches.
+
+NETaa14537: select() can return too soon
+From: Matt Kimball
+Also: Andreas Gustafsson
+Files patched: pp_sys.c
+
+NETaa14538: method calls were treated like do {} under loop modifiers
+From: Ilya Zakharevich
+Files patched: perly.c perly.y
+ Needed to take the OPf_SPECIAL flag off of entersubs from method reductions.
+ (It was probably a cut-and-paste error from long ago.)
+
+NETaa14540: foreach (@array) no longer does extra stack copy
+From: darrinm@lmc.com
+Files patched: Todo op.c pp_ctl.c pp_hot.c
+ Fixed by doing the foreach(@array) optimization, so it iterates
+ directly through the array, and can detect the implicit shift from
+ referencing <>.
+
+NETaa14541: new version of perlbug
+From: Kenneth Albanowski
+Files patched: README pod/perl.pod utils/perlbug.PL
+ Brought it up to version 1.09.
+
+NETaa14541: perlbug 1.11
+Files patched: utils/perlbug.PL
+ (same)
+
+NETaa14548: magic sets didn't check private OK bits
+From: W. Bradley Rubenstein
+Files patched: mg.c
+ The magic code was getting mixed up between private and public POK bits.
+
+NETaa14550: made ~ magic magical
+From: Tim Bunce
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa14551: humongous header causes infinite loop in format
+From: Grace Lee
+Files patched: pp_sys.c
+ Needed to check for page exhaustion after doing top-of-form.
+
+NETaa14558: attempt to call undefined top format core dumped
+From: Hallvard B Furuseth
+Files patched: pod/perldiag.pod pp_sys.c
+ Now issues an error on attempts to call a non-existent top format.
+
+NETaa14561: Gurusamy Sarathy's G_KEEPERR patch
+From: Andreas Koenig
+Also: Gurusamy Sarathy
+Also: Tim Bunce
+Files patched: cop.h interp.sym perl.c perl.h pp_ctl.c pp_sys.c sv.c toke.c
+ Applied latest patch.
+
+NETaa14581: shouldn't execute BEGIN when there are compilation errors
+From: Rickard Westman
+Files patched: op.c
+ Perl should not try to execute BEGIN and END blocks if there's been a
+ compilation error.
+
+NETaa14582: got SEGV sorting sparse array
+From: Rick Pluta
+Files patched: pp_ctl.c
+ Now weeds out undefined values much like Perl 4 did.
+ Now sorts undefined values to the front.
+
+NETaa14582: sort was letting unsortable values through to comparison routine
+Files patched: pp_ctl.c
+ (same)
+
+NETaa14585: globs in pad space weren't properly cleaned up
+From: Gurusamy Sarathy
+Files patched: op.c pp.c pp_hot.c sv.c
+ Applied suggested patch.
+
+NETaa14614: now does dbmopen with perl_eval_sv()
+From: The Man
+Files patched: perl.c pp_sys.c proto.h
+ dbmopen now invokes perl_eval_sv(), which should handle error conditions
+ better.
+
+NETaa14618: exists doesn't work in GDBM_File
+From: Andrew Wilcox
+Files patched: ext/GDBM_File/GDBM_File.xs
+ Applied suggested patch.
+
+NETaa14619: tied()
+From: Larry Wall
+Also: Paul Marquess
+Files patched: embed.h global.sym keywords.h keywords.pl opcode.h opcode.pl pp_sys.c toke.c
+ Applied suggested patch.
+
+NETaa14636: Jumbo Dynaloader patch
+From: Tim Bunce
+Files patched: ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c
+ Applied suggested patches.
+
+NETaa14637: checkcomma routine was stupid about bareword sub calls
+From: Tim Bunce <Tim.Bunce@ig.co.uk>
+Files patched: toke.c
+ The checkcomma routine was stupid about bareword sub calls.
+
+NETaa14639: (?i) didn't reset on runtime patterns
+From: Mark A. Scheel
+Files patched: op.h pp_ctl.c toke.c
+ It didn't distinguish between permanent flags outside the pattern and
+ temporary flags within the pattern.
+
+NETaa14649: selecting anonymous globs dumps core
+From: Chip Salzenberg
+Files patched: cop.h doio.c embed.h global.sym perl.c pp_sys.c proto.h
+ Applied suggested patch, but reversed the increment and decrement to avoid
+ decrementing and freeing what we're going to increment.
+
+NETaa14655: $? returned negative value on AIX
+From: Kim Frutiger
+Also: Stephen D. Lee
+Files patched: pp_sys.c
+ Applied suggested patch.
+
+NETaa14668: {2,} could match once
+From: Hugo van der Sanden
+Files patched: regexec.c
+ When an internal pattern failed a conjecture, it didn't back off on the
+ number of times it thought it had matched.
+
+NETaa14673: open $undefined dumped core
+From: Samuli K{rkk{inen
+Files patched: pp_sys.c
+ pp_open() didn't check its argument for globness.
+
+NETaa14683: stringifies were running pad out of space
+From: Robin Barker
+Files patched: op.h toke.c
+ Increased PADOFFSET to a U32, and made lexer not put double-quoted strings
+ inside OP_STRINGIFY unless they really needed it.
+
+NETaa14689: shouldn't have . in @INC when tainting
+From: William R. Somsky
+Files patched: perl.c
+ Now does not put . into @INC when tainting.  It may still be added with a 
+ 
+     use lib ".";
+ 
+ or, to put it at the end,
+ 
+     BEGIN { push(@INC, ".") }
+ 
+ but this is not recommended unless a chdir to a known location has been done
+ first.
+
+NETaa14690: values inside tainted SVs were ignored
+From: "James M. Stern"
+Files patched: pp.c pp_ctl.c
+ It was assuming that a tainted value was a string.
+
+NETaa14692: format name required qualification under use strict
+From: Tom Christiansen
+Files patched: gv.c
+ Now treats format names the same as subroutine names.
+
+NETaa14695: added simple regexp caching
+From: John Rowe
+Files patched: pp_ctl.c
+ Applied suggested patch.
+
+NETaa14697: regexp comments were sometimes wrongly treated as literal text
+From: Tom Christiansen
+Files patched: regcomp.c
+ The literal-character grabber didn't know about extended comments.
+ N.B. '#' is treated as a comment character whenever the /x option is
+ used now, so you can't include '#' as a simple literal in /x regexps.
+ 
+ (By the way, Tom, the boxed form of quoting in the previous enclosure is
+ exceeding antisocial when you want to extract the code from it.)
+
+NETaa14704: closure got wrong outer scope if outer sub was predeclared
+From: Marc Paquette
+Files patched: op.c
+ The outer scope of the anonymous sub was set to the stub rather than to
+ the actual subroutine.  I kludged it by making the outer scope of the
+ stub be the actual subroutine, if anything is depending on the stub.
+
+NETaa14705: $foo .= $foo did free memory read
+From: Gerd Knops
+Files patched: sv.c
+ Now modifies address to copy if it was reallocated.
+
+NETaa14709: Chip's FileHandle stuff
+From: Larry Wall
+Also: Chip Salzenberg
+Files patched: MANIFEST ext/FileHandle/FileHandle.pm ext/FileHandle/FileHandle.xs ext/FileHandle/Makefile.PL ext/POSIX/POSIX.pm ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs lib/FileCache.pm lib/Symbol.pm t/lib/filehand.t t/lib/posix.t
+ Applied suggested patches.
+
+NETaa14711: added (&) and (*) prototypes for blocks and symbols
+From: Kenneth Albanowski
+Files patched: Makefile.SH op.c perly.c perly.h perly.y toke.c
+ & now means that it must have an anonymous sub as that argument.  If
+ it's the first argument, the sub may be specified as a block in the
+ indirect object slot, much like grep or sort, which have prototypes of (&@).
+ 
+ Also added * so you can do things like
+ 
+     sub myopen (*;$);
+ 
+     myopen(FOO, $filename);
+
+NETaa14713: setuid FROM root now defaults to not do tainting
+From: Tony Camas
+Files patched: mg.c perl.c pp_hot.c
+ Applied suggested patch.
+
+NETaa14714: duplicate magics could be added to an SV
+From: Yary Hluchan
+Files patched: sv.c sv.c
+ The sv_magic() routine didn't properly check to see if it already had a
+ magic of that type.  Ordinarily it would have, but it was called during
+ mg_get(), which forces the magic flags off temporarily.
+
+NETaa14721: sub defined during erroneous do-FILE caused core dump
+From: David Campbell
+Files patched: op.c
+ Fixed the seg fault.  I couldn't reproduce the return problem.
+
+NETaa14734: ref should never return undef
+From: Dale Amon
+Files patched: pp.c t/op/overload.t
+ Now returns null string.
+
+NETaa14751: slice of undefs now returns null list
+From: Tim Bunce
+Files patched: pp.c pp_hot.c
+ Null list clobberation is now done in lslice, not aassign.
+
+NETaa14789: select coredumped on Linux
+From: Ulrich Kunitz
+Files patched: pp_sys.c
+ Applied suggested patches, more or less.
+
+NETaa14789: straightened out ins and out of duping
+Files patched: lib/IPC/Open3.pm
+ (same)
+
+NETaa14791: implemented internal SUPER class
+From: Nick Ing-Simmons
+Also: Dean Roehrich
+Files patched: gv.c
+ Applied suggested patch.
+
+NETaa14845: s/// didn't handle offset strings
+From: Ken MacLeod
+Files patched: pp_ctl.c
+ Needed a call to SvOOK_off(targ) in pp_substcont().
+
+NETaa14851: Use of << to mean <<"" is deprecated
+From: Larry Wall
+Files patched: toke.c
+
+NETaa14865: added HINT_BLOCK_SCOPE to "elsif"
+From: Jim Avera
+Files patched: perly.y
+ Needed to set HINT_BLOCK_SCOPE on "elsif" to prevent the do block from
+ being optimized away, which caused the statement transition in elsif
+ to reset the stack too far back.
+
+NETaa14876: couldn't delete localized GV safely
+From: John Hughes
+Files patched: pp.c scope.c
+ The reference count of the "borrowed" GV needed to be incremented while
+ there was a reference to it in the savestack.
+
+NETaa14887: couldn't negate magical scalars
+From: ian
+Also: Gurusamy Sarathy
+Files patched: pp.c
+ Applied suggested patch, more or less.  (It's not necessary to test both
+ SvNIOK and SvNIOKp, since the private bits are always set if the public
+ bits are set.)
+
+NETaa14893: /m modifier was sticky
+From: Jim Avera
+Files patched: pp_ctl.c
+ pp_match() and pp_subst() were using an improperly scoped SAVEINT to restore
+ the value of the internal variable multiline.
+
+NETaa14893: /m modifier was sticky     
+Files patched: cop.h pp_hot.c
+ (same)
+
+NETaa14916: complete.pl retained old return value
+From: Martyn Pearce
+Files patched: lib/complete.pl
+ Applied suggested patch.
+
+NETaa14928: non-const 3rd arg to split assigned to list could coredump
+From: Hans de Graaff
+Files patched: op.c
+ The optimizer was assuming the OP was an OP_CONST.
+
+NETaa14942: substr as lvalue could disable magic
+From: Darrell Kindred <dkindred+@cmu.edu>
+Files patched: pp.c
+ The substr was disabling the magic of $1.
+
+NETaa14990: "not" not parseable when expecting term
+From: "Randal L. Schwartz"
+Files patched: perly.c perly.c.diff perly.y vms/perly_c.vms
+ The NOTOP production needed to be moved down into the terms.
+
+NETaa14993: Bizarre copy of formline
+From: Tom Christiansen
+Also: Charles Bailey
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa14998: sv_add_arena() no longer leaks memory
+From: Andreas Koenig
+Files patched: av.c hv.c perl.h sv.c
+ Now keeps one potential arena "on tap", but doesn't use it unless there's
+ demand for SV headers.  When an AV or HV is extended, its old memory
+ becomes the next potential arena unless there already is one, in which
+ case it is simply freed.  This will have the desired property of not
+ stranding medium-sized chunks of memory when extending a single array
+ repeatedly, but will not degrade when there's no SV demand beyond keeping
+ one chunk of memory on tap, which generally will be about 250 bytes big,
+ since it prefers the earlier freed chunk over the later.  See the nice_chunk
+ variable.
+
+NETaa14999: $a and $b now protected from use strict and lexical declaration
+From: Tom Christiansen
+Files patched: gv.c pod/perldiag.pod toke.c
+ Bare $a and $b are now allowed during "use strict".  In addition,
+ the following diag was added:
+ 
+ =item Can't use "my %s" in sort comparison
+ 
+ (F) The global variables $a and $b are reserved for sort comparisons.
+ You mentioned $a or $b in the same line as the <=> or cmp operator,
+ and the variable had earlier been declared as a lexical variable.
+ Either qualify the sort variable with the package name, or rename the
+ lexical variable.
+ 
+
+NETaa15034: use strict refs should allow calls to prototyped functions
+From: Roderick Schertler
+Files patched: perly.c perly.c.diff perly.y toke.c vms/perly_c.vms
+ Applied patch suggested by Chip.
+
+NETaa15083: forced $AUTOLOAD to be untainted
+From: Tim Bunce
+Files patched: gv.c pp_hot.c
+ Stripped any taintmagic from $AUTOLOAD after setting it.
+
+NETaa15084: patch for Term::Cap
+From: Mark Kaehny
+Also: Hugo van der Sanden
+Files patched: lib/Term/Cap.pm
+ Applied suggested patch.
+
+NETaa15086: null pattern could cause coredump in s//_$1_/
+From: "Paul E. Maisano"
+Files patched: cop.h pp_ctl.c
+ If the replacement pattern was complicated enough to cause pp_substcont
+ to be called, then it lost track of which REGEXP* it was supposed to
+ be using.
+
+NETaa15087: t/io/pipe.t didn't work on AIX
+From: Andy Dougherty
+Files patched: t/io/pipe.t
+ Applied suggested patch.
+
+NETaa15088: study was busted
+From: Hugo van der Sanden
+Files patched: opcode.h opcode.pl pp.c
+ It was studying its scratch pad target rather than the argument supplied.
+
+NETaa15090: MSTATS patch
+From: Tim Bunce
+Files patched: global.sym malloc.c perl.c perl.h proto.h
+ Applied suggested patch.
+
+NETaa15098: longjmp out of magic leaks memory
+From: Chip Salzenberg
+Files patched: mg.c sv.c
+ Applied suggested patch.
+
+NETaa15102: getpgrp() is broken if getpgrp2() is available
+From: Roderick Schertler
+Files patched: perl.h pp_sys.c
+ Applied suggested patch.
+
+NETaa15103: prototypes leaked opcodes
+From: Chip Salzenberg
+Files patched: op.c
+ Applied suggested patch.
+
+NETaa15107: quotameta memory bug on all metacharacters
+From: Chip Salzenberg
+Files patched: pp.c
+ Applied suggested patch.
+
+NETaa15108: Fix for incomplete string leak
+From: Chip Salzenberg
+Files patched: toke.c
+ Applied suggested patch.
+
+NETaa15110: couldn't use $/ with 8th bit set on some architectures
+From: Chip Salzenberg
+Files patched: doop.c interp.sym mg.c op.c perl.c perl.h pp_ctl.c pp_hot.c pp_sys.c sv.c toke.c util.c
+ Applied suggested patches.
+
+NETaa15112: { a_1 => 2 } didn't parse as expected
+From: Stuart M. Weinstein
+Files patched: toke.c
+ The little dwimmer was only skipping ALPHA rather than ALNUM chars.
+
+NETaa15123: bitwise ops produce spurious warnings
+From: Hugo van der Sanden
+Also: Chip Salzenberg
+Also: Andreas Gustafsson
+Files patched: sv.c
+ Decided to suppress the warning in the conversion routines if merely converting
+ a temporary, which can never be a user-supplied value anyway.
+
+NETaa15129: #if defined (foo) misparsed in h2ph
+From: Roderick Schertler <roderick@gate.net>
+Files patched: utils/h2ph.PL
+ Applied suggested patch.
+
+NETaa15131: some POSIX functions assumed valid filehandles
+From: Chip Salzenberg
+Files patched: ext/POSIX/POSIX.xs
+ Applied suggested patch.
+
+NETaa15151: don't optimize split on OPpASSIGN_COMMON
+From: Huw Rogers
+Files patched: op.c
+ Had to swap the optimization down to after the assignment op is generated
+ and COMMON is calculated, and then clean up the resultant tree differently.
+
+NETaa15154: MakeMaker-5.18
+From: Andreas Koenig
+Files patched: MANIFEST lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mksymlists.pm
+ Brought it up to 5.18.
+
+NETaa15156: some Exporter tweaks
+From: Roderick Schertler
+Also: Tim Bunce
+Files patched: lib/Exporter.pm
+ Also did Tim's Tiny Trivial patch.
+
+NETaa15157: new version of Test::Harness
+From: Andreas Koenig
+Files patched: lib/Test/Harness.pm
+ Applied suggested patch.
+
+NETaa15175: overloaded nomethod has garbage 4th op
+From: Ilya Zakharevich
+Files patched: gv.c
+ Applied suggested patch.
+
+NETaa15179: SvPOK_only shouldn't back off on offset pointer
+From: Gutorm.Hogasen@oslo.teamco.telenor.no
+Files patched: sv.h
+ SvPOK_only() was calling SvOOK_off(), which adjusted the string pointer
+ after tr/// has already acquired it.  It shouldn't really be necessary
+ for SvPOK_only() to undo an offset string pointer, since there's no
+ conflict with a possible integer value where the offset is stored.
+
+NETaa15193: & now always bypasses prototype checking
+From: Larry Wall
+Files patched: dump.c op.c op.h perly.c perly.c.diff perly.y pod/perlsub.pod pp_hot.c proto.h toke.c vms/perly_c.vms vms/perly_h.vms
+ Turned out to be a big hairy deal because the lexer turns foo() into &foo().
+ But it works consistently now.  Also fixed pod.
+
+NETaa15197: 5.002b2 is 'appending' to $@
+From: Gurusamy Sarathy
+Files patched: pp_ctl.c
+ Applied suggested patch.
+
+NETaa15201: working around Linux DBL_DIG problems
+From: Kenneth Albanowski
+Files patched: hints/linux.sh sv.c
+ Applied suggested patch.
+
+NETaa15208: SelectSaver
+From: Chip Salzenberg
+Files patched: MANIFEST lib/SelectSaver.pm
+ Applied suggested patch.
+
+NETaa15209: DirHandle
+From: Chip Salzenberg
+Files patched: MANIFEST lib/DirHandle.pm t/lib/dirhand.t
+
+NETaa15210: sysopen()
+From: Chip Salzenberg
+Files patched: doio.c keywords.pl lib/ExtUtils/typemap opcode.pl pod/perlfunc.pod pp_hot.c pp_sys.c proto.h toke.c
+ Applied suggested patch.  Hope it works...
+
+NETaa15211: use mnemonic names in Safe setup
+From: Chip Salzenberg
+Files patched: ext/Safe/Safe.pm
+ Applied suggested patch, more or less.
+
+NETaa15214: prototype()
+From: Chip Salzenberg
+Files patched: ext/Safe/Safe.pm global.sym keywords.pl opcode.pl pp.c toke.c
+ Applied suggested patch.
+
+NETaa15217: -w problem with -d:foo
+From: Tim Bunce
+Files patched: perl.c
+ Applied suggested patch.
+
+NETaa15218: *GLOB{ELEMENT}
+From: Larry Wall
+Files patched: Makefile.SH embed.h ext/Safe/Safe.pm keywords.h opcode.h opcode.h opcode.pl perly.c perly.c.diff perly.y pp_hot.c t/lib/safe.t vms/perly_c.vms
+
+NETaa15219: Make *x=\*y do like *x=*y
+From: Chip Salzenberg
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa15221: Indigestion with Carp::longmess and big eval '...'s
+From: Tim Bunce
+Files patched: lib/Carp.pm
+ Applied suggested patch.
+
+NETaa15222: VERSION patch for standard extensions
+From: Paul Marquess
+Files patched: ext/DB_File/Makefile.PL ext/DynaLoader/DynaLoader.pm ext/DynaLoader/Makefile.PL ext/Fcntl/Fcntl.pm ext/Fcntl/Makefile.PL ext/GDBM_File/GDBM_File.pm ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/NDBM_File/NDBM_File.pm ext/ODBM_File/Makefile.PL ext/ODBM_File/ODBM_File.pm ext/POSIX/Makefile.PL ext/POSIX/POSIX.pm ext/SDBM_File/Makefile.PL ext/SDBM_File/SDBM_File.pm ext/Safe/Makefile.PL ext/Safe/Safe.pm ext/Socket/Makefile.PL
+ Applied suggested patch.
+
+NETaa15222: VERSION patch for standard extensions (reprise)
+Files patched: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm ext/POSIX/POSIX.pm ext/SDBM_File/SDBM_File.pm ext/Safe/Safe.pm ext/Socket/Socket.pm
+ (same)
+
+NETaa15227: $i < 10000 should optimize to integer op
+From: Larry Wall
+Files patched: op.c op.c
+ The program
+ 
+     for ($i = 0; $i < 100000; $i++) {
+ 	push @foo, $i;
+     }
+ 
+ takes about one quarter the memory if the optimizer decides that it can
+ use an integer < comparison rather than floating point.  It now does so
+ if one side is an integer constant and the other side a simple variable.
+ This should really help some of our benchmarks.  You can still force a
+ floating point comparison by using 100000.0 instead.
+
+NETaa15228: CPerl-mode patch
+From: Ilya Zakharevich
+Files patched: emacs/cperl-mode.el
+ Applied suggested patch.
+
+NETaa15231: Symbol::qualify()
+From: Chip Salzenberg
+Files patched: ext/FileHandle/FileHandle.pm gv.c lib/SelectSaver.pm lib/Symbol.pm pp_hot.c
+ Applied suggested patch.
+
+NETaa15236: select select broke under use strict
+From: Chip Salzenberg
+Files patched: op.c
+ Instead of inventing a new bit, I just turned off the HINT_STRICT_REFS bit.
+ I don't think it's worthwhile distinguishing between qualified or unqualified
+ names to select.
+
+NETaa15237: use vars
+From: Larry Wall
+Files patched: MANIFEST gv.c lib/subs.pm lib/vars.pm sv.c
+
+NETaa15240: keep op names _and_ descriptions
+From: Chip Salzenberg
+Files patched: doio.c embed.h ext/Safe/Safe.pm ext/Safe/Safe.xs global.sym op.c opcode.h opcode.pl scope.c sv.c
+ Applied suggested patch.
+
+NETaa15259: study doesn't unset on string modification
+From: Larry Wall
+Files patched: mg.c pp.c
+ Piggybacked on m//g unset magic to unset the study too.
+
+NETaa15276: pick a better initial cxstack_max
+From: Chip Salzenberg
+Files patched: perl.c
+ Added fudge in, and made it calculate how many it could fit into (most of) 8K,
+ to avoid getting 16K of Kingsley malloc.
+
+NETaa15287: numeric comparison optimization adjustments
+From: Clark Cooper
+Files patched: op.c
+ Applied patch suggested by Chip, with liberalization to >= and <=.
+
+NETaa15299: couldn't eval string containing pod or __DATA__     
+From: Andreas Koenig
+Also: Gisle Aas
+Files patched: toke.c
+ Basically, eval didn't know how to bypass pods correctly.
+
+NETaa15300: sv_backoff problems
+From: Paul Marquess
+Also: mtr
+Also: Chip Salzenberg
+Files patched: op.c sv.c sv.h
+ Applied suggested patch.
+
+NETaa15312: Avoid fclose(NULL)
+From: Chip Salzenberg
+Files patched: toke.c
+ Applied suggested patch.
+
+NETaa15318: didn't set up perl_init_i18nl14n for export
+From: Ilya Zakharevich
+Files patched: perl_exp.SH
+ Applied suggested patch.
+
+NETaa15331: File::Path::rmtree followed symlinks
+From: Andreas Koenig
+Files patched: lib/File/Path.pm
+ Added suggested patch, except I did
+ 
+        if (not -l $root and -d _) {
+ 
+ for efficiency, since if -d is true, the -l already called lstat on it.
+
+NETaa15339: sv_gets() didn't reset count
+From: alanburlison@unn.unisys.com
+Files patched: sv.c
+ Applied suggested patch.
+
+NETaa15341: differentiated importation of different types
+From: Chip Salzenberg
+Files patched: gv.c gv.h op.c perl.c pp.c pp_ctl.c sv.c sv.h toke.c
+ Applied suggested patch.
+
+NETaa15342: Consistent handling of e_{fp,tmpname}
+From: Chip Salzenberg
+Files patched: perl.c pp_ctl.c util.c
+ Applied suggested patch.
+
+NETaa15344: Safe gets confused about malloc on AIX
+From: Tim Bunce
+Files patched: ext/Safe/Safe.xs
+ Applied suggested patch.
+
+NETaa15348: -M upgrade
+From: Tim Bunce
+Files patched: perl.c pod/perlrun.pod
+ Applied suggested patch.
+
+NETaa15369: change in split optimization broke scalar context
+From: Ulrich Pfeifer
+Files patched: op.c
+ The earlier patch to make the split optimization pay attention to
+ OPpASSIGN_COMMON rearranged how the syntax tree is constructed, but kept
+ the wrong context flags.  This causes pp_split() do do the wrong thing.
+
+NETaa15423: can't do subversion numbering because of %5.3f assumptions
+From: Andy Dougherty
+Files patched: configpm patchlevel.h perl.c perl.h pp_ctl.c
+ Removed the %5.3f assumptions where appropriate.  patchlevel.h now
+ defines SUBVERSION, which if greater than 0 indicates a development version.
+
+NETaa15424: Sigsetjmp patch
+From: Kenneth Albanowski
+Files patched: Configure config_h.SH op.c perl.c perl.h pp_ctl.c util.c
+ Applied suggested patch.
+
+Needed to make install paths absolute.
+Files patched: installperl
+
+h2xs 1.14
+Files patched: utils/h2xs.PL
+
+makedir() looped on a symlink to a directory.
+Files patched: installperl
+
+xsubpp 1.932
+Files patched: lib/ExtUtils/xsubpp
+
+-------------
+Version 5.001
+-------------
+
+Nearly all the changes for 5.001 were bug fixes of one variety or another,
+so here's the bug list, along with the "resolution" for each of them.  If
+you wish to correspond about any of them, please include the bug number.
+
+There were a few that can be construed as enhancements:
+    NETaa13059: now warns of use of \1 where $1 is necessary.
+    NETaa13512: added $SIG{__WARN__} and $SIG{__DIE__} hooks
+    NETaa13520: added closures
+    NETaa13530: scalar keys now resets hash iterator
+    NETaa13641: added Tim's fancy new import whizbangers
+    NETaa13710: cryptswitch needed to be more "useable"
+    NETaa13716: Carp now allows multiple packages to be skipped out of
+    NETaa13716: now counts imported routines as "defined" for redef warnings
+    (and, of course, much of the stuff from the perl5-porters)
+
+NETaa12974: README incorrectly said it was a pre-release.
+Files patched: README
+
+NETaa13033: goto pushed a bogus scope on the context stack.
+From: Steve Vinoski
+Files patched: pp_ctl.c
+ The goto operator pushed an extra bogus scope onto the context stack.  (This
+ often didn't matter, since many things pop extra unrecognized scopes off.)
+
+NETaa13034: tried to get valid pointer from undef.
+From: Castor Fu
+Also:  Achille Hui, the Day Dreamer 
+Also: Eric Arnold
+Files patched: pp_sys.c
+ Now treats undef specially, and calls SvPV_force on any non-numeric scalar
+ value to get a real pointer to somewhere.
+
+NETaa13035: included package info with filehandles.
+From: Jack Shirazi - BIU
+Files patched: pp_hot.c pp_sys.c
+ Now passes a glob to filehandle methods to keep the package info intact.
+
+NETaa13048: didn't give strict vars message on every occurrence.
+From: Doug Campbell
+Files patched: gv.c
+ It now complains about every occurrence.  (The bug resulted from an
+ ill-conceived attempt to suppress a duplicate error message in a
+ suboptimal fashion.)
+
+NETaa13052: test for numeric sort sub return value fooled by taint magic.
+From: Peter Jaspers-Fayer
+Files patched: pp_ctl.c sv.h
+ The test to see if the sort sub return value was numeric looked at the
+ public flags rather than the private flags of the SV, so taint magic
+ hid that info from the sort.
+
+NETaa13053: forced a2p to use byacc
+From: Andy Dougherty
+Files patched: MANIFEST x2p/Makefile.SH x2p/a2p.c
+ a2p.c is now pre-byacced and shipped with the kit.
+
+NETaa13055: misnamed constant in previous patch.
+From: Conrad Augustin
+Files patched: op.c op.h toke.c
+ The tokener translates $[ to a constant, but with a special marking in case
+ the constant gets assigned to or localized.  Unfortunately, the marking
+ was done with a combination of OPf_SPECIAL and OPf_MOD that was easily
+ spoofed.  There is now a private OPpCONST_ARYLEN flag for this purpose.
+
+NETaa13055: use of OPf_SPECIAL for $[ lvaluehood was too fragile.
+Files patched: op.c op.h toke.c
+ (same)
+
+NETaa13056: convert needs to throw away any number info on its list.
+From: Jack Shirazi - BIU
+Files patched: op.c
+ The listiness of the argument list leaked out to the subroutine call because
+ of how prepend_elem and append_elem reuse an existing list.  The convert()
+ routine just needs to discard any listiness it finds on its argument.
+
+NETaa13058: AUTOLOAD shouldn't assume size of @_ is meaningful.
+From: Florent Guillaume
+Files patched: ext/DB_File/DB_File.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/Socket/Socket.pm h2xs.SH
+ I just deleted the optimization, which is silly anyway since the eventual
+ subroutine definition is cached.
+
+NETaa13059: now warns of use of \1 where $1 is necessary.
+From: Gustaf Neumann
+Files patched: toke.c
+ Now says
+ 
+     Can't use \1 to mean $1 in expression at foo line 2
+ 
+ along with an explanation in perldiag.
+
+NETaa13060: no longer warns on attempt to read <> operator's transition state.
+From: Chaim Frenkel
+Files patched: pp_hot.c
+ No longer warns on <> operator's transitional state.
+
+NETaa13140: warning said $ when @ would be more appropriate.
+From: David J. MacKenzie
+Files patched: op.c pod/perldiag.pod
+ Now says
+ 
+     (Did you mean $ or @ instead of %?)
+ 
+ and added more explanation to perldiag.
+
+NETaa13149: was reading freed memory to make incorrect error message.
+Files patched: pp_ctl.c
+ It was reading freed memory to make an error message that would be
+ incorrect in any event because it had the inner filename rather than
+ the outer.
+
+NETaa13149: confess was sometimes less informative than croak
+From: Jack Shirazi
+Files patched: lib/Carp.pm
+ (same)
+
+NETaa13150: stderr needs to be STDERR in package
+From: Jack Shirazi
+Files patched: lib/File/CheckTree.pm
+ Also fixed pl2pm to translate the filehandles to uppercase.
+
+NETaa13150: uppercases stdin, stdout and stderr
+Files patched: pl2pm
+ (same)
+
+NETaa13154: array assignment didn't notice package magic.
+From: Brian Reichert
+Files patched: pp_hot.c
+ The list assignment operator looked for only set magic, but set magic is
+ only on the elements of a magical hash, not on the hash as a whole.  I made
+ the operator look for any magic at all on the target array or hash.
+
+NETaa13155: &DB::DB left trash on the stack.
+From: Thomas Koenig
+Files patched: lib/perl5db.pl pp_ctl.c
+ The call by pp_dbstate() to &DB::DB left trash on the stack.  It now
+ calls DB in list context, and DB returns ().
+
+NETaa13156: lexical variables didn't show up in debugger evals.
+From: Joergen Haegg
+Files patched: op.c
+ The code that searched back up the context stack for the lexical scope
+ outside the eval only partially took into consideration that there
+ might be extra debugger subroutine frames that shouldn't be used, and
+ ended up comparing the wrong statement sequence number to the range of
+ valid sequence numbers for the scope of the lexical variable.  (There
+ was also a bug fixed in passing that caused the scope of lexical to go
+ clear to the end of the subroutine even if it was within an inner block.)
+
+NETaa13157: any request for autoloaded DESTROY should create a null one.
+From: Tom Christiansen
+Files patched: lib/AutoLoader.pm
+ If DESTROY.al is not located, it now creates sub DESTROY {} automatically.
+
+NETaa13158: now preserves $@ around destructors while leaving eval.
+From: Tim Bunce
+Files patched: pp_ctl.c
+ Applied supplied patch, except the whole second hunk can be replaced with
+ 
+     sv_insert(errsv, 0, 0, message, strlen(message));
+
+NETaa13160: clarified behavior of split without arguments
+From: Harry Edmon
+Files patched: pod/perlfunc.pod
+ Clarified the behavior of split without arguments.
+
+NETaa13162: eval {} lost list/scalar context
+From: Dov Grobgeld
+Files patched: op.c
+ LEAVETRY didn't propagate number to ENTERTRY.
+
+NETaa13163: clarified documentation of foreach using my variable
+From: Tom Christiansen
+Files patched: pod/perlsyn.pod
+ Explained that foreach using a lexical is still localized.
+
+NETaa13164: the dot detector for the end of formats was over-rambunctious.
+From: John Stoffel
+Files patched: toke.c
+ The dot detector for the end of formats was over-rambunctious.  It would
+ pick up any dot that didn't have a space in front of it.
+
+NETaa13165: do {} while 1 never linked outer block into next chain.
+From: Gisle Aas
+Files patched: op.c
+ When the conditional of do {} while 1; was optimized away, it confused the
+ postfix order construction so that the block that ordinarily sits around the
+ whole loop was never executed.  So when the loop tried to unstack between
+ iterations, it got the wrong context, and blew away the lexical variables
+ of the outer scope.  Fixed it by introducing a NULL opcode that will be
+ optimized away later.
+
+NETaa13167: coercion was looking at public bits rather than private bits.
+From: Randal L. Schwartz
+Also: Thomas Riechmann
+Also: Shane Castle
+Files patched: sv.c
+ There were some bad ifdefs around the various varieties of set*id().  In
+ addition, tainting was interacting badly with assignment to $> because
+ sv_2iv() was examining SvPOK rather than SvPOKp, and so couldn't coerce
+ a string uid to an integer one.
+
+NETaa13167: had some ifdefs wrong on set*id.
+Files patched: mg.c pp_hot.c
+ (same)
+
+NETaa13168: relaxed test for comparison of new and old fds
+From: Casper H.S. Dik
+Files patched: t/lib/posix.t
+ I relaxed the comparison to just check that the new fd is greater.
+
+NETaa13169: autoincrement can corrupt scalar value state.
+From: Gisle Aas
+Also: Tom Christiansen
+Files patched: sv.c
+ It assumed a PV didn't need to be upgraded to become an NV.
+
+NETaa13169: previous patch could leak a string pointer.
+Files patched: sv.c
+ (same)
+
+NETaa13170: symbols missing from global.sym
+From: Tim Bunce
+Files patched: global.sym
+ Applied suggested patch.
+
+NETaa13171: \\ in <<'END' shouldn't reduce to \.
+From: Randal L. Schwartz
+Files patched: toke.c
+ <<'END' needed to bypass ordinary single-quote processing.
+
+NETaa13172: 'use integer' turned off magical autoincrement.
+From: Erich Rickheit KSC
+Files patched: pp.c pp_hot.c
+ The integer versions of the increment and decrement operators were trying too
+ hard to be efficient.
+
+NETaa13172: deleted duplicate increment and decrement code
+Files patched: opcode.h opcode.pl pp.c
+ (same)
+
+NETaa13173: install should make shared libraries executable.
+From: Brian Grossman
+Also: Dave Nadler
+Also: Eero Pajarre
+Files patched: installperl
+ Now gives permission 555 to any file ending with extension specified by $dlext.
+
+NETaa13176: ck_rvconst didn't free the const it used up.
+From: Nick Duffek
+Files patched: op.c
+ I checked in many random memory leaks under this bug number, since it
+ was an eval that brought many of them out.
+
+NETaa13176: didn't delete XRV for temp ref of destructor.
+Files patched: sv.c
+ (same)
+
+NETaa13176: didn't delete op_pmshort in matching operators.
+Files patched: op.c
+ (same)
+
+NETaa13176: eval leaked the name of the eval.
+Files patched: scope.c
+ (same)
+
+NETaa13176: gp_free didn't free the format.
+Files patched: gv.c
+ (same)
+
+NETaa13176: minor leaks in loop exits and constant subscript optimization.
+Files patched: op.c
+ (same)
+
+NETaa13176: plugged some duplicate struct allocation memory leaks.
+Files patched: perl.c
+ (same)
+
+NETaa13176: sv_clear of an FM didn't clear anything.
+Files patched: sv.c
+ (same)
+
+NETaa13176: tr/// didn't mortalize its return value.
+Files patched: pp.c
+ (same)
+
+NETaa13177: SCOPE optimization hid line number info
+From: David J. MacKenzie
+Also: Hallvard B Furuseth
+Files patched: op.c
+ Every pass on the syntax tree has to keep track of the current statement.
+ Unfortunately, the single-statement block was optimized into a single
+ statement between the time the variable was parsed and the time the
+ void code scan was done, so that pass didn't see the OP_NEXTSTATE
+ operator, because it has been optimized to an OP_NULL.
+ 
+ Fortunately, null operands remember what they were, so it was pretty easy
+ to make it set the correct line number anyway.
+
+NETaa13178: some linux doesn't handle nm well
+From: Alan Modra
+Files patched: hints/linux.sh
+ Applied supplied patch.
+
+NETaa13180: localized slice now pre-extends array
+From: Larry Schuler
+Files patched: pp.c
+ A localized slice now pre-extends its array to avoid reallocation during
+ the scope of the local.
+
+NETaa13181: m//g didn't keep track of whether previous match matched null.
+From: "philippe.verdret"
+Files patched: mg.h pp_hot.c
+ A pattern isn't allowed to match a null string in the same place twice in
+ a row.  m//g wasn't keeping track of whether the previous match matched
+ the null string.
+
+NETaa13182: now includes whitespace as a regexp metacharacter.
+From: Larry Wall
+Files patched: toke.c
+ scan_const() now counts " \t\n\r\f\v" as metacharacters when scanning a pattern.
+
+NETaa13183: sv_setsv shouldn't try to clone an object.
+From: Peter Gordon
+Files patched: sv.c
+ The sv_mortalcopy() done by the return in STORE called sv_setsv(),
+ which cloned the object.  sv_setsv() shouldn't be in the business of
+ cloning objects.
+
+NETaa13184: bogus warning on quoted signal handler name removed.
+From: Dan Carson
+Files patched: toke.c
+ Now doesn't complain unless the first non-whitespace character after the =
+ is an alphabetic character.
+
+NETaa13186: now croaks on chop($')
+From: Casper H.S. Dik
+Files patched: doop.c
+ Now croaks on chop($') and such.
+
+NETaa13187: "${foo::bar}" now counts as mere delimitation, not as a bareword.
+From: Jay Rogers
+Files patched: toke.c
+ "${foo::bar}" now counts as mere delimitation, not as a bareword inside a
+ reference block.
+
+NETaa13188: for backward compatibility, looks for "perl -" before "perl".
+From: Russell Mosemann
+Files patched: toke.c
+ Now allows non-whitespace characters on the #! line between the "perl"
+ and the "-".
+
+NETaa13188: now allows non-whitespace after #!...perl before switches.
+Files patched: toke.c
+ (same)
+
+NETaa13189: derivative files need to be removed before recreation
+From: Simon Leinen
+Also: Dick Middleton
+Also: David J. MacKenzie
+Files patched: embed_h.sh x2p/Makefile.SH
+ Fixed various little nits as suggested in several messages.
+
+NETaa13190: certain assignments can spoof pod directive recognizer
+From: Ilya Zakharevich
+Files patched: toke.c
+ The lexer now only recognizes pod directives where a statement is expected.
+
+NETaa13194: now returns undef when there is no curpm.
+From: lusol@Dillon.CC.Lehigh.EDU
+Files patched: mg.c
+ Since there was no regexp prior to the "use", it was returning whatever the
+ last successful match was within the "use", because there was no current
+ regexp, so it treated it as a normal variable.  It now returns undef.
+
+NETaa13195: semop had one S too many.
+From: Joachim Huober
+Files patched: opcode.pl
+ The entry in opcode.pl had one too many S's.
+
+NETaa13196: always assumes it's a Perl script if -c is used.
+From: Dan Carson
+Files patched: toke.c
+ It now will assume it's a Perl script if the -c switch is used.
+
+NETaa13197: changed implicit -> message to be more understandable.
+From: Bruce Barnett
+Files patched: op.c pod/perldiag.pod
+ I changed the error message to be more understandable.  It now says
+ 
+     Can't use subscript on sort...
+ 
+
+NETaa13201: added OPpCONST_ENTERED flag to properly enter filehandle symbols.
+From: E. Jay Berkenbilt
+Also: Tom Christiansen
+Files patched: op.c op.h toke.c
+ The grammatical reduction of a print statement didn't properly count
+ the filehandle as a symbol reference because it couldn't distinguish
+ between a symbol entered earlier in the program and a symbol entered
+ for the first time down in the lexer.
+
+NETaa13203: README shouldn't mention uperl.o any more.
+From: Anno Siegel
+Files patched: README
+
+NETaa13204: .= shouldn't warn on uninitialized target.
+From: Pete Peterson
+Files patched: pp_hot.c
+ No longer warns on uninitialized target of .= operator.
+
+NETaa13206: handy macros in XSUB.h
+From: Tim Bunce
+Files patched: XSUB.h
+ Added suggested macros.
+
+NETaa13228: commonality checker didn't treat lexicals as variables.
+From: mcook@cognex.com
+Files patched: op.c opcode.pl
+ The list assignment operator tries to avoid unnecessary copies by doing the
+ assignment directly if there are no common variables on either side of the
+ equals.  Unfortunately, the code that decided that only recognized references
+ to dynamic variables, not lexical variables.
+
+NETaa13229: fixed sign stuff for complement, integer coercion.
+From: Larry Wall
+Files patched: perl.h pp.c sv.c
+ Fixed ~0 and integer coercions.
+
+NETaa13230: no longer tries to reuse scratchpad temps if tainting in effect.
+From: Luca Fini
+Files patched: op.c
+ I haven't reproduced it, but I believe the problem is the reuse of scratchpad
+ temporaries between statements.  I've made it not try to reuse them if
+ tainting is in effect.
+
+NETaa13231: *foo = *bar now prevents typo warnings on "foo"
+From: Robin Barker
+Files patched: sv.c
+ Aliasing of the form *foo = *bar is now protected from the typo warnings.
+ Previously only the *foo = \$bar form was.
+
+NETaa13235: require BAREWORD now introduces package name immediately.
+From: Larry Wall
+Files patched: toke.c
+ require BAREWORD now introduces package name immediately.  This lets the
+ method intuit code work right even though the require hasn't actually run
+ yet.
+
+NETaa13289: didn't calculate correctly using arybase.
+From: Jared Rhine
+Files patched: pp.c pp_hot.c
+ The runtime code didn't use curcop->cop_arybase correctly.
+
+NETaa13301: store now throws exception on error
+From: Barry Friedman
+Files patched: ext/GDBM_File/GDBM_File.xs ext/NDBM_File/NDBM_File.xs ext/ODBM_File/ODBM_File.xs ext/SDBM_File/SDBM_File.xs
+ Changed warn to croak in ext/*DBM_File/*.xs.
+
+NETaa13302: ctime now takes Time_t rather than Time_t*.
+From: Rodger Anderson
+Files patched: ext/POSIX/POSIX.xs
+ Now declares a Time_t and takes the address of that in CODE.
+
+NETaa13302: shorter way to do this patch
+Files patched: ext/POSIX/POSIX.xs
+ (same)
+
+NETaa13304: could feed too large $@ back into croak, whereupon it croaked.
+From: Larry Wall
+Files patched: perl.c
+ callist() could feed $@ back into croak with more than a bare %s.  (croak()
+ handles long strings with a bare %s okay.)
+
+NETaa13305: compiler misoptimized RHS to outside of s/a/print/e
+From: Brian S. Cashman <bsc@umich.edu>
+Files patched: op.c
+ The syntax tree was being misconstructed because the compiler felt that
+ the RHS was invariant, so it did it outside the s///.
+
+NETaa13314: assigning mortal to lexical leaks
+From: Larry Wall
+Files patched: sv.c
+ In stealing strings, sv_setsv was checking SvPOK to see if it should free
+ the destination string.  It should have been checking SvPVX.
+
+NETaa13316: wait4pid now recalled when errno == EINTR
+From: Robert J. Pankratz
+Files patched: pp_sys.c util.c
+ system() and the close() of a piped open now recall wait4pid if it returned
+ prematurely with errno == EINTR.
+
+NETaa13329: needed to localize taint magic
+From: Brian Katzung
+Files patched: sv.c doio.c mg.c pp_hot.c pp_sys.c scope.c taint.c
+ Taint magic is now localized better, though I had to resort to a kludge
+ to allow a value to be both tainted and untainted simultaneously during
+ the assignment of
+ 
+     local $foo = $_[0];
+ 
+ when $_[0] is a reference to the variable $foo already.
+
+NETaa13341: clarified interaction of AnyDBM_File::ISA and "use"
+From: Ian Phillipps
+Files patched: pod/modpods/AnyDBMFile.pod
+ The doc was misleading.
+
+NETaa13342: grep and map with block would enter block but never leave it.
+From: Ian Phillipps
+Files patched: op.c
+ The compiler use some sort-checking code to handle the arguments of
+ grep and map.  Unfortunately, this wiped out the block exit opcode while
+ leaving the block entry opcode.  This doesn't matter to sort, but did
+ matter to grep and map.  It now leave the block entry intact.
+ 
+ The reason it worked without the my is because the block entry and exit
+ were optimized away to an OP_SCOPE, which it doesn't matter if it's there
+ or not.
+
+NETaa13343: goto needed to longjmp when in a signal handler.
+From: Robert Partington
+Files patched: pp_ctl.c
+ goto needed to longjmp() when in a signal handler to get back into the
+ right run() context.
+ 
+
+NETaa13344: strict vars shouldn't apply to globs or filehandles.
+From: Andrew Wilcox
+Files patched: gv.c
+ Filehandles and globs will be excepted from "strict vars", so that you can
+ do the standard Perl 4 trick of
+ 
+     use strict;
+     sub foo {
+         local(*IN);
+         open(IN,"file");
+     }
+ 
+
+NETaa13345: assert.pl didn't use package DB
+From: Hans Mulder
+Files patched: lib/assert.pl
+ Now it does.
+
+NETaa13348: av_undef didn't free scalar representing $#foo.
+From: David Filo
+Files patched: av.c
+ av_undef didn't free scalar representing $#foo.
+
+NETaa13349: sort sub accumulated save stack entries
+From: David Filo
+Files patched: pp_ctl.c
+ COMMON only gets set if assigning to @_, which is reasonable.  Most of the
+ problem was a memory leak.
+
+NETaa13351: didn't treat indirect filehandles as references.
+From: Andy Dougherty
+Files patched: op.c
+ Now produces
+ 
+ Can't use an undefined value as a symbol reference at ./foo line 3.
+ 
+
+NETaa13352: OP_SCOPE allocated as UNOP rather than LISTOP.
+From: Andy Dougherty
+Files patched: op.c
+
+NETaa13353: scope() didn't release filegv on OP_SCOPE optimization.
+From: Larry Wall
+Files patched: op.c
+ When scope() nulled out a NEXTSTATE, it didn't release its filegv reference.
+
+NETaa13355: hv_delete now avoids useless mortalcopy
+From: Larry Wall
+Files patched: hv.c op.c pp.c pp_ctl.c proto.h scope.c util.c
+ hv_delete now avoids useless mortalcopy.
+ 
+
+NETaa13359: comma operator section missing its heading
+From: Larry Wall
+Files patched: pod/perlop.pod
+
+NETaa13359: random typo
+Files patched: pod/perldiag.pod
+
+NETaa13360: code to handle partial vec values was bogus.
+From: Conrad Augustin
+Files patched: pp.c
+ The code that Mark J. added a long time ago to handle values that were partially
+ off the end of the string was incorrect.
+
+NETaa13361: made it not interpolate inside regexp comments
+From: Martin Jost
+Files patched: toke.c
+ To avoid surprising people, it no longer interpolates inside regexp
+ comments.
+
+NETaa13362: ${q[1]} should be interpreted like it used to
+From: Hans Mulder
+Files patched: toke.c
+ Now resolves ${keyword[1]} to $keyword[1] and warns if -w.  Likewise for {}.
+
+NETaa13363: meaning of repeated search chars undocumented in tr///
+From: Stephen P. Potter
+Files patched: pod/perlop.pod
+ Documented that repeated characters use the first translation given.
+
+NETaa13365: if closedir fails, don't try it again.
+From: Frank Crawford
+Files patched: pp_sys.c
+ Now does not attempt to closedir a second time.
+
+NETaa13366: can't do block scope optimization on $1 et al when tainting.
+From: Andrew Vignaux
+Files patched: toke.c
+ The tainting mechanism assumes that every statement starts out
+ untainted.  Unfortunately, the scope removal optimization for very
+ short blocks removed the statementhood of statements that were
+ attempting to read $1 as an untainted value, with the effect that $1
+ appeared to be tainted anyway.  The optimization is now disabled when
+ tainting and the block contains $1 (or equivalent).
+
+NETaa13366: fixed this a better way in toke.c.
+Files patched: op.c
+ (same)
+
+NETaa13366: need to disable scope optimization when tainting.
+Files patched: op.c
+ (same)
+
+NETaa13367: Did a SvCUR_set without nulling out final char.
+From: "Rob Henderson" <robh@cs.indiana.edu>
+Files patched: doop.c pp.c pp_sys.c
+ When do_vop set the length on its result string it neglected to null-terminate
+ it.
+
+NETaa13368: bigrat::norm sometimes chucked sign
+From: Greg Kuperberg
+Files patched: lib/bigrat.pl
+ The normalization routine was assuming that the gcd of two numbers was
+ never negative, and based on that assumption managed to move the sign
+ to the denominator, where it was deleted on the assumption that the
+ denominator is always positive.
+
+NETaa13368: botched previous patch
+Files patched: lib/bigrat.pl
+ (same)
+
+NETaa13369: # is now a comment character, and \# should be left for regcomp.
+From: Simon Parsons
+Files patched: toke.c
+ It was not skipping the comment when it skipped the white space, and constructed
+ an opcode that tried to match a null string.  Unfortunately, the previous
+ star tried to use the first character of the null string to optimize where
+ to recurse, so it never matched.
+
+NETaa13369: comment after regexp quantifier induced non-match.
+Files patched: regcomp.c
+ (same)
+
+NETaa13370: some code assumed SvCUR was of type int.
+From: Spider Boardman
+Files patched: pp_sys.c
+ Did something similar to the proposed patch.  I also fixed the problem that
+ it assumed the type of SvCUR was int.  And fixed get{peer,sock}name the
+ same way.
+
+NETaa13375: sometimes dontbother wasn't added back into strend.
+From: Jamshid Afshar
+Files patched: regexec.c
+ When the /g modifier was used, the regular expression code would calculate
+ the end of $' too short by the minimum number of characters the pattern could
+ match.
+
+NETaa13375: sv_setpvn now disallows negative length.
+Files patched: sv.c
+ (same)
+
+NETaa13376: suspected indirect objecthood prevented recognition of lexical.
+From: Gisle.Aas@nr.no
+Files patched: toke.c
+ When $data[0] is used in a spot that might be an indirect object, the lexer
+ was getting confused over the rule that says the $data in $$data[0] isn't
+ an array element.  (The lexer uses XREF state for both indirect objects
+ and for variables used as names.)
+
+NETaa13377: -I processesing ate remainder of #! line.
+From: Darrell Schiebel
+Files patched: perl.c
+ I made the -I processing in moreswitches look for the end of the string,
+ delimited by whitespace.
+
+NETaa13379: ${foo} now treated the same outside quotes as inside
+From: Hans Mulder
+Files patched: toke.c
+ ${bareword} is now treated the same outside quotes as inside.
+
+NETaa13379: previous fix for this bug was botched
+Files patched: toke.c
+ (same)
+
+NETaa13381: TEST should check for perl link
+From: Andy Dougherty
+Files patched: t/TEST
+ die "You need to run \"make test\" first to set things up.\n" unless -e 'perl';
+ 
+
+NETaa13384: fixed version 0.000 botch.
+From: Larry Wall
+Files patched: installperl
+
+NETaa13385: return 0 from required file loses message
+From: Malcolm Beattie
+Files patched: pp_ctl.c
+ Works right now.
+
+NETaa13387: added pod2latex
+From: Taro KAWAGISHI
+Files patched: MANIFEST pod/pod2latex
+ Added most recent copy to pod directory.
+
+NETaa13388: constant folding now prefers integer results over double
+From: Ilya Zakharevich
+Files patched: op.c
+ Constant folding now prefers integer results over double.
+
+NETaa13389: now treats . and exec as shell metathingies
+From: Hans Mulder
+Files patched: doio.c
+ Now treats . and exec as shell metathingies.
+
+NETaa13395: eval didn't check taintedness.
+From: Larry Wall
+Files patched: pp_ctl.c
+
+NETaa13396: $^ coredumps at end of string
+From: Paul Rogers
+Files patched: toke.c
+ The scan_ident() didn't check for a null following $^.
+
+NETaa13397: improved error messages when operator expected
+From: Larry Wall
+Files patched: toke.c
+ Added message (Do you need to predeclare BAR?).  Also fixed the missing
+ semicolon message.
+
+NETaa13399: cleanup by Andy
+From: Larry Wall
+Files patched: Changes Configure Makefile.SH README cflags.SH config.H config_h.SH deb.c doop.c dump.c ext/DB_File/DB_File.pm ext/DB_File/DB_File.xs ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/POSIX/POSIX.pm ext/SDBM_File/sdbm/sdbm.h ext/Socket/Socket.pm ext/util/make_ext h2xs.SH hints/aix.sh hints/bsd386.sh hints/dec_osf.sh hints/esix4.sh hints/freebsd.sh hints/irix_5.sh hints/next_3_2.sh hints/sunos_4_1.sh hints/svr4.sh hints/ultrix_4.sh installperl lib/AutoSplit.pm lib/Cwd.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/Term/Cap.pm mg.c miniperlmain.c perl.c perl.h perl_exp.SH pod/Makefile pod/perldiag.pod pod/pod2html pp.c pp_ctl.c pp_hot.c pp_sys.c proto.h sv.h t/re_tests util.c x2p/Makefile.SH x2p/a2p.h x2p/a2py.c x2p/handy.h x2p/hash.c x2p/hash.h x2p/str.c x2p/str.h x2p/util.c x2p/util.h x2p/walk.c
+
+NETaa13399: cleanup from Andy
+Files patched: MANIFEST
+
+NETaa13399: configuration cleanup
+Files patched: Configure Configure MANIFEST MANIFEST Makefile.SH Makefile.SH README config.H config.H config_h.SH config_h.SH configpm ext/DynaLoader/DynaLoader.pm ext/DynaLoader/dl_hpux.xs ext/NDBM_File/Makefile.PL ext/ODBM_File/Makefile.PL ext/util/make_ext handy.h hints/aix.sh hints/hpux_9.sh hints/hpux_9.sh hints/irix_4.sh hints/linux.sh hints/mpeix.sh hints/next_3_2.sh hints/solaris_2.sh hints/svr4.sh installperl installperl lib/AutoSplit.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/Getopt/Long.pm lib/Text/Tabs.pm makedepend.SH makedepend.SH mg.c op.c perl.h perl_exp.SH pod/perl.pod pod/perldiag.pod pod/perlsyn.pod pod/pod2man pp_sys.c proto.h proto.h unixish.h util.c util.c vms/config.vms writemain.SH x2p/a2p.h x2p/a2p.h x2p/a2py.c x2p/a2py.c x2p/handy.h x2p/util.c x2p/walk.c x2p/walk.c
+
+NETaa13399: new files from Andy
+Files patched: ext/DB_File/Makefile.PL ext/DynaLoader/Makefile.PL ext/Fcntl/Makefile.PL ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/ODBM_File/Makefile.PL ext/POSIX/Makefile.PL ext/SDBM_File/Makefile.PL ext/SDBM_File/sdbm/Makefile.PL ext/Socket/Makefile.PL globals.c hints/convexos.sh hints/irix_6.sh
+
+NETaa13399: patch0l from Andy
+Files patched: Configure MANIFEST Makefile.SH config.H config_h.SH ext/DB_File/Makefile.PL ext/GDBM_File/Makefile.PL ext/NDBM_File/Makefile.PL ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/Makefile.PL ext/util/make_ext h2xs.SH hints/next_3_2.sh hints/solaris_2.sh hints/unicos.sh installperl lib/Cwd.pm lib/ExtUtils/MakeMaker.pm makeaperl.SH vms/config.vms x2p/util.c x2p/util.h
+
+NETaa13399: stuff from Andy
+Files patched: Configure MANIFEST Makefile.SH configpm hints/dec_osf.sh hints/linux.sh hints/machten.sh lib/ExtUtils/MakeMaker.pm util.c
+
+NETaa13399: Patch 0k from Andy
+Files patched: Configure MANIFEST Makefile.SH config.H config_h.SH hints/dec_osf.sh hints/mpeix.sh hints/next_3_0.sh hints/ultrix_4.sh installperl lib/ExtUtils/MakeMaker.pm lib/File/Path.pm makeaperl.SH minimod.PL perl.c proto.h vms/config.vms vms/ext/MM_VMS.pm x2p/a2p.h
+
+NETaa13399: Patch 0m from Andy
+Files patched: Configure MANIFEST Makefile.SH README config.H config_h.SH ext/DynaLoader/README ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/sdbm.h ext/util/extliblist hints/cxux.sh hints/linux.sh hints/powerunix.sh lib/ExtUtils/MakeMaker.pm malloc.c perl.h pp_sys.c util.c
+
+NETaa13400: pod2html update from Bill Middleton
+From: Larry Wall
+Files patched: pod/pod2html
+
+NETaa13401: Boyer-Moore code attempts to compile string longer than 255.
+From: Kyriakos Georgiou
+Files patched: util.c
+ The Boyer-Moore table uses unsigned char offsets, but the BM compiler wasn't
+ rejecting strings longer than 255 chars, and was miscompiling them.
+
+NETaa13403: missing a $ on variable name
+From: Wayne Scott
+Files patched: installperl
+ Yup, it was missing.
+
+NETaa13406: didn't wipe out dead match when proceeding to next BRANCH
+From: Michael P. Clemens
+Files patched: regexec.c
+ The code to check alternatives didn't invalidate backreferences matched by the
+ failed branch.
+
+NETaa13407: overload upgrade
+From: owner-perl5-porters@nicoh.com
+Also: Ilya Zakharevich
+Files patched: MANIFEST gv.c lib/Math/BigInt.pm perl.h pod/perlovl.pod pp.c pp.h pp_hot.c sv.c t/lib/bigintpm.t t/op/overload.t
+ Applied supplied patch, and fixed bug induced by use of sv_setsv to do
+ a deep copy, since sv_setsv no longer copies objecthood.
+
+NETaa13409: sv_gets tries to grow string at EOF
+From: Harold O Morris
+Files patched: sv.c
+ Applied suggested patch, only two statements earlier, since the end code
+ also does SvCUR_set.
+
+NETaa13410: delaymagic did =~ instead of &= ~
+From: Andreas Schwab
+Files patched: pp_hot.c
+ Applied supplied patch.
+
+NETaa13411: POSIX didn't compile under -DLEAKTEST
+From: Frederic Chauveau
+Files patched: ext/POSIX/POSIX.xs
+ Used NEWSV instead of newSV.
+
+NETaa13412: new version from Tony Sanders
+From: Tony Sanders
+Files patched: lib/Term/Cap.pm
+ Installed as Term::Cap.pm
+
+NETaa13413: regmust extractor needed to restart loop on BRANCH for (?:) to work
+From: DESARMENIEN
+Files patched: regcomp.c
+ The BRANCH skipper should have restarted the loop from the top.
+
+NETaa13414: the check for accidental list context was done after pm_short check
+From: Michael H. Coen
+Files patched: pp_hot.c
+ Moved check for accidental list context to before the pm_short optimization.
+
+NETaa13418: perlre.pod babbled nonsense about | in character classes
+From: Philip Hazel
+Files patched: pod/perlre.pod
+ Removed bogus brackets.  Now reads:
+     Note however that "|" is interpreted as a literal with square brackets,
+     so if you write C<[fee|fie|foe]> you're really only matching C<[feio|]>.
+
+NETaa13419: need to document introduction of lexical variables
+From: "Heading, Anthony"
+Files patched: pod/perlfunc.pod
+ Now mentions that lexicals aren't introduced till after the current statement.
+
+NETaa13420: formats that overflowed a page caused endless top of forms
+From: Hildo@CONSUL.NL
+Files patched: pp_sys.c
+ If a record is too large to fit on a page, it now prints whatever will
+ fit and then calls top of form again on the remainder.
+
+NETaa13423: the code to do negative list subscript in scalar context was missing
+From: Steve McDougall
+Files patched: pp.c
+ The negative subscript code worked right in list context but not in scalar
+ context.  In fact, there wasn't code to do it in the scalar context.
+
+NETaa13424: existing but undefined CV blocked inheritance
+From: Spider Boardman
+Files patched: gv.c
+ Applied supplied patch.
+
+NETaa13425: removed extra argument to croak
+From: "R. Bernstein"
+Files patched: regcomp.c
+ Removed extra argument.
+
+NETaa13427: added return types
+From: "R. Bernstein"
+Files patched: x2p/a2py.c
+ Applied suggested patch.
+
+NETaa13427: added static declarations
+Files patched: x2p/walk.c
+ (same)
+
+NETaa13428: split was assuming that all backreferences were defined
+From: Dave Schweisguth
+Files patched: pp.c
+ split was assuming that all backreferences were defined.
+
+NETaa13430: hoistmust wasn't hoisting anchored shortcircuit's length
+From: Tom Christiansen
+Also: Rob Hooft
+Files patched: toke.c
+
+NETaa13432: couldn't call code ref under debugger
+From: Mike Fletcher
+Files patched: op.c pp_hot.c sv.h
+ The debugging code assumed it could remember a name to represent a subroutine,
+ but anonymous subroutines don't have a name.  It now remembers a CV reference
+ in that case.
+
+NETaa13435: 1' dumped core
+From: Larry Wall
+Files patched: toke.c
+ Didn't check a pointer for nullness.
+
+NETaa13436: print foo(123) didn't treat foo as subroutine
+From: mcook@cognex.com
+Files patched: toke.c
+ Now treats it as a subroutine rather than a filehandle.
+
+NETaa13437: &$::foo didn't think $::foo was a variable name
+From: mcook@cognex.com
+Files patched: toke.c
+ Now treats $::foo as a global variable.
+
+NETaa13439: referred to old package name
+From: Tom Christiansen
+Files patched: lib/Sys/Syslog.pm
+ Wasn't a strict refs problem after all.  It was simply referring to package
+ syslog, which had been renamed to Sys::Syslog.
+
+NETaa13440: stat operations didn't know what to do with glob or ref to glob
+From: mcook@cognex.com
+Files patched: doio.c pp_sys.c
+ Now knows about the kinds of filehandles returned by FileHandle constructors
+ and such.
+
+NETaa13442: couldn't find name of copy of deleted symbol table entry
+From: Spider Boardman
+Files patched: gv.c gv.h
+ I did a much simpler fix.  When gp_free notices that it's freeing the
+ master GV, it nulls out gp_egv.  The GvENAME and GvESTASH macros know
+ to revert to gv if egv is null.
+ 
+ This has the advantage of not creating a reference loop.
+
+NETaa13443: couldn't override an XSUB
+From: William Setzer
+Files patched: op.c
+ When the newSUB and newXS routines checked for whether the old sub was
+ defined, they only looked at CvROOT(cv), not CvXSUB(cv).
+
+NETaa13443: needed to do same thing in newXS
+Files patched: op.c
+ (same)
+
+NETaa13444: -foo now doesn't warn unless sub foo is defined
+From: Larry Wall
+Files patched: toke.c
+ Made it not warn on -foo, unless there is a sub foo defined.
+
+NETaa13451: in scalar context, pp_entersub now guarantees one item from XSUB
+From: Nick Gianniotis
+Files patched: pp_hot.c
+ The pp_entersub routine now guarantees that an XSUB in scalar context
+ returns one and only one value.  If there are fewer, it pushes undef,
+ and if there are more, it returns the last one.
+
+NETaa13457: now explicitly disallows printf format with 'n' or '*'.
+From: lees@cps.msu.edu
+Files patched: doop.c
+ Now says
+ 
+     Use of n in printf format not supported at ./foo line 3.
+ 
+
+NETaa13458: needed to call SvPOK_only() in pp_substr
+From: Wayne Scott
+Files patched: pp.c
+ Needed to call SvPOK_only() in pp_substr.
+
+NETaa13459: umask and chmod now warn about missing initial 0 even with paren
+From: Andreas Koenig
+Files patched: toke.c
+ Now skips parens as well as whitespace looking for argument.
+
+NETaa13460: backtracking didn't work on .*? because reginput got clobbered
+From: Andreas Koenig
+Files patched: regexec.c
+ When .*? did a probe of the rest of the string, it clobbered reginput,
+ so the next call to match a . tried to match the newline and failed.
+
+NETaa13475: \(@ary) now treats array as list of scalars
+From: Tim Bunce
+Files patched: op.c
+ The mod() routine now refrains from marking @ary as an lvalue if it's in parens
+ and is the subject of an OP_REFGEN.
+
+NETaa13481: accept buffer wasn't aligned good enough
+From: Holger Bechtold
+Also: Christian Murphy
+Files patched: pp_sys.c
+ Applied suggested patch.
+
+NETaa13486: while (<>) now means while (defined($_ = <>))
+From: Jim Balter
+Files patched: op.c pod/perlop.pod
+ while (<HANDLE>) now means while (defined($_ = <HANDLE>)).
+
+NETaa13500: needed DESTROY in FileHandle
+From: Tim Bunce
+Files patched: ext/POSIX/POSIX.pm
+ Added DESTROY method.  Also fixed ungensym to use POSIX:: instead of _POSIX.
+ Removed ungensym from close method, since DESTROY should do that now.
+
+NETaa13502: now complains if you use local on a lexical variable
+From: Larry Wall
+Files patched: op.c
+ Now says something like
+ 
+     Can't localize lexical variable $var at ./try line 6.
+
+NETaa13512: added $SIG{__WARN__} and $SIG{__DIE__} hooks
+From: Larry Wall
+Files patched: embed.h gv.c interp.sym mg.c perl.h pod/perlvar.pod pp_ctl.c util.c Todo pod/perldiag.pod
+
+NETaa13514: statements before intro of lex var could see lex var
+From: William Setzer
+Files patched: op.c
+ When a lexical variable is declared, introduction is delayed until
+ the start of the next statement, so that any initialization code runs
+ outside the scope of the new variable.  Thus,
+ 
+     my $y = 3;
+     my $y = $y;
+     print $y;
+ 
+ should print 3.  Unfortunately, the declaration was marked with the
+ beginning location at the time that "my $y" was processed instead of 
+ when the variable was introduced, so any embedded statements within
+ an anonymous subroutine picked up the wrong "my".  The declaration
+ is now labelled correctly when the variable is actually introduced.
+
+NETaa13520: added closures
+From: Larry Wall
+Files patched: Todo cv.h embed.h global.sym gv.c interp.sym op.c perl.c perl.h pod/perlform.pod pp.c pp_ctl.c pp_hot.c sv.c sv.h toke.c
+
+NETaa13520: test to see if lexical works in a format now
+Files patched: t/op/write.t
+
+NETaa13522: substitution couldn't be used on a substr()
+From: Hans Mulder
+Files patched: pp_ctl.c pp_hot.c
+ Changed pp_subst not to use sv_replace() anymore, which didn't handle lvalues
+ and was overkill anyway.  Should be slightly faster this way too.
+
+NETaa13525: G_EVAL mode in perl_call_sv didn't return values right.
+Files patched: perl.c
+
+NETaa13525: consolidated error message
+From: Larry Wall
+Files patched: perl.h toke.c
+
+NETaa13525: derived it
+Files patched: perly.h
+
+NETaa13525: missing some values from embed.h
+Files patched: embed.h
+
+NETaa13525: random cleanup
+Files patched: MANIFEST Todo cop.h lib/TieHash.pm lib/perl5db.pl opcode.h patchlevel.h pod/perldata.pod pod/perlsub.pod t/op/ref.t toke.c
+
+NETaa13525: random cleanup                  
+Files patched: pp_ctl.c util.c
+
+NETaa13527: File::Find needed to export $name and $dir
+From: Chaim Frenkel
+Files patched: lib/File/Find.pm
+ They are now exported.
+
+NETaa13528: cv_undef left unaccounted-for GV pointer in CV
+From: Tye McQueen
+Also: Spider Boardman
+Files patched: op.c
+
+NETaa13530: scalar keys now resets hash iterator
+From: Tim Bunce
+Files patched: doop.c
+ scalar keys() now resets the hash iterator.
+
+NETaa13531: h2ph doesn't check defined right
+From: Casper H.S. Dik
+Files patched: h2ph.SH
+
+NETaa13540: VMS update
+From: Larry Wall
+Files patched: MANIFEST README.vms doio.c embed.h ext/DynaLoader/dl_vms.xs interp.sym lib/Cwd.pm lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Find.pm lib/File/Path.pm mg.c miniperlmain.c perl.c perl.h perly.c perly.c.diff pod/perldiag.pod pp_ctl.c pp_hot.c pp_sys.c proto.h util.c vms/Makefile vms/config.vms vms/descrip.mms vms/ext/Filespec.pm vms/ext/MM_VMS.pm vms/ext/VMS/stdio/Makefile.PL vms/ext/VMS/stdio/stdio.pm vms/ext/VMS/stdio/stdio.xs vms/genconfig.pl vms/perlvms.pod vms/sockadapt.c vms/sockadapt.h vms/vms.c vms/vmsish.h vms/writemain.pl
+
+NETaa13540: got some duplicate code
+Files patched: lib/File/Path.pm
+
+NETaa13540: stuff from Charles
+Files patched: MANIFEST README.vms lib/ExtUtils/MakeMaker.pm lib/ExtUtils/MakeMaker.pm lib/ExtUtils/xsubpp lib/File/Basename.pm lib/File/Path.pm perl.c perl.h pod/perldiag.pod pod/perldiag.pod vms/Makefile vms/Makefile vms/config.vms vms/config.vms vms/descrip.mms vms/descrip.mms vms/ext/Filespec.pm vms/ext/Filespec.pm vms/ext/MM_VMS.pm vms/ext/MM_VMS.pm vms/ext/VMS/stdio/stdio.pm vms/ext/VMS/stdio/stdio.xs vms/gen_shrfls.pl vms/gen_shrfls.pl vms/genconfig.pl vms/genconfig.pl vms/mms2make.pl vms/perlvms.pod vms/sockadapt.h vms/test.com vms/vms.c vms/vms.c vms/vmsish.h vms/vmsish.h vms/writemain.pl
+
+NETaa13540: tweak from Charles
+Files patched: lib/File/Path.pm
+
+NETaa13552: scalar unpack("P4",...) ignored the 4
+From: Eric Arnold
+Files patched: pp.c
+ The optimization that tried to do only one item in a scalar context didn't
+ realize that the argument to P was not a repeat count.
+
+NETaa13553: now warns about 8 or 9 in octal escapes
+From: Mike Rogers
+Files patched: util.c
+ Now warns if it finds 8 or 9 before the end of the octal escape sequence.
+ So \039 produces a warning, but \0339 does not.
+
+NETaa13554: now allows foreach ${"name"}
+From: Johan Holtman
+Files patched: op.c
+ Instead of trying to remove OP_RV2SV, the compiler now just transmutes it into an
+ OP_RV2GV, which is a no-op for ordinary variables and does the right
+ thing for ${"name"}.
+
+NETaa13559: substitution now always checks for readonly
+From: Rodger Anderson
+Files patched: pp_hot.c
+ Substitution now always checks for readonly.
+
+NETaa13561: added explanations of closures and curly-quotes
+From: Larry Wall
+Files patched: pod/perlref.pod
+
+NETaa13562: null components in path cause indigestion
+From: Ambrose Kofi Laing
+Files patched: lib/Cwd.pm lib/pwd.pl
+
+NETaa13575: documented semantics of negative substr length
+From: Jeff Bouis
+Files patched: pod/perlfunc.pod
+ Documented the fact that negative length now leaves characters off the end,
+ and while I was at it, made it work right even if offset wasn't 0.
+
+NETaa13575: negative length to substr didn't work when offset non-zero
+Files patched: pp.c
+ (same)
+
+NETaa13575: random cleanup
+Files patched: pod/perlfunc.pod
+ (same)
+
+NETaa13580: couldn't localize $ACCUMULATOR
+From: Larry Wall
+Files patched: gv.c lib/English.pm mg.c perl.c sv.c
+ Needed to make $^A a real magical variable.  Also lib/English.pm wasn't
+ exporting good.
+
+NETaa13583: doc mods from Tom
+From: Larry Wall
+Files patched: pod/modpods/AnyDBMFile.pod pod/modpods/Basename.pod pod/modpods/Benchmark.pod pod/modpods/Cwd.pod pod/modpods/Dynaloader.pod pod/modpods/Exporter.pod pod/modpods/Find.pod pod/modpods/Finddepth.pod pod/modpods/Getopt.pod pod/modpods/MakeMaker.pod pod/modpods/Open2.pod pod/modpods/POSIX.pod pod/modpods/Ping.pod pod/modpods/less.pod pod/modpods/strict.pod pod/perlapi.pod pod/perlbook.pod pod/perldata.pod pod/perlform.pod pod/perlfunc.pod pod/perlipc.pod pod/perlmod.pod pod/perlobj.pod pod/perlref.pod pod/perlrun.pod pod/perlsec.pod pod/perlsub.pod pod/perltrap.pod pod/perlvar.pod
+
+NETaa13589: return was enforcing list context on its arguments
+From: Tim Freeman
+Files patched: opcode.pl
+ A return was being treated like a normal list operator, in that it was
+ setting list context on its arguments.  This was bogus.
+
+NETaa13591: POSIX::creat used wrong argument
+From: Paul Marquess
+Files patched: ext/POSIX/POSIX.pm
+ Applied suggested patch.
+
+NETaa13605: use strict refs error message now displays bad ref
+From: Peter Gordon
+Files patched: perl.h pod/perldiag.pod pp.c pp_hot.c
+ Now says
+ 
+     Can't use string ("2") as a HASH ref while "strict refs" in use at ./foo line 12.
+
+NETaa13630: eof docs were unclear
+From: Hallvard B Furuseth
+Files patched: pod/perlfunc.pod
+ Applied suggested patch.
+
+NETaa13636: $< and $> weren't refetched on undump restart
+From: Steve Pearlmutter
+Files patched: perl.c
+ The code in main() bypassed perl_construct on an undump restart, which bypassed
+ the code that set $< and $>.
+
+NETaa13641: added Tim's fancy new import whizbangers
+From: Tim Bunce
+Files patched: lib/Exporter.pm
+ Applied suggested patch.
+
+NETaa13649: couldn't AUTOLOAD a symbol reference
+From: Larry Wall
+Files patched: pp_hot.c
+ pp_entersub needed to guarantee a CV so it would get to the AUTOLOAD code.
+
+NETaa13651: renamed file had wrong package name
+From: Andreas Koenig
+Files patched: lib/File/Path.pm
+ Applied suggested patch.
+
+NETaa13660: now that we're testing distribution we can diagnose RANDBITS errors
+From: Karl Glazebrook
+Files patched: t/op/rand.t
+ Changed to suggested algorithm.  Also duplicated it to test rand(100) too.
+
+NETaa13660: rand.t didn't test for proper distribution within range
+Files patched: t/op/rand.t
+ (same)
+
+NETaa13671: array slice misbehaved in a scalar context
+From: Tye McQueen
+Files patched: pp.c
+ A spurious else prevented the scalar-context-handling code from running.
+
+NETaa13672: filehandle constructors in POSIX don't return failure successfully
+From: Ian Phillipps
+Files patched: ext/POSIX/POSIX.pm
+ Applied suggested patch.
+ 
+
+NETaa13678: forced $1 to always be untainted
+From: Ka-Ping Yee
+Files patched: mg.c
+ I believe the bug that triggered this was fixed elsewhere, but just in case,
+ I put in explicit code to force $1 et al not to be tainted regardless.
+
+NETaa13682: formline doc need to discuss ~ and ~~ policy
+From: Peter Gordon
+Files patched: pod/perlfunc.pod
+
+NETaa13686: POSIX::open and POSIX::mkfifo didn't check tainting
+From: Larry Wall
+Files patched: ext/POSIX/POSIX.xs
+ open() and mkfifo() now check tainting.
+
+NETaa13687: new Exporter.pm
+From: Tim Bunce
+Files patched: lib/Exporter.pm
+ Added suggested changes, except for @EXPORTABLE, because it looks too much
+ like @EXPORTTABLE.  Decided to stick with @EXPORT_OK because it looks more
+ like an adjunct.  Also added an export_tags routine.  The keys in the
+ %EXPORT_TAGS hash no longer use colons, to make the initializers prettier.
+
+NETaa13687: new Exporter.pm      
+Files patched: ext/POSIX/POSIX.pm
+ (same)
+
+NETaa13694: add sockaddr_in to Socket.pm
+From: Tim Bunce
+Files patched: ext/Socket/Socket.pm
+ Applied suggested patch.
+
+NETaa13695: library routines should use qw() as good example
+From: Dean Roehrich
+Files patched: ext/DB_File/DB_File.pm ext/DynaLoader/DynaLoader.pm ext/Fcntl/Fcntl.pm ext/GDBM_File/GDBM_File.pm ext/POSIX/POSIX.pm ext/Socket/Socket.pm
+ Applied suggested patch.
+
+NETaa13696: myconfig should be a routine in Config.pm
+From: Kenneth Albanowski
+Files patched: configpm
+ Applied suggested patch.
+
+NETaa13704: fdopen closed fd on failure
+From: Hallvard B Furuseth
+Files patched: doio.c
+ Applied suggested patch.
+
+NETaa13706: Term::Cap doesn't work
+From: Dean Roehrich
+Files patched: lib/Term/Cap.pm
+ Applied suggested patch.
+
+NETaa13710: cryptswitch needed to be more "useable"
+From: Tim Bunce
+Files patched: embed.h global.sym perl.h toke.c
+ The cryptswitch_fp function now can operate in two modes.  It can
+ modify the global rsfp to redirect input as before, or it can modify
+ linestr and return true, indicating that it is not necessary for yylex
+ to read another line since cryptswitch_fp has just done it.
+
+NETaa13712: new_tmpfile() can't be called as constructor
+From: Hans Mulder
+Files patched: ext/POSIX/POSIX.xs
+ Now allows new_tmpfile() to be called as a constructor.
+
+NETaa13714: variable method call not documented
+From: "Randal L. Schwartz"
+Files patched: pod/perlobj.pod
+ Now indicates that OBJECT->$method() works.
+
+NETaa13715: PACK->$method produces spurious warning
+From: Larry Wall
+Files patched: toke.c
+ The -> operator was telling the lexer to expect an operator when the
+ next thing was a variable.
+
+NETaa13716: Carp now allows multiple packages to be skipped out of
+From: Larry Wall
+Files patched: lib/Carp.pm
+ The subroutine redefinition warnings now warn on import collisions.
+
+NETaa13716: Exporter catches warnings and gives a better line number
+Files patched: lib/Exporter.pm
+ (same)
+
+NETaa13716: now counts imported routines as "defined" for redef warnings
+Files patched: op.c sv.c
+ (same)
+
+-------------
+Version 5.000
+-------------
+
+New things
+----------
+    The -w switch is much more informative.
+
+    References.  See t/op/ref.t for examples.  All entities in Perl 5 are
+    reference counted so that it knows when each item should be destroyed.
+
+    Objects.  See t/op/ref.t for examples.
+
+    => is now a synonym for comma.  This is useful as documentation for
+    arguments that come in pairs, such as initializers for associative arrays,
+    or named arguments to a subroutine.
+
+    All functions have been turned into list operators or unary operators,
+    meaning the parens are optional.  Even subroutines may be called as
+    list operators if they've already been declared.
+
+    More embeddible.  See main.c and embed_h.sh.  Multiple interpreters
+    in the same process are supported (though not with interleaved
+    execution yet).
+
+    The interpreter is now flattened out.  Compare Perl 4's eval.c with
+    the perl 5's pp.c.  Compare Perl 4's 900 line interpreter loop in cmd.c
+    with Perl 5's 1 line interpreter loop in run.c.  Eventually we'll make
+    everything non-blocking so we can interface nicely with a scheduler.
+
+    eval is now treated more like a subroutine call.  Among other things,
+    this means you can return from it.
+
+    Format value lists may be spread over multiple lines by enclosing in
+    a do {} block.
+
+    You may now define BEGIN and END subroutines for each package.  The BEGIN
+    subroutine executes the moment it's parsed.  The END subroutine executes
+    just before exiting.
+
+    Flags on the #! line are interpreted even if the script wasn't
+    executed directly.  (And even if the script was located by "perl -x"!)
+
+    The ?: operator is now legal as an lvalue.
+
+    List context now propagates to the right side of && and ||, as well
+    as the 2nd and 3rd arguments to ?:.
+
+    The "defined" function can now take a general expression.
+
+    Lexical scoping available via "my".  eval can see the current lexical
+    variables.
+
+    The preferred package delimiter is now :: rather than '.
+
+    tie/untie are now preferred to dbmopen/dbmclose.  Multiple DBM
+    implementations are allowed in the same executable, so you can
+    write scripts to interchange data among different formats.
+
+    New "and" and "or" operators work just like && and || but with
+    a precedence lower than comma, so they work better with list operators.
+
+    New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst(),
+    chomp(), glob()
+
+    require with a number checks to see that the version of Perl that is
+    currently running is at least that number.
+
+    Dynamic loading of external modules is now supported.
+
+    There is a new quote form qw//, which is equivalent to split(' ', q//).
+
+    Assignment of a reference to a glob value now just replaces the
+    single element of the glob corresponding to the reference type:
+	*foo = \$bar, *foo = \&bletch;
+
+    Filehandle methods are now supported:
+	output_autoflush STDOUT 1;
+
+    There is now an "English" module that provides human readable translations
+    for cryptic variable names.
+
+    Autoload stubs can now call the replacement subroutine with goto &realsub.
+
+    Subroutines can be defined lazily in any package by declaring an AUTOLOAD
+    routine, which will be called if a non-existent subroutine is called in
+    that package.
+
+    Several previously added features have been subsumed under the new
+    keywords "use" and "no".  Saying "use Module LIST" is short for
+	BEGIN { require Module; import Module LIST; }
+    The "no" keyword is identical except that it calls "unimport" instead.
+    The earlier pragma mechanism now uses this mechanism, and two new
+    modules have been added to the library to implement "use integer"
+    and variations of "use strict vars, refs, subs".
+
+    Variables may now be interpolated literally into a pattern by prefixing
+    them with \Q, which works just like \U, but backwhacks non-alphanumerics
+    instead.  There is also a corresponding quotemeta function.
+
+    Any quantifier in a regular expression may now be followed by a ? to
+    indicate that the pattern is supposed to match as little as possible.
+
+    Pattern matches may now be followed by an m or s modifier to explicitly
+    request multiline or singleline semantics.  An s modifier makes . match
+    newline.
+
+    Patterns may now contain \A to match only at the beginning of the string,
+    and \Z to match only at the end.  These differ from ^ and $ in that
+    they ignore multiline semantics.  In addition, \G matches where the
+    last interation of m//g or s///g left off.
+
+    Non-backreference-producing parens of various sorts may now be
+    indicated by placing a ? directly after the opening parenthesis,
+    followed by a character that indicates the purpose of the parens.
+    An :, for instance, indicates simple grouping.  (?:a|b|c) will
+    match any of a, b or c without producing a backreference.  It does
+    "eat" the input.  There are also assertions which do not eat the
+    input but do lookahead for you.  (?=stuff) indicates that the next
+    thing must be "stuff".  (?!nonsense) indicates that the next thing
+    must not be "nonsense".
+
+    The negation operator now treats non-numeric strings specially.
+    A -"text" is turned into "-text", so that -bareword is the same
+    as "-bareword".  If the string already begins with a + or -, it
+    is flipped to the other sign.
+
+Incompatibilities
+-----------------
+    @ now always interpolates an array in double-quotish strings.  Some programs
+    may now need to use backslash to protect any @ that shouldn't interpolate.
+
+    Ordinary variables starting with underscore are no longer forced into
+    package main.
+
+    s'$lhs'$rhs' now does no interpolation on either side.  It used to
+    interplolate $lhs but not $rhs.
+
+    The second and third arguments of splice are now evaluated in scalar
+    context (like the book says) rather than list context.
+
+    Saying "shift @foo + 20" is now a semantic error because of precedence.
+
+    "open FOO || die" is now incorrect.  You need parens around the filehandle.
+
+    The elements of argument lists for formats are now evaluated in list
+    context.  This means you can interpolate list values now.
+
+    You can't do a goto into a block that is optimized away.  Darn.
+
+    It is no longer syntactically legal to use whitespace as the name
+    of a variable, or as a delimiter for any kind of quote construct.
+
+    Some error messages will be different.
+
+    The caller function now returns a false value in a scalar context if there
+    is no caller.  This lets library files determine if they're being required.
+
+    m//g now attaches its state to the searched string rather than the
+    regular expression.
+
+    "reverse" is no longer allowed as the name of a sort subroutine.
+
+    taintperl is no longer a separate executable.  There is now a -T
+    switch to turn on tainting when it isn't turned on automatically.
+
+    Symbols starting with _ are no longer forced into package main, except
+    for $_ itself (and @_, etc.).
+
+    Double-quoted strings may no longer end with an unescaped $ or @.
+
+    Negative array subscripts now count from the end of the array.
+
+    The comma operator in a scalar context is now guaranteed to give a
+    scalar context to its arguments.
+
+    The ** operator now binds more tightly than unary minus.
+
+    Setting $#array lower now discards array elements so that destructors
+    work reasonably.
+
+    delete is not guaranteed to return the old value for tied arrays,
+    since this capability may be onerous for some modules to implement.
+
+    Attempts to set $1 through $9 now result in a run-time error.
diff --git a/gnu/usr.bin/perl/Changes.Conf b/gnu/usr.bin/perl/Changes.Conf
new file mode 100644
index 00000000000..a956fd77da8
--- /dev/null
+++ b/gnu/usr.bin/perl/Changes.Conf
@@ -0,0 +1,2686 @@
+-------------
+Version 5.002
+-------------
+
+Summary of user-visible Configure and build changes since 5.001:
+
+Yet more enhancements and fixes have been made to the Configure and
+build process for perl.  Most of these will not be visible to the
+ordinary user--they just make the process more robust and likely to
+work on a wider range of platforms.
+
+This is a brief summary of the most important changes.  A more
+detailed description is given below.
+
+    Slightly changed installation directories.  See INSTALL.
+
+    Include 5.000 - 5.001 upgrage notes :-) (see below).  You might
+    want to read through them as well as these notes.
+
+    Install documentation for perl modules and pod2* translators.  You can
+    now view perl module documentation with either your system's man(1)
+    program or with the supplied perldoc script.
+
+    Many hint file updates.
+
+    Improve and simplify detection of local libraries and header files.
+
+    Expand documentation of installation process in new INSTALL file.
+
+    Try to reduce Unixisms (such as SH file extraction) to enhance
+    portability to other platforms.  There's still a long way to go.
+
+Upgrade Traps and Pitfalls:
+
+Since a lot has changed in the build process, you are probably best off
+starting with a fresh copy of the perl5.002 sources.  In particular,
+your 5.000 or 5.001 config.sh will contain several variables that are no
+longer needed.  Further, improvements in the Configure tests may mean
+that some of the answers will be different than they were in previous
+versions, and which answer to keep can be difficult to sort out. 
+Therefore, you are probably better off ignoring your old config.sh, as
+in the following:
+
+	make -k distclean 	# (if you've built perl before)
+	rm -f config.sh 	# (in case distclean mysteriously fails)
+	sh Configure [whatever options you like]
+	make depend
+	make
+	make test
+
+This, and much more, is described in the new INSTALL file.
+
+Here are the detailed changes from 5.002beta1 to 5.002b2 in
+reverse chronolgical order:
+
+=item 5.002beta2
+
+This is patch.2b2 to perl5.002beta1.  
+This takes you from 5.002beta1h to 5.002beta2.
+
+Renaming this as beta2 reflects _my_ feeling that it's time to
+wrap up things for the release of 5.002.
+
+Index: Changes.Conf
+
+    Include changes from patches 2b1a .. 2b1h, as well as this
+    patch.
+
+Index: Configure
+
+    Use nm -D on Linux with shared libraries, if the system
+    supports nm -D.
+
+Prereq:  3.0.1.8 
+*** perl5.002b1h/Configure	Thu Jan  4 11:14:37 1996
+--- perl5.002b2/Configure	Thu Jan 11 17:09:13 1996
+
+Index: MANIFEST
+
+    Include Stub Readline library as part of new debugger.
+    
+    Include hints file dec_osf for ODBM_File extension.
+
+*** perl5.002b1h/MANIFEST	Wed Jan  3 14:37:54 1996
+--- perl5.002b2/MANIFEST	Sat Jan 13 16:30:43 1996
+
+Index: configpm
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/configpm	Tue Oct 31 11:51:52 1995
+--- perl5.002b2/configpm	Fri Jan 12 10:53:34 1996
+
+Index: doop.c
+
+    Chip's patch to use STDCHAR and U8 nearly everywhere instead of
+    assuming 8-bit chars or ~(char) 0 == 0xff.
+
+*** perl5.002b1h/doop.c	Wed Nov 15 15:08:01 1995
+--- perl5.002b2/doop.c	Fri Jan 12 15:05:04 1996
+
+Index: embed.h
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/embed.h	Thu Jan  4 13:28:08 1996
+--- perl5.002b2/embed.h	Fri Jan 12 15:09:11 1996
+
+Index: ext/DB_File/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/DB_File/Makefile.PL	Tue Nov 14 14:14:17 1995
+--- perl5.002b2/ext/DB_File/Makefile.PL	Tue Jan  9 16:54:17 1996
+
+*** perl5.002b1h/ext/DB_File/Makefile.PL	Tue Nov 14 14:14:17 1995
+--- perl5.002b2/ext/DB_File/Makefile.PL	Sat Jan 13 17:07:11 1996
+
+Index: ext/DynaLoader/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/DynaLoader/Makefile.PL	Tue Jun  6 12:24:37 1995
+--- perl5.002b2/ext/DynaLoader/Makefile.PL	Sat Jan 13 17:16:34 1996
+
+Index: ext/Fcntl/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/Fcntl/Makefile.PL	Thu Jan 19 18:58:52 1995
+--- perl5.002b2/ext/Fcntl/Makefile.PL	Sat Jan 13 17:16:38 1996
+
+Index: ext/GDBM_File/GDBM_File.pm
+
+    Make the NAME section a legal paragraph.
+
+*** perl5.002b1h/ext/GDBM_File/GDBM_File.pm	Mon Nov 20 10:22:26 1995
+--- perl5.002b2/ext/GDBM_File/GDBM_File.pm	Fri Jan 12 16:11:38 1996
+
+Index: ext/GDBM_File/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/GDBM_File/Makefile.PL	Wed Feb 22 14:36:36 1995
+--- perl5.002b2/ext/GDBM_File/Makefile.PL	Sat Jan 13 17:08:02 1996
+
+Index: ext/NDBM_File/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/NDBM_File/Makefile.PL	Wed Feb 22 14:36:39 1995
+--- perl5.002b2/ext/NDBM_File/Makefile.PL	Sat Jan 13 17:08:13 1996
+
+Index: ext/ODBM_File/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/ODBM_File/Makefile.PL	Mon Jun  5 15:03:44 1995
+--- perl5.002b2/ext/ODBM_File/Makefile.PL	Sat Jan 13 17:08:22 1996
+
+Index: ext/ODBM_File/hints/dec_osf.pl
+
+    New file.
+
+*** /dev/null	Sat Jan 13 16:48:01 1996
+--- perl5.002b2/ext/ODBM_File/hints/dec_osf.pl	Sat Jan 13 16:30:01 1996
+
+Index: ext/POSIX/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/POSIX/Makefile.PL	Thu Jan 19 18:59:00 1995
+--- perl5.002b2/ext/POSIX/Makefile.PL	Sat Jan 13 17:08:27 1996
+
+Index: ext/SDBM_File/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/SDBM_File/Makefile.PL	Tue Nov 14 11:16:43 1995
+--- perl5.002b2/ext/SDBM_File/Makefile.PL	Sat Jan 13 17:16:49 1996
+
+Index: ext/SDBM_File/sdbm/sdbm.c
+
+    Give correct prototype for free.
+
+Prereq:  1.16 
+*** perl5.002b1h/ext/SDBM_File/sdbm/sdbm.c	Mon Nov 13 23:01:41 1995
+--- perl5.002b2/ext/SDBM_File/sdbm/sdbm.c	Fri Jan 12 10:33:32 1996
+
+Index: ext/Safe/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/Safe/Makefile.PL	Tue Jan  2 15:43:53 1996
+--- perl5.002b2/ext/Safe/Makefile.PL	Sat Jan 13 17:08:45 1996
+
+Index: ext/Safe/Safe.pm
+
+    Patch from Andreas.
+
+*** perl5.002b1h/ext/Safe/Safe.pm	Tue Jan  2 15:45:27 1996
+--- perl5.002b2/ext/Safe/Safe.pm	Fri Jan 12 10:52:33 1996
+
+Index: ext/Safe/Safe.xs
+
+    Patch for older compilers which had namespace confusion.
+
+*** perl5.002b1h/ext/Safe/Safe.xs	Tue Jan  2 15:45:27 1996
+--- perl5.002b2/ext/Safe/Safe.xs	Fri Jan  5 14:27:47 1996
+
+Index: ext/Socket/Makefile.PL
+
+    Disable prototypes.
+    Disable pod2man.
+
+*** perl5.002b1h/ext/Socket/Makefile.PL	Sat Dec  2 16:23:52 1995
+--- perl5.002b2/ext/Socket/Makefile.PL	Sat Jan 13 17:08:52 1996
+
+Index: ext/Socket/Socket.xs
+
+    Use unsigned shorts for ports.
+
+*** perl5.002b1h/ext/Socket/Socket.xs	Sat Dec  2 15:46:20 1995
+--- perl5.002b2/ext/Socket/Socket.xs	Mon Jan  8 21:59:52 1996
+
+Index: global.sym
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/global.sym	Wed Jan  3 12:01:59 1996
+--- perl5.002b2/global.sym	Fri Jan 12 10:53:34 1996
+
+Index: gv.c
+
+    Avoid VMS sprintf bug with buffers >1024.
+
+*** perl5.002b1h/gv.c	Fri Dec  8 10:37:22 1995
+--- perl5.002b2/gv.c	Fri Jan 12 15:27:27 1996
+
+Index: hints/aix.sh
+
+    Updated
+
+*** perl5.002b1h/hints/aix.sh	Mon Nov 13 23:03:33 1995
+--- perl5.002b2/hints/aix.sh	Fri Jan 12 12:09:48 1996
+
+Index: hints/irix_5.sh
+
+    Updated
+
+*** perl5.002b1h/hints/irix_5.sh	Tue Jan  2 14:53:52 1996
+--- perl5.002b2/hints/irix_5.sh	Tue Jan  9 16:05:11 1996
+
+Index: hints/linux.sh
+
+    Updated
+
+*** perl5.002b1h/hints/linux.sh	Fri Jun  2 10:20:55 1995
+--- perl5.002b2/hints/linux.sh	Fri Jan 12 11:43:52 1996
+
+Index: hints/machten.sh
+
+    Updated
+
+*** perl5.002b1h/hints/machten.sh	Sun Mar 12 02:36:04 1995
+--- perl5.002b2/hints/machten.sh	Wed Jan 10 14:53:32 1996
+
+Index: installman
+    
+    Use File::Path::mkpath instead of our own makedir().
+    ./perl installman --man1dir=man1 could lead to infinte recursion
+    in old makedir() routine.  Use the standard library instead.
+
+*** perl5.002b1h/installman	Thu Dec 28 16:06:11 1995
+--- perl5.002b2/installman	Thu Jan 11 16:12:30 1996
+
+Index: installperl
+    
+    Use File::Path::mkpath instead of our own makedir().
+
+*** perl5.002b1h/installperl	Wed Jan  3 14:33:57 1996
+--- perl5.002b2/installperl	Thu Jan 11 16:12:16 1996
+
+Index: interp.sym
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/interp.sym	Fri Nov 10 17:17:32 1995
+--- perl5.002b2/interp.sym	Fri Jan 12 15:05:04 1996
+
+Index: lib/AutoLoader.pm
+
+    Undo Tim's tainting patch from beta1h.
+
+*** perl5.002b1h/lib/AutoLoader.pm	Tue Jan  2 16:10:36 1996
+--- perl5.002b2/lib/AutoLoader.pm	Fri Jan  5 16:02:28 1996
+
+Index: lib/Carp.pm
+*** perl5.002b1h/lib/Carp.pm	Tue Jan  2 12:10:38 1996
+--- perl5.002b2/lib/Carp.pm	Fri Jan 12 11:23:31 1996
+
+Index: lib/ExtUtils/MM_VMS.pm
+
+    Updated to MakeMaker-5.16.
+
+*** perl5.002b1h/lib/ExtUtils/MM_VMS.pm	Tue Jan  2 14:07:10 1996
+--- perl5.002b2/lib/ExtUtils/MM_VMS.pm	Thu Jan  4 21:00:46 1996
+
+Index: lib/ExtUtils/MakeMaker.pm
+
+    Updated to MakeMaker-5.16.
+
+Prereq:  1.129 
+*** perl5.002b1h/lib/ExtUtils/MakeMaker.pm	Tue Jan  2 14:07:10 1996
+--- perl5.002b2/lib/ExtUtils/MakeMaker.pm	Wed Jan 10 16:13:05 1996
+
+Index: lib/File/Find.pm
+
+    Fixed exporting of symbols to work.
+
+*** perl5.002b1h/lib/File/Find.pm	Wed Nov 15 15:20:03 1995
+--- perl5.002b2/lib/File/Find.pm	Wed Jan 10 14:46:24 1996
+
+Index: lib/I18N/Collate.pm
+
+    Updated documentation to match program.
+
+*** perl5.002b1h/lib/I18N/Collate.pm	Fri Jun  2 11:30:49 1995
+--- perl5.002b2/lib/I18N/Collate.pm	Fri Jan  5 16:05:26 1996
+
+Index: lib/Term/ReadLine.pm
+
+    Stub new file to interface to various readline packages, or
+    give stub functions if none are found.
+
+*** /dev/null	Sat Jan 13 16:48:01 1996
+--- perl5.002b2/lib/Term/ReadLine.pm	Fri Jan 12 11:23:31 1996
+
+Index: lib/dumpvar.pl
+
+    Ilya's new debugger.
+
+*** perl5.002b1h/lib/dumpvar.pl	Tue Oct 18 12:36:00 1994
+--- perl5.002b2/lib/dumpvar.pl	Fri Jan 12 11:23:31 1996
+
+Index: lib/perl5db.pl
+
+    Ilya's new debugger.
+
+*** perl5.002b1h/lib/perl5db.pl	Tue Jan  2 16:30:33 1996
+--- perl5.002b2/lib/perl5db.pl	Fri Jan 12 11:23:31 1996
+
+Index: lib/sigtrap.pm
+
+    Ilya's new debugger.
+
+*** perl5.002b1h/lib/sigtrap.pm	Thu May 25 11:20:13 1995
+--- perl5.002b2/lib/sigtrap.pm	Fri Jan 12 11:23:31 1996
+
+Index: miniperlmain.c
+
+    More robust i18nl14n() function from jhi.
+
+*** perl5.002b1h/miniperlmain.c	Thu Jan  4 12:03:37 1996
+--- perl5.002b2/miniperlmain.c	Mon Jan  8 22:00:19 1996
+
+Index: myconfig
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/myconfig	Tue Apr  4 12:13:21 1995
+--- perl5.002b2/myconfig	Fri Jan 12 10:53:35 1996
+
+Index: op.c
+
+    Chip's U8/STDCHAR patch.
+
+*** perl5.002b1h/op.c	Wed Jan  3 14:17:01 1996
+--- perl5.002b2/op.c	Fri Jan 12 15:05:05 1996
+
+Index: perl.c
+
+    Change Copyright date to include 1996.  Hope you don't mind.
+
+    Presumptively call this beta2.
+
+*** perl5.002b1h/perl.c	Thu Jan  4 15:13:53 1996
+--- perl5.002b2/perl.c	Fri Jan 12 15:05:05 1996
+
+Index: perl.h
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/perl.h	Wed Jan  3 12:21:55 1996
+--- perl5.002b2/perl.h	Fri Jan 12 15:05:04 1996
+
+Index: pod/Makefile
+
+    Use PERL=../miniperl
+
+*** perl5.002b1h/pod/Makefile	Wed Jan  3 15:06:41 1996
+--- perl5.002b2/pod/Makefile	Fri Jan  5 14:14:30 1996
+
+Index: pod/perlembed.pod
+
+    Give correct usage for the 5th arg to perl_parse (don't pass
+    env).
+
+*** perl5.002b1h/pod/perlembed.pod	Thu Dec 28 16:34:07 1995
+--- perl5.002b2/pod/perlembed.pod	Tue Jan  9 16:02:51 1996
+
+Index: pod/perlfunc.pod
+
+    Work around a pod2man complaint about the -X function.
+
+*** perl5.002b1h/pod/perlfunc.pod	Tue Jan  2 15:39:26 1996
+--- perl5.002b2/pod/perlfunc.pod	Fri Jan 12 11:04:15 1996
+
+*** perl5.002b1h/pod/perlfunc.pod	Tue Jan  2 15:39:26 1996
+--- perl5.002b2/pod/perlfunc.pod	Fri Jan 12 11:04:15 1996
+
+Index: pod/perlovl.pod
+
+    Add DESCRIPTION to head1 line.
+
+*** perl5.002b1h/pod/perlovl.pod	Thu Dec 28 16:34:13 1995
+--- perl5.002b2/pod/perlovl.pod	Thu Jan 11 17:11:16 1996
+
+Index: pod/perlrun.pod
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/pod/perlrun.pod	Thu Dec 28 16:34:15 1995
+--- perl5.002b2/pod/perlrun.pod	Fri Jan 12 10:53:35 1996
+
+Index: pp_ctl.c
+
+    Debugger patch.
+
+*** perl5.002b1h/pp_ctl.c	Wed Jan  3 12:23:13 1996
+--- perl5.002b2/pp_ctl.c	Fri Jan 12 15:05:05 1996
+
+Index: t/lib/posix.t
+
+    Not having POSIX shouldn't result in test failing TEST harness.
+
+*** perl5.002b1h/t/lib/posix.t	Mon Jan 16 22:27:33 1995
+--- perl5.002b2/t/lib/posix.t	Tue Jan  9 15:33:14 1996
+
+Index: t/lib/safe.t
+
+    Not having Safe shouldn't result in test failing TEST harness.
+
+*** perl5.002b1h/t/lib/safe.t	Tue Jan  2 15:43:53 1996
+--- perl5.002b2/t/lib/safe.t	Tue Jan  9 15:35:43 1996
+
+Index: t/lib/socket.t
+
+    Not having Socket shouldn't result in test failing TEST harness.
+
+*** perl5.002b1h/t/lib/socket.t	Fri Dec  8 11:16:01 1995
+--- perl5.002b2/t/lib/socket.t	Tue Jan  9 15:35:51 1996
+
+Index: t/op/time.t
+
+   Test missed year-end wrap-around by one day.
+
+*** perl5.002b1h/t/op/time.t	Tue Oct 18 12:46:31 1994
+--- perl5.002b2/t/op/time.t	Wed Jan 10 16:04:41 1996
+
+Index: toke.c
+
+    Chip's U8/STDCHAR patch.
+
+    Tim's "add a ; after PERL5DB" patch.
+
+*** perl5.002b1h/toke.c	Wed Dec  6 13:24:19 1995
+--- perl5.002b2/toke.c	Fri Jan 12 15:05:06 1996
+
+Index: utils/h2xs.PL
+
+   Updated to 1.13.  Include Changes template file.
+
+*** perl5.002b1h/utils/h2xs.PL	Tue Jan  2 13:50:55 1996
+--- perl5.002b2/utils/h2xs.PL	Thu Jan 11 16:59:48 1996
+
+Index: writemain.SH
+
+    Updates from Tim's  -m/-M/-V patch.
+
+*** perl5.002b1h/writemain.SH	Sat Nov 18 15:51:55 1995
+--- perl5.002b2/writemain.SH	Fri Jan 12 10:53:35 1996
+
+=item patch.2b1h
+
+This is patch.2b1h to perl5.002beta1.  This is mainly a clean-up
+patch.  No progress is made dealing with memory leaks or
+optimizations, though I have used #define STRANGE_MALLOC to
+work around at least some problems.
+
+Index: Configure
+
+    Upgraded to metaconfig patchlevel 60.
+
+    Add in usesafe variable to include or exclude the Safe extension.
+
+    Test for sigaction().
+
+    Check for pager.  This was actually accidental since perldoc.PL
+    mentions $pager and metaconfig has a unit to check for the
+    user's pager.  In retrospect, I decided the Configure check
+    didn't do any harm and some extension writers might decide to
+    use it.
+
+    Always put man1dir under $prefix unless a command line
+    override is used.
+
+    Allow command-line overrides of $man1ext and $man3ext.
+
+
+    Allow man1dir and man3dir names like .../man.1 instead of
+    just .../man1.
+
+    Lots of rearrangements of various pieces of Configure.
+    This might be because I ran metaconfig on a different
+    architecture.
+
+    libc searching now honors $libpth.  Previously, it (almost)
+    always looked in /usr/lib before checking /lib.
+
+    Only prompt user if voidflags is not 15.  If voidflags is 15, then
+    we presume all is well.
+
+
+Prereq:  3.0.1.8 
+*** perl5.002b1g/Configure	Fri Dec  8 11:23:56 1995
+--- perl5.002b1h/Configure	Thu Jan  4 11:14:37 1996
+
+Index: INSTALL
+
+    Document how to skip various extensions.
+
+    Indicate that site_perl is typically under (not beside)
+    /usr/local/lib/perl5.
+
+    Mention how to avoid nm extraction.
+
+
+*** perl5.002b1g/INSTALL	Tue Nov 21 22:54:28 1995
+--- perl5.002b1h/INSTALL	Thu Jan  4 11:06:28 1996
+
+Index: MANIFEST
+
+    Rearrange files some.  Try to move .PL utilities to a separate
+    utils/ subdirectory.
+
+    Merge c2ph.PL and c2ph.doc.
+
+    Add the Safe extension.
+
+*** perl5.002b1g/MANIFEST	Fri Jan  5 11:41:50 1996
+--- perl5.002b1h/MANIFEST	Wed Jan  3 14:37:54 1996
+
+Index: Makefile.SH
+
+    Now builds .PL utilities in the utils/ subdirectory.
+    
+*** perl5.002b1g/Makefile.SH	Fri Dec  8 10:36:33 1995
+--- perl5.002b1h/Makefile.SH	Wed Jan  3 14:28:30 1996
+
+Index: README.vms
+
+    Updated.
+
+*** perl5.002b1g/README.vms	Wed Nov 15 14:23:10 1995
+--- perl5.002b1h/README.vms	Tue Jan  2 16:33:02 1996
+
+Index: XSUB.h
+
+    Updated to match xsubpp-1.929.
+
+*** perl5.002b1g/XSUB.h	Wed Dec  6 13:25:26 1995
+--- perl5.002b1h/XSUB.h	Tue Jan  2 11:57:57 1996
+
+Index: config_h.SH
+
+    Check for HAS_SIGACCTION
+
+    Add STARTPERL define for C code (specifically, a2p).
+
+Prereq:  3.0.1.4 
+*** perl5.002b1g/config_h.SH	Fri Dec  8 11:23:56 1995
+--- perl5.002b1h/config_h.SH	Thu Jan  4 11:14:37 1996
+
+Index: doio.c
+
+    VMS changes for kill.
+
+*** perl5.002b1g/doio.c	Wed Nov 15 14:36:12 1995
+--- perl5.002b1h/doio.c	Tue Jan  2 16:27:07 1996
+
+Index: embed.h
+
+    Auto-generated from global.sym and interp.sym.
+
+*** perl5.002b1g/embed.h	Wed Nov 15 14:48:47 1995
+--- perl5.002b1h/embed.h	Thu Jan  4 13:28:08 1996
+
+Index: ext/DynaLoader/DynaLoader.pm
+
+    VMS-specific updates.
+
+*** perl5.002b1g/ext/DynaLoader/DynaLoader.pm	Fri Nov 10 11:49:00 1995
+--- perl5.002b1h/ext/DynaLoader/DynaLoader.pm	Tue Jan  2 16:28:02 1996
+
+Index: ext/DynaLoader/dl_vms.xs
+
+    Updated to Oct 31, 1995 version.
+
+*** perl5.002b1g/ext/DynaLoader/dl_vms.xs	Tue Oct 31 11:06:06 1995
+--- perl5.002b1h/ext/DynaLoader/dl_vms.xs	Tue Jan  2 16:27:32 1996
+
+Index: global.sym
+
+    Added maxo and save_pptr items.
+
+*** perl5.002b1g/global.sym	Wed Nov 15 14:58:14 1995
+--- perl5.002b1h/global.sym	Wed Jan  3 12:01:59 1996
+
+Index: hints/README.hints
+
+    List of tested systems updated a little.
+
+*** perl5.002b1g/hints/README.hints	Fri May  5 14:12:06 1995
+--- perl5.002b1h/hints/README.hints	Tue Dec 12 20:03:36 1995
+
+Index: hints/irix_5.sh
+
+    Note SGI stdio/malloc related problem.
+
+*** perl5.002b1g/hints/irix_5.sh	Fri May  5 14:07:52 1995
+--- perl5.002b1h/hints/irix_5.sh	Tue Jan  2 14:53:52 1996
+
+Index: hints/irix_6.sh
+
+    Address change.
+    
+    Note SGI stdio/malloc related problem.
+
+*** perl5.002b1g/hints/irix_6.sh	Fri May  5 14:08:41 1995
+--- perl5.002b1h/hints/irix_6.sh	Tue Jan  2 14:54:04 1996
+
+Index: hints/irix_6_2.sh
+    
+    Address change.
+
+*** perl5.002b1g/hints/irix_6_2.sh	Mon Nov 20 11:16:55 1995
+--- perl5.002b1h/hints/irix_6_2.sh	Tue Jan  2 14:49:45 1996
+
+Index: hints/os2.sh
+
+    Updated.
+
+*** perl5.002b1g/hints/os2.sh	Tue Nov 14 11:07:33 1995
+--- perl5.002b1h/hints/os2.sh	Tue Dec 26 17:51:16 1995
+
+Index: installman
+
+    Use fork if available.
+
+*** perl5.002b1g/installman	Fri Jan  5 11:41:52 1996
+--- perl5.002b1h/installman	Thu Dec 28 16:06:11 1995
+
+Index: installperl
+
+    Use new location of utility scripts.
+
+    Eliminate double '//' and extra "".
+
+*** perl5.002b1g/installperl	Mon Nov 20 12:55:03 1995
+--- perl5.002b1h/installperl	Wed Jan  3 14:33:57 1996
+
+Index: lib/AutoLoader.pm
+
+    Avoid tainting problems.
+
+*** perl5.002b1g/lib/AutoLoader.pm	Wed Nov 15 15:04:59 1995
+--- perl5.002b1h/lib/AutoLoader.pm	Tue Jan  2 16:10:36 1996
+
+Index: lib/Carp.pm
+
+    Honor trailing \n in messages, as is done for warn().
+    
+*** perl5.002b1g/lib/Carp.pm	Thu May 25 11:16:07 1995
+--- perl5.002b1h/lib/Carp.pm	Tue Jan  2 12:10:38 1996
+
+Index: lib/Cwd.pm
+
+    VMS patches.
+
+*** perl5.002b1g/lib/Cwd.pm	Fri Jan  5 11:41:52 1996
+--- perl5.002b1h/lib/Cwd.pm	Tue Jan  2 16:28:57 1996
+
+Index: lib/Exporter.pm
+
+    Include Tim Bunce's enhanced Exporter.  I also tried to
+    resolve the two copies of documentation that I had.
+
+*** perl5.002b1g/lib/Exporter.pm	Fri Jan  5 11:41:52 1996
+--- perl5.002b1h/lib/Exporter.pm	Thu Jan  4 14:02:08 1996
+
+Index: lib/ExtUtils/MM_VMS.pm
+
+    New file.  Incorporates VMS-specific items into MakeMaker.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/lib/ExtUtils/MM_VMS.pm	Tue Jan  2 14:07:10 1996
+
+Index: lib/ExtUtils/MakeMaker.pm
+Prereq:  1.116 
+
+    Updated from 5.12 to 5.16.
+
+*** perl5.002b1g/lib/ExtUtils/MakeMaker.pm	Fri Jan  5 11:41:53 1996
+--- perl5.002b1h/lib/ExtUtils/MakeMaker.pm	Tue Jan  2 14:07:10 1996
+
+Index: lib/ExtUtils/Manifest.pm
+
+    Updated from MakeMaker 5.12 to 5.16.
+
+*** perl5.002b1g/lib/ExtUtils/Manifest.pm	Fri Jan  5 11:41:54 1996
+--- perl5.002b1h/lib/ExtUtils/Manifest.pm	Tue Jan  2 14:07:10 1996
+
+Index: lib/ExtUtils/Mkbootstrap.pm
+
+    Updated from MakeMaker 5.12 to 5.16.
+
+*** perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm	Fri Jan  5 11:41:54 1996
+--- perl5.002b1h/lib/ExtUtils/Mkbootstrap.pm	Tue Jan  2 14:07:10 1996
+
+Index: lib/ExtUtils/xsubpp
+
+    Updated from xsubpp-1.924 to 1.929.
+
+*** perl5.002b1g/lib/ExtUtils/xsubpp	Sun Nov 26 16:04:50 1995
+--- perl5.002b1h/lib/ExtUtils/xsubpp	Tue Jan  2 16:29:59 1996
+
+Index: lib/File/Path.pm
+
+    VMS-specific changes.
+
+*** perl5.002b1g/lib/File/Path.pm	Wed Nov 15 15:20:31 1995
+--- perl5.002b1h/lib/File/Path.pm	Tue Jan  2 16:30:21 1996
+
+Index: lib/Pod/Text.pm
+
+    New file.  This was created by Dov (???) and enhanced
+    by Kenneth Albanowski, but all based on Tom C.'s pod2text.
+    Unfortunately, they used a version of pod2text earlier than
+    the one in patch.2b1g.  I've tried to straighten this all out.
+
+    Equally unfortunately, we've all left Tom as the AUTHOR, even
+    though we can't hold him responsible for errors he didn't
+    introduce.  Oh well.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/lib/Pod/Text.pm	Thu Jan  4 14:16:50 1996
+
+Index: lib/Sys/Hostname.pm
+
+    VMS-specific changes.
+
+*** perl5.002b1g/lib/Sys/Hostname.pm	Fri Jan  5 11:41:55 1996
+--- perl5.002b1h/lib/Sys/Hostname.pm	Tue Jan  2 16:30:49 1996
+
+Index: lib/diagnostics.pm
+
+    A patch from Tim Bunce (?)
+
+*** perl5.002b1g/lib/diagnostics.pm	Wed Dec  6 13:58:42 1995
+--- perl5.002b1h/lib/diagnostics.pm	Tue Jan  2 12:10:37 1996
+
+Index: lib/perl5db.pl
+
+    VMS-specific changes.
+
+*** perl5.002b1g/lib/perl5db.pl	Wed Nov 15 22:37:45 1995
+--- perl5.002b1h/lib/perl5db.pl	Tue Jan  2 16:30:33 1996
+
+Index: lib/splain
+
+    Fix some old typos.
+
+*** perl5.002b1g/lib/splain	Tue Nov 14 16:16:36 1995
+--- perl5.002b1h/lib/splain	Tue Jan  2 12:10:37 1996
+
+Index: makeaperl.SH
+
+    Use the 'new' startperl variable.
+
+*** perl5.002b1g/makeaperl.SH	Thu Jun  1 11:20:52 1995
+--- perl5.002b1h/makeaperl.SH	Tue Jan  2 12:11:28 1996
+
+Index: mg.c
+
+    Set up a reliable signal handler, courtesy of Kenneth Albanowski.
+    This needs to be documented still.  The idea is that even on
+    System V systems, you won't have to reset the signal handler as
+    the first action inside your signal handler.
+
+*** perl5.002b1g/mg.c	Wed Nov 15 15:44:10 1995
+--- perl5.002b1h/mg.c	Thu Jan  4 13:49:12 1996
+
+Index: minimod.pl
+
+    Give a proper NAME description.
+
+*** perl5.002b1g/minimod.pl	Sun Nov 26 16:19:55 1995
+--- perl5.002b1h/minimod.pl	Tue Jan  2 14:30:24 1996
+
+Index: miniperlmain.c
+
+    Better locale handling, courtesy of jhi.
+
+    Include a proper cast of NULL for non-prototyping compilers.
+
+*** perl5.002b1g/miniperlmain.c	Sat Nov 18 15:48:10 1995
+--- perl5.002b1h/miniperlmain.c	Thu Jan  4 12:03:37 1996
+
+Index: op.c
+
+   Turn on USE_OP_MASK by default for the Safe extension.  I'll be
+   interested in benchmark results with this on and off.
+
+*** perl5.002b1g/op.c	Wed Nov 15 22:10:36 1995
+--- perl5.002b1h/op.c	Wed Jan  3 14:17:01 1996
+
+Index: os2/Makefile.SHs
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/Makefile.SHs	Sun Dec 24 13:55:22 1995
+
+Index: os2/README
+
+    Updated.
+
+*** perl5.002b1g/os2/README	Tue Nov 14 14:42:13 1995
+--- perl5.002b1h/os2/README	Tue Dec 26 18:31:32 1995
+
+Index: os2/diff.MANIFEST
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.MANIFEST	Tue Dec 26 19:54:12 1995
+
+Index: os2/diff.Makefile
+
+    Updated
+
+*** perl5.002b1g/os2/diff.Makefile	Tue Nov 14 11:09:29 1995
+--- perl5.002b1h/os2/diff.Makefile	Fri Dec  8 00:09:56 1995
+
+Index: os2/diff.c2ph
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.c2ph	Thu Dec  7 15:25:52 1995
+
+Index: os2/diff.configure
+
+    Updated.
+
+*** perl5.002b1g/os2/diff.configure	Sun Nov 12 01:31:34 1995
+--- perl5.002b1h/os2/diff.configure	Tue Dec 26 19:57:08 1995
+
+Index: os2/diff.db_file
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.db_file	Tue Dec 19 02:14:54 1995
+
+Index: os2/diff.init
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.init	Sun Nov 26 15:05:48 1995
+
+Index: os2/diff.installman
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.installman	Wed Nov 22 03:50:26 1995
+
+Index: os2/diff.installperl
+
+    Updated.
+
+*** perl5.002b1g/os2/diff.installperl	Tue Nov 14 11:09:28 1995
+--- perl5.002b1h/os2/diff.installperl	Wed Nov 22 02:59:58 1995
+
+Index: os2/diff.mkdep
+
+    Updated.
+
+*** perl5.002b1g/os2/diff.mkdep	Tue Nov 14 11:09:28 1995
+--- perl5.002b1h/os2/diff.mkdep	Sun Nov 26 15:00:24 1995
+
+Index: os2/diff.rest
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/diff.rest	Thu Dec  7 16:03:26 1995
+
+Index: os2/diff.x2pMakefile
+
+    Updated.
+
+*** perl5.002b1g/os2/diff.x2pMakefile	Tue Nov 14 11:09:29 1995
+--- perl5.002b1h/os2/diff.x2pMakefile	Wed Nov 22 21:55:42 1995
+
+Index: os2/notes
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/notes	Tue Dec 26 19:55:30 1995
+
+Index: os2/os2.c
+
+    Updated.
+
+*** perl5.002b1g/os2/os2.c	Tue Nov 14 11:07:33 1995
+--- perl5.002b1h/os2/os2.c	Sun Dec 24 13:43:02 1995
+
+Index: os2/os2ish.h
+
+    Updated.
+
+*** perl5.002b1g/os2/os2ish.h	Tue Nov 14 11:07:33 1995
+--- perl5.002b1h/os2/os2ish.h	Mon Dec 18 16:17:38 1995
+
+Index: os2/perl2cmd.pl
+
+    New file.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/os2/perl2cmd.pl	Tue Dec 19 11:20:42 1995
+
+Index: perl.c
+
+    Updated to say beta1h.
+
+    Move VMS env code.
+
+*** perl5.002b1g/perl.c	Fri Jan  5 11:41:56 1996
+--- perl5.002b1h/perl.c	Thu Jan  4 15:13:53 1996
+
+Index: perl.h
+
+    5.002beta1 attempted some memory optimizations, but unfortunately
+    they can result in a memory leak problem.  This can be
+    avoided by #define STRANGE_MALLOC.  I do that here until
+    consensus is reached on a better strategy for handling the
+    memory optimizations.
+
+    Include maxo for the maximum number of operations (needed
+    for the Safe extension).
+
+*** perl5.002b1g/perl.h	Wed Nov 15 17:13:16 1995
+--- perl5.002b1h/perl.h	Wed Jan  3 12:21:55 1996
+
+Index: pod/Makefile
+
+    Include -I../lib so that pod2* can find the appropriate libraries.
+
+    The pod names are once again sorted.
+
+    The PERL line is wrong.  It should read 
+	PERL = ../miniperl
+    This file is automatically generated, but I happened to do it on
+    a system without miniperl avaialable, so my script fell back on
+    the perl default.
+
+*** perl5.002b1g/pod/Makefile	Fri Jan  5 11:41:56 1996
+--- perl5.002b1h/pod/Makefile	Wed Jan  3 15:06:41 1996
+
+Index: pod/perlmod.pod
+
+    Mention the Safe extension.
+
+*** perl5.002b1g/pod/perlmod.pod	Fri Jan  5 11:41:59 1996
+--- perl5.002b1h/pod/perlmod.pod	Thu Jan  4 13:52:14 1996
+
+Index: pod/perltoc.pod
+
+    Rebuilt using  pod/buildtoc and fmt.
+
+*** perl5.002b1g/pod/perltoc.pod	Fri Jan  5 11:42:00 1996
+--- perl5.002b1h/pod/perltoc.pod	Thu Jan  4 14:04:20 1996
+
+Index: pod/pod2text.PL
+*** perl5.002b1g/pod/pod2text.PL	Fri Jan  5 11:42:01 1996
+--- perl5.002b1h/pod/pod2text.PL	Tue Jan  2 14:28:24 1996
+
+Index: pp_sys.c
+
+    VMS changes ?  
+
+*** perl5.002b1g/pp_sys.c	Wed Nov 15 21:51:33 1995
+--- perl5.002b1h/pp_sys.c	Tue Jan  2 16:32:50 1996
+
+Index: t/lib/safe.t
+
+    New test.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/t/lib/safe.t	Tue Jan  2 15:43:53 1996
+
+Index: utils/Makefile
+
+    New file to build the utilities.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/utils/Makefile	Wed Jan  3 14:06:18 1996
+
+Index: utils/c2ph.PL
+
+    Ungracefully merge the old c2ph.doc in as an embedded pod.
+    
+    Delete lots of trailing spaces and tabs that have crept in.
+    
+Prereq:  1.7 
+*** perl5.002b1g/utils/c2ph.PL	Mon Nov 20 12:36:17 1995
+--- perl5.002b1h/utils/c2ph.PL	Wed Jan  3 14:05:41 1996
+
+Index: utils/h2ph.PL
+
+    Add patch for AIX files which sometimes have #include<foo.h>,
+    i.e., no spaces after the word 'include'.
+
+*** perl5.002b1g/utils/h2ph.PL	Mon Nov 27 10:14:50 1995
+--- perl5.002b1h/utils/h2ph.PL	Tue Jan  2 16:13:31 1996
+
+Index: utils/h2xs.PL
+
+    Add version stuff.
+
+    The old version didn't have a number.  This one's called 1.12.
+
+*** perl5.002b1g/utils/h2xs.PL	Sun Nov 19 22:37:58 1995
+--- perl5.002b1h/utils/h2xs.PL	Tue Jan  2 13:50:55 1996
+
+Index: utils/perlbug.PL
+
+    New utility.
+
+*** /dev/null	Fri Jan  5 12:48:01 1996
+--- perl5.002b1h/utils/perlbug.PL	Sat Nov 18 16:15:13 1995
+
+Index: utils/perldoc.PL
+
+    Better error handling.
+
+    Updated to use Pod::Text, if available.
+    
+    More VMS friendly.
+
+    New -u option .
+
+*** perl5.002b1g/utils/perldoc.PL	Tue Nov 14 14:57:57 1995
+--- perl5.002b1h/utils/perldoc.PL	Tue Jan  2 14:28:08 1996
+
+Index: utils/pl2pm.PL
+
+    Changed into a .PL extract file for proper setting of
+    $startperl.
+
+    Add _minimal_ pod documentation.
+
+*** perl5.002b1g/utils/pl2pm.PL	Mon Jan 16 23:45:07 1995
+--- perl5.002b1h/utils/pl2pm.PL	Wed Jan  3 14:14:57 1996
+
+Index: vms/Makefile
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/Makefile	Wed Nov 15 22:05:15 1995
+--- perl5.002b1h/vms/Makefile	Tue Jan  2 16:33:53 1996
+
+Index: vms/config.vms
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/config.vms	Wed Nov 15 22:05:26 1995
+--- perl5.002b1h/vms/config.vms	Tue Jan  2 16:33:09 1996
+
+Index: vms/descrip.mms
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/descrip.mms	Wed Nov 15 22:05:38 1995
+--- perl5.002b1h/vms/descrip.mms	Tue Jan  2 16:33:18 1996
+
+Index: vms/ext/Filespec.pm
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/ext/Filespec.pm	Sun Mar 12 03:14:26 1995
+--- perl5.002b1h/vms/ext/Filespec.pm	Tue Jan  2 16:33:25 1996
+
+Index: vms/ext/MM_VMS.pm
+
+    Updated for VMS.  This might be obsolete now that we have
+    lib/ExtUtils/MM_VMS.pm.
+
+*** perl5.002b1g/vms/ext/MM_VMS.pm	Wed Nov 15 22:05:48 1995
+--- perl5.002b1h/vms/ext/MM_VMS.pm	Tue Jan  2 16:33:32 1996
+
+Index: vms/gen_shrfls.pl
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/gen_shrfls.pl	Wed Nov 15 22:06:27 1995
+--- perl5.002b1h/vms/gen_shrfls.pl	Tue Jan  2 16:33:47 1996
+
+Index: vms/genconfig.pl
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/genconfig.pl	Sun Mar 12 03:14:36 1995
+--- perl5.002b1h/vms/genconfig.pl	Tue Jan  2 16:33:39 1996
+
+Index: vms/perlvms.pod
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/perlvms.pod	Wed Nov 15 22:06:32 1995
+--- perl5.002b1h/vms/perlvms.pod	Tue Jan  2 16:33:59 1996
+
+Index: vms/test.com
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/test.com	Wed Nov 15 22:06:59 1995
+--- perl5.002b1h/vms/test.com	Tue Jan  2 16:34:07 1996
+
+Index: vms/vms.c
+
+    Updated for VMS.
+
+Prereq:  2.2 
+*** perl5.002b1g/vms/vms.c	Wed Nov 15 22:07:10 1995
+--- perl5.002b1h/vms/vms.c	Tue Jan  2 16:34:13 1996
+
+Index: vms/vmsish.h
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/vmsish.h	Wed Nov 15 22:07:24 1995
+--- perl5.002b1h/vms/vmsish.h	Tue Jan  2 16:34:20 1996
+
+Index: vms/writemain.pl
+
+    Updated for VMS.
+
+*** perl5.002b1g/vms/writemain.pl	Mon Mar  6 20:00:18 1995
+--- perl5.002b1h/vms/writemain.pl	Tue Jan  2 16:34:26 1996
+
+Index: x2p/a2py.c
+
+    Use new config_h.SH STARTPERL #define.
+
+*** perl5.002b1g/x2p/a2py.c	Tue Mar  7 11:53:10 1995
+--- perl5.002b1h/x2p/a2py.c	Tue Jan  2 12:11:28 1996
+
+Index: x2p/find2perl.PL
+
+    Add missing "" around $Config{startperl}.
+
+*** perl5.002b1g/x2p/find2perl.PL	Sun Nov 19 23:11:58 1995
+--- perl5.002b1h/x2p/find2perl.PL	Tue Jan  2 12:11:27 1996
+
+Index: x2p/s2p.PL
+
+    Add missing "" around $Config{startperl}.
+
+*** perl5.002b1g/x2p/s2p.PL	Sun Nov 19 23:14:59 1995
+--- perl5.002b1h/x2p/s2p.PL	Tue Jan  2 12:11:27 1996
+
+
+=item patch.2b1g
+
+This is patch.2b1g to perl5.002beta1.
+
+This patch is just my packaging of Tom's documentation patches
+he released as patch.2b1g.
+
+Index: MANIFEST
+*** perl5.002b1f/MANIFEST	Fri Dec  8 13:34:53 1995
+--- perl5.002b1g/MANIFEST	Thu Dec 21 13:00:58 1995
+
+Index: ext/DB_File/DB_File.pm
+*** perl5.002b1f/ext/DB_File/DB_File.pm	Tue Nov 14 14:14:25 1995
+--- perl5.002b1g/ext/DB_File/DB_File.pm	Thu Dec 21 13:00:58 1995
+
+Index: ext/POSIX/POSIX.pm
+*** perl5.002b1f/ext/POSIX/POSIX.pm	Fri Dec  8 10:23:54 1995
+--- perl5.002b1g/ext/POSIX/POSIX.pm	Thu Dec 21 13:00:58 1995
+
+Index: ext/POSIX/POSIX.pod
+*** perl5.002b1f/ext/POSIX/POSIX.pod	Fri Dec  8 10:30:40 1995
+--- perl5.002b1g/ext/POSIX/POSIX.pod	Thu Dec 21 13:00:59 1995
+
+Index: ext/Safe/Makefile.PL
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/ext/Safe/Makefile.PL	Thu Dec 21 13:01:00 1995
+
+Index: ext/Safe/Safe.pm
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/ext/Safe/Safe.pm	Thu Dec 21 13:01:00 1995
+
+Index: ext/Safe/Safe.xs
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/ext/Safe/Safe.xs	Thu Dec 21 13:01:00 1995
+
+Index: ext/Socket/Socket.pm
+*** perl5.002b1f/ext/Socket/Socket.pm	Wed Dec  6 13:58:41 1995
+--- perl5.002b1g/ext/Socket/Socket.pm	Thu Dec 21 13:01:00 1995
+
+Index: installman
+*** perl5.002b1f/installman	Mon Nov  6 11:16:43 1995
+--- perl5.002b1g/installman	Thu Dec 21 13:01:00 1995
+
+Index: lib/AutoSplit.pm
+*** perl5.002b1f/lib/AutoSplit.pm	Wed Nov 15 15:06:19 1995
+--- perl5.002b1g/lib/AutoSplit.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/Cwd.pm
+*** perl5.002b1f/lib/Cwd.pm	Fri Dec  8 10:42:46 1995
+--- perl5.002b1g/lib/Cwd.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/Devel/SelfStubber.pm
+*** perl5.002b1f/lib/Devel/SelfStubber.pm	Sun Nov 26 16:59:51 1995
+--- perl5.002b1g/lib/Devel/SelfStubber.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/Env.pm
+*** perl5.002b1f/lib/Env.pm	Tue Oct 18 12:34:43 1994
+--- perl5.002b1g/lib/Env.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/Exporter.pm
+*** perl5.002b1f/lib/Exporter.pm	Wed Nov 15 15:19:33 1995
+--- perl5.002b1g/lib/Exporter.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/ExtUtils/Liblist.pm
+*** perl5.002b1f/lib/ExtUtils/Liblist.pm	Tue Dec  5 07:56:53 1995
+--- perl5.002b1g/lib/ExtUtils/Liblist.pm	Thu Dec 21 13:01:01 1995
+
+Index: lib/ExtUtils/MakeMaker.pm
+Prereq:  1.115 
+*** perl5.002b1f/lib/ExtUtils/MakeMaker.pm	Tue Dec  5 13:20:56 1995
+--- perl5.002b1g/lib/ExtUtils/MakeMaker.pm	Thu Dec 21 13:01:02 1995
+
+Index: lib/ExtUtils/Manifest.pm
+*** perl5.002b1f/lib/ExtUtils/Manifest.pm	Tue Dec  5 13:21:00 1995
+--- perl5.002b1g/lib/ExtUtils/Manifest.pm	Thu Dec 21 13:01:02 1995
+
+Index: lib/ExtUtils/Mkbootstrap.pm
+*** perl5.002b1f/lib/ExtUtils/Mkbootstrap.pm	Thu Oct 19 05:58:34 1995
+--- perl5.002b1g/lib/ExtUtils/Mkbootstrap.pm	Thu Dec 21 13:01:02 1995
+
+Index: lib/FileHandle.pm
+*** perl5.002b1f/lib/FileHandle.pm	Thu May 25 11:18:20 1995
+--- perl5.002b1g/lib/FileHandle.pm	Thu Dec 21 13:01:02 1995
+
+Index: lib/IPC/Open2.pm
+*** perl5.002b1f/lib/IPC/Open2.pm	Thu May 25 11:31:07 1995
+--- perl5.002b1g/lib/IPC/Open2.pm	Thu Dec 21 13:01:03 1995
+
+Index: lib/IPC/Open3.pm
+Prereq:  1.1 
+*** perl5.002b1f/lib/IPC/Open3.pm	Wed Nov 15 15:21:11 1995
+--- perl5.002b1g/lib/IPC/Open3.pm	Thu Dec 21 13:01:03 1995
+
+Index: lib/SelfLoader.pm
+*** perl5.002b1f/lib/SelfLoader.pm	Sun Nov 26 16:59:51 1995
+--- perl5.002b1g/lib/SelfLoader.pm	Thu Dec 21 13:01:03 1995
+
+Index: lib/Sys/Hostname.pm
+*** perl5.002b1f/lib/Sys/Hostname.pm	Tue Oct 18 12:38:25 1994
+--- perl5.002b1g/lib/Sys/Hostname.pm	Thu Dec 21 13:01:03 1995
+
+Index: lib/Sys/Syslog.pm
+*** perl5.002b1f/lib/Sys/Syslog.pm	Wed Dec  6 14:07:54 1995
+--- perl5.002b1g/lib/Sys/Syslog.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Term/Cap.pm
+*** perl5.002b1f/lib/Term/Cap.pm	Sun Mar 12 00:14:42 1995
+--- perl5.002b1g/lib/Term/Cap.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Term/Complete.pm
+*** perl5.002b1f/lib/Term/Complete.pm	Wed May 24 12:09:48 1995
+--- perl5.002b1g/lib/Term/Complete.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Test/Harness.pm
+*** perl5.002b1f/lib/Test/Harness.pm	Mon Nov 13 23:01:40 1995
+--- perl5.002b1g/lib/Test/Harness.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Text/Soundex.pm
+Prereq:  1.2 
+*** perl5.002b1f/lib/Text/Soundex.pm	Tue Oct 18 12:38:42 1994
+--- perl5.002b1g/lib/Text/Soundex.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Text/Tabs.pm
+*** perl5.002b1f/lib/Text/Tabs.pm	Sat Nov 18 16:08:55 1995
+--- perl5.002b1g/lib/Text/Tabs.pm	Thu Dec 21 13:01:04 1995
+
+Index: lib/Text/Wrap.pm
+*** perl5.002b1f/lib/Text/Wrap.pm	Sat Nov 18 16:08:56 1995
+--- perl5.002b1g/lib/Text/Wrap.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/TieHash.pm
+*** perl5.002b1f/lib/TieHash.pm	Wed Nov 15 15:27:47 1995
+--- perl5.002b1g/lib/TieHash.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/Time/Local.pm
+*** perl5.002b1f/lib/Time/Local.pm	Tue Oct 18 12:38:47 1994
+--- perl5.002b1g/lib/Time/Local.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/less.pm
+*** perl5.002b1f/lib/less.pm	Thu May 25 11:19:59 1995
+--- perl5.002b1g/lib/less.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/overload.pm
+*** perl5.002b1f/lib/overload.pm	Sat Nov 18 16:03:33 1995
+--- perl5.002b1g/lib/overload.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/strict.pm
+*** perl5.002b1f/lib/strict.pm	Thu May 25 11:20:27 1995
+--- perl5.002b1g/lib/strict.pm	Thu Dec 21 13:01:05 1995
+
+Index: lib/syslog.pl
+*** perl5.002b1f/lib/syslog.pl	Tue Oct 18 12:37:13 1994
+--- perl5.002b1g/lib/syslog.pl	Thu Dec 21 13:01:05 1995
+
+Index: perl.c
+*** perl5.002b1f/perl.c	Sun Nov 19 16:11:29 1995
+--- perl5.002b1g/perl.c	Thu Dec 21 13:01:06 1995
+
+Index: pod/Makefile
+*** perl5.002b1f/pod/Makefile	Mon Nov 20 13:00:50 1995
+--- perl5.002b1g/pod/Makefile	Thu Dec 21 13:01:06 1995
+
+Index: pod/PerlDoc/Functions.pm
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/PerlDoc/Functions.pm	Thu Dec 21 13:01:07 1995
+
+Index: pod/PerlDoc/Functions.pm.POSIX
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/PerlDoc/Functions.pm.POSIX	Thu Dec 21 13:01:07 1995
+
+Index: pod/buildtoc
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/buildtoc	Thu Dec 21 13:01:07 1995
+
+Index: pod/perl.pod
+*** perl5.002b1f/pod/perl.pod	Sat Nov 18 17:23:58 1995
+--- perl5.002b1g/pod/perl.pod	Thu Dec 21 13:01:07 1995
+
+Index: pod/perlbot.pod
+*** perl5.002b1f/pod/perlbot.pod	Fri Nov 10 17:27:33 1995
+--- perl5.002b1g/pod/perlbot.pod	Thu Dec 21 13:01:07 1995
+
+Index: pod/perldata.pod
+*** perl5.002b1f/pod/perldata.pod	Sat Nov 18 17:23:59 1995
+--- perl5.002b1g/pod/perldata.pod	Thu Dec 21 13:01:07 1995
+
+Index: pod/perldiag.pod
+*** perl5.002b1f/pod/perldiag.pod	Sun Nov 19 22:10:58 1995
+--- perl5.002b1g/pod/perldiag.pod	Thu Dec 21 13:01:08 1995
+
+Index: pod/perldsc.pod
+*** perl5.002b1f/pod/perldsc.pod	Sat Nov 18 17:24:22 1995
+--- perl5.002b1g/pod/perldsc.pod	Thu Dec 21 13:01:08 1995
+
+Index: pod/perlembed.pod
+*** perl5.002b1f/pod/perlembed.pod	Tue Oct 18 12:39:24 1994
+--- perl5.002b1g/pod/perlembed.pod	Thu Dec 21 13:01:09 1995
+
+Index: pod/perlform.pod
+*** perl5.002b1f/pod/perlform.pod	Sat Nov 18 17:23:59 1995
+--- perl5.002b1g/pod/perlform.pod	Thu Dec 21 13:01:09 1995
+
+Index: pod/perlfunc.pod
+*** perl5.002b1f/pod/perlfunc.pod	Sat Nov 18 17:24:01 1995
+--- perl5.002b1g/pod/perlfunc.pod	Thu Dec 21 13:01:09 1995
+
+Index: pod/perlguts.pod
+*** perl5.002b1f/pod/perlguts.pod	Tue Oct 31 15:38:18 1995
+--- perl5.002b1g/pod/perlguts.pod	Thu Dec 21 13:01:10 1995
+
+Index: pod/perlipc.pod
+*** perl5.002b1f/pod/perlipc.pod	Sat Nov 18 17:24:02 1995
+--- perl5.002b1g/pod/perlipc.pod	Thu Dec 21 13:01:11 1995
+
+Index: pod/perllol.pod
+*** perl5.002b1f/pod/perllol.pod	Sat Nov 18 17:24:22 1995
+--- perl5.002b1g/pod/perllol.pod	Thu Dec 21 13:01:11 1995
+
+Index: pod/perlmod.pod
+*** perl5.002b1f/pod/perlmod.pod	Sat Nov 18 17:24:03 1995
+--- perl5.002b1g/pod/perlmod.pod	Thu Dec 21 13:01:11 1995
+
+Index: pod/perlobj.pod
+*** perl5.002b1f/pod/perlobj.pod	Sun Mar 12 00:48:38 1995
+--- perl5.002b1g/pod/perlobj.pod	Thu Dec 21 13:01:11 1995
+
+Index: pod/perlop.pod
+*** perl5.002b1f/pod/perlop.pod	Sat Nov 18 17:24:03 1995
+--- perl5.002b1g/pod/perlop.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlovl.pod
+*** perl5.002b1f/pod/perlovl.pod	Mon Jan 23 13:25:35 1995
+--- perl5.002b1g/pod/perlovl.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlpod.pod
+*** perl5.002b1f/pod/perlpod.pod	Sun Nov 19 22:22:59 1995
+--- perl5.002b1g/pod/perlpod.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlre.pod
+*** perl5.002b1f/pod/perlre.pod	Sun Nov 26 16:57:20 1995
+--- perl5.002b1g/pod/perlre.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlref.pod
+*** perl5.002b1f/pod/perlref.pod	Sat Nov 18 17:24:04 1995
+--- perl5.002b1g/pod/perlref.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlrun.pod
+*** perl5.002b1f/pod/perlrun.pod	Wed Feb 22 18:32:59 1995
+--- perl5.002b1g/pod/perlrun.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlsec.pod
+*** perl5.002b1f/pod/perlsec.pod	Wed Feb 22 18:33:02 1995
+--- perl5.002b1g/pod/perlsec.pod	Thu Dec 21 13:01:12 1995
+
+Index: pod/perlstyle.pod
+*** perl5.002b1f/pod/perlstyle.pod	Tue Oct 18 12:40:13 1994
+--- perl5.002b1g/pod/perlstyle.pod	Thu Dec 21 13:01:13 1995
+
+Index: pod/perlsub.pod
+*** perl5.002b1f/pod/perlsub.pod	Sun Mar 12 22:42:58 1995
+--- perl5.002b1g/pod/perlsub.pod	Thu Dec 21 13:01:13 1995
+
+Index: pod/perlsyn.pod
+*** perl5.002b1f/pod/perlsyn.pod	Sat Nov 18 17:24:04 1995
+--- perl5.002b1g/pod/perlsyn.pod	Thu Dec 21 13:01:14 1995
+
+Index: pod/perltie.pod
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/perltie.pod	Thu Dec 21 13:01:14 1995
+
+Index: pod/perltoc.pod
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/perltoc.pod	Thu Dec 21 13:01:14 1995
+
+Index: pod/perltrap.pod
+*** perl5.002b1f/pod/perltrap.pod	Wed Nov 15 21:36:11 1995
+--- perl5.002b1g/pod/perltrap.pod	Thu Dec 21 13:01:14 1995
+
+Index: pod/perlvar.pod
+*** perl5.002b1f/pod/perlvar.pod	Wed Nov 15 21:36:59 1995
+--- perl5.002b1g/pod/perlvar.pod	Thu Dec 21 13:01:15 1995
+
+Index: pod/perlxs.pod
+*** perl5.002b1f/pod/perlxs.pod	Sun Nov 19 22:12:44 1995
+--- perl5.002b1g/pod/perlxs.pod	Thu Dec 21 13:01:15 1995
+
+Index: pod/perlxstut.pod
+*** perl5.002b1f/pod/perlxstut.pod	Mon Nov 20 13:02:12 1995
+--- perl5.002b1g/pod/perlxstut.pod	Thu Dec 21 13:01:15 1995
+
+Index: pod/pod2man.PL
+Prereq:  1.5 
+*** perl5.002b1f/pod/pod2man.PL	Wed Nov 15 22:32:51 1995
+--- perl5.002b1g/pod/pod2man.PL	Thu Dec 21 13:01:15 1995
+
+Index: pod/pod2text
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/pod2text	Thu Dec 21 13:01:16 1995
+
+Index: pod/roffitall
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/roffitall	Thu Dec 21 13:01:16 1995
+
+Index: pod/splitpod
+*** /dev/null	Wed Jan  3 14:35:56 1996
+--- perl5.002b1g/pod/splitpod	Thu Dec 21 13:01:16 1995
+
+=item patch.2b1f
+
+This is patch.2b1f to perl5.002beta1.
+
+Index: Changes.Conf
+
+Include 5.001m -> 5.002beta1 changes.
+
+*** perl5.002b1e/Changes.Conf	Mon Nov 20 10:08:05 1995
+--- perl5.002b1f/Changes.Conf	Wed Dec  6 15:29:48 1995
+
+Index: Configure
+
+    Include Jeff Okamoto's patch to allow arbitrary specification
+    of $startperl.  
+
+    As requested, I have moved site_perl to be under
+    $privlib, by default.  The default will now be
+    /usr/local/lib/perl5/site_perl.  This is in accord with the way
+    emacs used to do it :-).
+    
+
+Prereq:  3.0.1.8 
+*** perl5.002b1e/Configure	Fri Dec  8 14:55:26 1995
+--- perl5.002b1f/Configure	Fri Dec  8 11:23:56 1995
+
+Index: MANIFEST
+    Add in POSIX.pod.  I didn't include Dean's mkposixman tool because
+    it seemed to confuse MakeMaker, and I didn't want to manually fix
+    the POSIX/Makefile.PL file today.
+
+    Renamed minimod.PL.  The idea is as follows:  I'd like to reserve
+    the .PL suffix for files that are extracted during build time, and
+    then can be deleted after installation.  That is, it will be
+    analogous to the .SH suffix.  For example, h2xs.PL creates
+    h2xs, and a 'make realclean' will remove the h2xs.  Minimod.PL
+    was an exception to this pattern.  Eventually, the .PL dependencies
+    will be generated automatically, just as the .SH dependencies are
+    now.
+
+    Add in socket test.
+
+*** perl5.002b1e/MANIFEST	Fri Dec  8 14:55:27 1995
+--- perl5.002b1f/MANIFEST	Fri Dec  8 13:34:53 1995
+
+Index: Makefile.SH
+
+    Renamed minimod.PL to minimod.pl
+
+*** perl5.002b1e/Makefile.SH	Mon Nov 20 15:56:12 1995
+--- perl5.002b1f/Makefile.SH	Fri Dec  8 10:36:33 1995
+
+Index: XSUB.h
+
+    Include (SV*) cast in the newXSproto #define.
+
+*** perl5.002b1e/XSUB.h	Fri Dec  8 14:55:14 1995
+--- perl5.002b1f/XSUB.h	Wed Dec  6 13:25:26 1995
+
+Index: ext/POSIX/POSIX.pm
+
+    I have included Dean's patch and the .pod generated by mkposixman.
+
+*** perl5.002b1e/ext/POSIX/POSIX.pm	Wed Nov 15 14:54:09 1995
+--- perl5.002b1f/ext/POSIX/POSIX.pm	Fri Dec  8 10:23:54 1995
+
+Index: ext/POSIX/POSIX.pod
+
+    I have included Dean's patch and the .pod generated by mkposixman.
+
+*** /dev/null	Fri Dec  8 13:36:14 1995
+--- perl5.002b1f/ext/POSIX/POSIX.pod	Fri Dec  8 10:30:40 1995
+
+Index: ext/POSIX/POSIX.xs
+
+    I have included Dean's patch and the .pod generated by mkposixman.
+
+*** perl5.002b1e/ext/POSIX/POSIX.xs	Wed Nov 15 14:56:22 1995
+--- perl5.002b1f/ext/POSIX/POSIX.xs	Fri Dec  8 10:23:54 1995
+
+Index: ext/Socket/Socket.pm
+
+    Replace errant sockaddr_in by correct sockaddr_un.
+    Remove an extra ')'.  -- from Tom C.
+
+*** perl5.002b1e/ext/Socket/Socket.pm	Fri Dec  8 14:55:28 1995
+--- perl5.002b1f/ext/Socket/Socket.pm	Wed Dec  6 13:58:41 1995
+
+Index: gv.c
+
+    Fix from Nick Ing-Simmons to get HvNAME(stash) from caller's
+    package.
+
+*** perl5.002b1e/gv.c	Wed Nov 15 14:58:39 1995
+--- perl5.002b1f/gv.c	Fri Dec  8 10:37:22 1995
+
+Index: lib/Cwd.pm
+
+    Fix a long-standing problem where insufficient permissions higher
+    up in the directory tree caused getcwd to fail.  This often showed
+    up on AFS.
+
+*** perl5.002b1e/lib/Cwd.pm	Mon Nov 13 23:01:38 1995
+--- perl5.002b1f/lib/Cwd.pm	Fri Dec  8 10:42:46 1995
+
+Index: lib/Sys/Syslog.pm
+
+    Modernize Syslog.pm to 'use Socket;' and 'use Sys::Hostname'.
+    Alas, I've lost the attribution for this patch.  Sorry about
+    that.
+
+*** perl5.002b1e/lib/Sys/Syslog.pm	Thu Feb  9 20:05:36 1995
+--- perl5.002b1f/lib/Sys/Syslog.pm	Wed Dec  6 14:07:54 1995
+
+Index: lib/diagnostics.pm
+
+    Fixes from Tom.
+
+*** perl5.002b1e/lib/diagnostics.pm	Tue Nov 14 16:16:36 1995
+--- perl5.002b1f/lib/diagnostics.pm	Wed Dec  6 13:58:42 1995
+
+Index: t/lib/socket.t
+
+    New test from Tom.  I've allowed it to fail if the echo service is
+    disabled, as is apparently the case on some systems.
+
+*** /dev/null	Fri Dec  8 13:36:14 1995
+--- perl5.002b1f/t/lib/socket.t	Fri Dec  8 11:16:01 1995
+
+Index: toke.c
+    
+    A patch from Paul Marquess "purely for source filters".
+
+*** perl5.002b1e/toke.c	Wed Nov 15 22:08:23 1995
+--- perl5.002b1f/toke.c	Wed Dec  6 13:24:19 1995
+
+=item patch.2b1e
+
+This is patch.2b1e to perl5.002beta1.  This is simply
+an upgrade from MakeMaker-5.10 to MakeMaker-5.11.
+
+
+Index: lib/ExtUtils/Liblist.pm
+*** perl5.002b1d/lib/ExtUtils/Liblist.pm	Sat Dec  2 16:50:47 1995
+--- perl5.002b1e/lib/ExtUtils/Liblist.pm	Wed Dec  6 11:52:22 1995
+
+Index: lib/ExtUtils/MakeMaker.pm
+Prereq:  1.114 
+*** perl5.002b1d/lib/ExtUtils/MakeMaker.pm	Sat Dec  2 16:50:48 1995
+--- perl5.002b1e/lib/ExtUtils/MakeMaker.pm	Wed Dec  6 11:52:22 1995
+
+Index: lib/ExtUtils/Manifest.pm
+*** perl5.002b1d/lib/ExtUtils/Manifest.pm	Sat Dec  2 16:50:48 1995
+--- perl5.002b1e/lib/ExtUtils/Manifest.pm	Wed Dec  6 11:52:22 1995
+
+=item patch.2b1d
+
+This is patch.2b1d to perl5.002beta1.
+
+This patch includes patches for the following items:
+
+    NETaa14710:	Included bsdi_bsdos.sh hint file.
+
+    pod/perlre.pod:  Mention 32bit limit.
+
+    Configure Updates.
+
+    Update Socket.xs to version 1.5.  This handles
+    systems that might not have <sys/un.h>.
+
+    Fix missing quotes in h2ph.PL
+
+These are each described in detail below, after the corresponding
+index line.
+
+Index: Configure
+
+    locincpth should now work as documented in INSTALL
+
+    Improved guessing of man1dir
+
+    Remove spurious semicolon in NONBLOCK testing.
+
+    Send failed './loc' message to fd 4.
+
+    Check for <sys/un.h>
+
+    Allow 'unixisms' to be overridden by hint files.
+
+    Remove -r test from './loc' since some executables are
+    not readable.
+
+    Remove spurious doublings of -L/usr/local/lib when reusing old
+    config.sh.
+
+    Improved domain name guessing, from 
+    Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+
+    Include sitelib (architecture-independent directory).
+
+
+Prereq:  3.0.1.8 
+*** perl5.002b1c/Configure	Mon Nov 20 10:00:33 1995
+--- perl5.002b1d/Configure	Sat Dec  2 15:35:13 1995
+
+Index: INSTALL
+
+    Consistently use "sh Configure" in examples.
+
+    Add reminder that interactive use may be helpful.
+
+*** perl5.002b1c/INSTALL	Mon Nov 20 10:46:48 1995
+--- perl5.002b1d/INSTALL	Tue Nov 21 22:54:28 1995
+
+Index: MANIFEST
+    
+    Include renamed hint file.
+
+*** perl5.002b1c/MANIFEST	Sat Dec  2 16:20:21 1995
+--- perl5.002b1d/MANIFEST	Sun Nov 26 17:03:31 1995
+
+Index: config_h.SH
+
+    Include check for <sys/un.h>.
+    
+    Include SITELIB_EXP definition for architecture-independent
+    site-specific modules.  Usually, this will be
+    /usr/local/lib/site_perl.
+
+Prereq:  3.0.1.4 
+*** perl5.002b1c/config_h.SH	Mon Nov 20 10:00:33 1995
+--- perl5.002b1d/config_h.SH	Sat Dec  2 15:35:13 1995
+
+Index: ext/Socket/Makefile.PL
+
+    Update version number to 1.5.
+
+*** perl5.002b1c/ext/Socket/Makefile.PL	Sat Nov 18 15:36:56 1995
+--- perl5.002b1d/ext/Socket/Makefile.PL	Sat Dec  2 16:23:52 1995
+
+Index: ext/Socket/Socket.pm
+
+    Update to version 1.5.
+
+*** perl5.002b1c/ext/Socket/Socket.pm	Sat Nov 18 15:37:03 1995
+--- perl5.002b1d/ext/Socket/Socket.pm	Sat Dec  2 16:25:17 1995
+
+Index: ext/Socket/Socket.xs
+
+    Update to version 1.5.
+    This only supports the sockaddr_un -related functions if your
+    system has <sys/un.h>.  SVR3 systems generally don't.
+
+*** perl5.002b1c/ext/Socket/Socket.xs	Sat Nov 18 15:36:57 1995
+--- perl5.002b1d/ext/Socket/Socket.xs	Sat Dec  2 15:46:20 1995
+
+Index: h2ph.PL
+
+    Add missing quotes.
+
+*** perl5.002b1c/h2ph.PL	Sun Nov 19 23:00:39 1995
+--- perl5.002b1d/h2ph.PL	Mon Nov 27 10:14:50 1995
+
+Index: hints/bsdi_bsdos.sh
+
+    Updated and renamed file.
+
+*** perl5.002b1c/hints/bsdi_bsdos.sh	Thu Jan 19 19:08:34 1995
+--- perl5.002b1d/hints/bsdi_bsdos.sh	Sun Nov 26 16:50:26 1995
+
+Index: pod/perlre.pod
+
+    Mention 65536 limit explicitly.
+
+*** perl5.002b1c/pod/perlre.pod	Wed Nov 15 21:35:31 1995
+--- perl5.002b1d/pod/perlre.pod	Sun Nov 26 16:57:20 1995
+
+=item patch.2b1c
+
+This is patch.2b1c to perl5.002beta1.  This patch includes
+    lib/SelfLoader, version 1.06, and 
+    lib/Devel/SelfStubber, version 1.01.
+These versions include prototype support.
+
+This is simply re-posting these library modules.
+I have also updated MANIFEST to include them.
+
+
+Index: MANIFEST
+*** perl5.002b1b/MANIFEST	Sat Dec  2 16:13:24 1995
+--- perl5.002b1c/MANIFEST	Sat Dec  2 16:12:54 1995
+
+Index: lib/Devel/SelfStubber.pm
+*** /dev/null	Fri Dec  1 16:03:22 1995
+--- perl5.002b1c/lib/Devel/SelfStubber.pm	Sun Nov 26 16:14:19 1995
+
+Index: lib/SelfLoader.pm
+*** /dev/null	Fri Dec  1 16:03:22 1995
+--- perl5.002b1c/lib/SelfLoader.pm	Sun Nov 26 16:14:50 1995
+
+=item patch.2b1b
+
+This is patch.2b1b to perl5.002beta1.  This is simply
+MakeMaker-5.10.  Nothing else is included.
+
+It contains:
+
+Upgrade to MakeMaker-5.10
+and a revised minimod.PL that now writes a pod section into ExtUtils::Miniperl.
+
+Index: lib/ExtUtils/Liblist.pm
+*** perl5.002b1a/lib/ExtUtils/Liblist.pm	Mon Nov 13 22:03:29 1995
+--- perl5.002b1b/lib/ExtUtils/Liblist.pm	Sat Dec  2 15:58:00 1995
+
+Index: lib/ExtUtils/MakeMaker.pm
+*** perl5.002b1a/lib/ExtUtils/MakeMaker.pm	Sat Nov 18 16:01:05 1995
+--- perl5.002b1b/lib/ExtUtils/MakeMaker.pm	Sat Dec  2 15:58:01 1995
+
+Index: lib/ExtUtils/Manifest.pm
+*** perl5.002b1a/lib/ExtUtils/Manifest.pm	Mon Nov 13 22:03:30 1995
+--- perl5.002b1b/lib/ExtUtils/Manifest.pm	Sat Dec  2 15:58:02 1995
+
+Index: minimod.PL
+*** perl5.002b1a/minimod.PL	Sun Nov 19 23:01:02 1995
+--- perl5.002b1b/minimod.PL	Sat Dec  2 15:58:02 1995
+
+=item patch.2b1a  
+
+This is patch.2b1a to perl5.002beta1.  This is simply
+xsubpp-1.944.  It includes perl prototype support.
+
+Index: XSUB.h
+
+Updated to match xsubpp-1.944.  Includes perl prototype support.
+
+*** perl5.002beta1/XSUB.h	Fri Nov 10 13:11:02 1995
+--- perl5.002b1a/XSUB.h	Sat Dec  2 15:43:54 1995
+
+Index: lib/ExtUtils/xsubpp
+
+Updated to xsubpp-1.944.  Includes perl prototype support.
+
+*** perl5.002beta1/lib/ExtUtils/xsubpp	Mon Nov 20 11:03:49 1995
+--- perl5.002b1a/lib/ExtUtils/xsubpp	Sat Dec  2 15:43:55 1995
+
+
+
+Here are the detailed changes from 5.001m to 5.002beta1:
+
+# rm -f Doc/perl5-notes		# Obsolete
+# rm -f c2ph.SH			# Replaced by c2ph.PL
+# rm -f emacs/cperl-mode		# Obsolete
+# rm -f emacs/emacs19		# Obsolete
+# rm -f emacs/perl-mode.el	# Obsolete
+# rm -f emacs/perldb.el		# Obsolete
+# rm -f emacs/perldb.pl		# Obsolete
+# rm -f emacs/tedstuff		# Obsolete
+# rm -f h2ph.SH			# Replaced by h2ph.PL
+# rm -f h2xs.SH			# Replaced by h2xs.PL
+# rm -f hints/hpux_9.sh		# Replaced by generic hpux.sh
+# rm -f hints/sco_3.sh		# Replaced by generic sco.sh
+# rm -f perldoc.SH		# Replaced by perldoc.PL
+# rm -f pod/pod2html.SH		# Replaced by pod2html.PL
+# rm -f pod/pod2latex.SH		# Replaced by pod2latex.PL
+# rm -f pod/pod2man.SH		# Replaced by pod2man.PL
+# rm -f x2p/find2perl.SH		# Replaced by find2perl.PL
+# rm -f x2p/s2p.SH		# Replaced by s2p.PL
+# exit
+
+
+Index: patchlevel.h
+Incremented to 2!
+*** perl5.001.lwall/patchlevel.h	Sun Mar 12 22:29:12 1995
+--- perl5.002beta1/patchlevel.h	Sat Nov 18 15:41:15 1995
+
+Index: Changes
+This includes the Changes file Larry sent me.  I added the first
+paragraph.
+*** perl5.001.lwall/Changes	Mon Mar 13 00:44:07 1995
+--- perl5.002beta1/Changes	Sat Nov 18 15:43:29 1995
+
+Index: Changes.Conf
+An all too brief summary.
+*** perl5.001.lwall/Changes.Conf	Thu Oct 19 21:00:06 1995
+--- perl5.002beta1/Changes.Conf	Mon Nov 20 10:08:05 1995
+
+Index: Configure
+
+Upgraded to metaconfig PL60 (despite the erroneous metaconfig message.
+
+Layed some groundwork for support on non Unix systems, such as OS/2.
+Define things such as  .o vs. .obj,  '' vs. .exe, .a vs. .lib, etc.
+
+Include I_LOCALE testing.
+
+Include checks for new library set-up.  I don't want to ever have to
+change this again.  It's documented more clearly in INSTALL.
+
+Figure out correct string for $startperl (usually
+#!/usr/local/bin/perl).
+
+Improve signal detection even more.  Once again, the signal number
+corresponding to sig_name[n] is n (up to NSIG-1).  Gaps in signal
+numbers (e.g. on Solaris) are allowed and are filled with
+innocuous names such as NUM37 NUM38, etc., where the 37 or 38
+represents the actual signal number.
+
+Prereq:  3.0.1.8 
+*** perl5.001.lwall/Configure	Mon Oct 23 14:08:59 1995
+--- perl5.002beta1/Configure	Mon Nov 20 10:00:33 1995
+
+Index: INSTALL
+
+Explain the library directory structure.
+
+Remove some tailing whitespace.
+
+Indicate that only the interfaces to gdbm and db are provided, not
+the libraries themselves.
+
+Add section on upgrading from previous versions of perl5.00x.
+
+Mention how to override old config.sh with Configure -D and -O.
+
+*** perl5.001.lwall/INSTALL	Mon Oct 23 14:10:26 1995
+--- perl5.002beta1/INSTALL	Mon Nov 20 10:46:48 1995
+
+Index: MANIFEST
+
+In an attempt to make the distribution slightly less Unix specific,
+I've changed .SH extraction to a .PL extraction where possible.
+That way folks on systems without a shell can still get the
+auxilliarly files such as find2perl (assuming they *can* build
+perl).
+
+The emacs/ directory was hopelessly out of date.  I don't use emacs,
+but included a current cperl-mode.el
+
+*** perl5.001.lwall/MANIFEST	Tue Nov 14 15:21:03 1995
+--- perl5.002beta1/MANIFEST	Mon Nov 20 12:40:41 1995
+
+Index: Makefile.SH
+
+Add variables for non unix systems.
+
+Add .PL file extraction logic.
+
+*** perl5.001.lwall/Makefile.SH	Tue Nov 14 20:25:48 1995
+--- perl5.002beta1/Makefile.SH	Mon Nov 20 15:56:12 1995
+
+Index: XSUB.h
+
+Protect arguments of macros with ().
+
+*** perl5.001.lwall/XSUB.h	Tue Mar  7 14:10:00 1995
+--- perl5.002beta1/XSUB.h	Fri Nov 10 13:11:02 1995
+
+Index: c2ph.PL
+Replaces c2ph.SH. 
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/c2ph.PL	Mon Nov 20 12:36:17 1995
+
+Index: cflags.SH
+Allow for .o or .obj in file names.
+*** perl5.001.lwall/cflags.SH	Thu Jan 19 19:06:13 1995
+--- perl5.002beta1/cflags.SH	Tue Nov 14 15:18:41 1995
+
+Index: config_H
+Updated.
+Prereq:  3.0.1.3 
+*** perl5.001.lwall/config_H	Thu Oct 19 21:01:14 1995
+--- perl5.002beta1/config_H	Mon Nov 20 15:41:49 1995
+
+Index: config_h.SH
+Updated to match new Configure.
+Prereq:  3.0.1.3 
+*** perl5.001.lwall/config_h.SH	Mon Oct 23 14:10:38 1995
+--- perl5.002beta1/config_h.SH	Mon Nov 20 10:00:33 1995
+
+Index: configpm
+Add in routine to print out full config.sh file.
+*** perl5.001.lwall/configpm	Wed Jun  7 19:46:01 1995
+--- perl5.002beta1/configpm	Tue Oct 31 11:51:52 1995
+
+Index: doop.c
+Check for sprintf memory overflow that can arise from things
+like %999999s.
+
+*** perl5.001.lwall/doop.c	Sun Jul  2 23:33:44 1995
+--- perl5.002beta1/doop.c	Wed Nov 15 15:08:01 1995
+
+Index: emacs/cperl-mode.el
+New version.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/emacs/cperl-mode.el	Sat Nov 11 16:29:33 1995
+
+Index: embed.h
+Remove unnecessary whichsigname introduced in patch.1n.
+*** perl5.001.lwall/embed.h	Tue Nov 14 15:21:08 1995
+--- perl5.002beta1/embed.h	Wed Nov 15 14:48:47 1995
+
+Index: ext/DB_File/DB_File.pm
+Updated to version 1.01.
+*** perl5.001.lwall/ext/DB_File/DB_File.pm	Wed Jun  7 19:46:14 1995
+--- perl5.002beta1/ext/DB_File/DB_File.pm	Tue Nov 14 14:14:25 1995
+
+Index: ext/DB_File/DB_File.xs
+Updated to version 1.01.
+*** perl5.001.lwall/ext/DB_File/DB_File.xs	Wed Jun  7 19:46:17 1995
+--- perl5.002beta1/ext/DB_File/DB_File.xs	Tue Nov 14 14:14:37 1995
+
+Index: ext/DB_File/Makefile.PL
+Updated to version 1.01.
+*** perl5.001.lwall/ext/DB_File/Makefile.PL	Wed Feb 22 14:36:32 1995
+--- perl5.002beta1/ext/DB_File/Makefile.PL	Tue Nov 14 14:14:17 1995
+
+Index: ext/DB_File/typemap
+Fix typemap to avoid core dump.
+*** perl5.001.lwall/ext/DB_File/typemap	Tue Oct 18 12:27:52 1994
+--- perl5.002beta1/ext/DB_File/typemap	Tue Oct 31 11:53:28 1995
+
+Index: ext/DynaLoader/DynaLoader.pm
+Add parentheses to Carp::confess call.
+*** perl5.001.lwall/ext/DynaLoader/DynaLoader.pm	Thu Oct 19 20:13:25 1995
+--- perl5.002beta1/ext/DynaLoader/DynaLoader.pm	Fri Nov 10 11:49:00 1995
+
+Index: ext/DynaLoader/dl_os2.xs
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/ext/DynaLoader/dl_os2.xs	Mon Nov 13 22:58:42 1995
+
+Index: ext/Fcntl/Fcntl.xs
+Add O_BINARY define for OS/2.
+*** perl5.001.lwall/ext/Fcntl/Fcntl.xs	Mon Oct 23 14:10:54 1995
+--- perl5.002beta1/ext/Fcntl/Fcntl.xs	Mon Nov 13 23:01:40 1995
+
+Index: ext/GDBM_File/GDBM_File.pm
+Added a tiny bit of documentation, including how to get gdbm.
+Shamelessly stolen from the DB_File.pm documentation.
+*** perl5.001.lwall/ext/GDBM_File/GDBM_File.pm	Wed Jun  7 19:46:34 1995
+--- perl5.002beta1/ext/GDBM_File/GDBM_File.pm	Mon Nov 20 10:22:26 1995
+
+Index: ext/GDBM_File/GDBM_File.xs
+Add gdbm_EXISTS #define.
+*** perl5.001.lwall/ext/GDBM_File/GDBM_File.xs	Sat Jul  1 18:44:02 1995
+--- perl5.002beta1/ext/GDBM_File/GDBM_File.xs	Sat Nov 11 14:25:50 1995
+
+Index: ext/NDBM_File/hints/solaris.pl
+Updated for MakeMaker 5.0x.
+*** perl5.001.lwall/ext/NDBM_File/hints/solaris.pl	Wed Jun  7 19:46:39 1995
+--- perl5.002beta1/ext/NDBM_File/hints/solaris.pl	Fri Nov 10 10:39:23 1995
+
+Index: ext/ODBM_File/hints/sco.pl
+Updated for MakeMaker 5.0x.
+*** perl5.001.lwall/ext/ODBM_File/hints/sco.pl	Wed Jun  7 19:46:44 1995
+--- perl5.002beta1/ext/ODBM_File/hints/sco.pl	Fri Nov 10 10:39:32 1995
+
+Index: ext/ODBM_File/hints/solaris.pl
+Updated for MakeMaker 5.0x.
+*** perl5.001.lwall/ext/ODBM_File/hints/solaris.pl	Wed Jun  7 19:46:46 1995
+--- perl5.002beta1/ext/ODBM_File/hints/solaris.pl	Fri Nov 10 10:39:44 1995
+
+Index: ext/ODBM_File/hints/svr4.pl
+Updated for MakeMaker 5.0x.
+*** perl5.001.lwall/ext/ODBM_File/hints/svr4.pl	Wed Jun  7 19:46:48 1995
+--- perl5.002beta1/ext/ODBM_File/hints/svr4.pl	Fri Nov 10 10:39:54 1995
+
+Index: ext/POSIX/POSIX.pm
+Remove POSIX_loadlibs relics from perl5alpha days.
+*** perl5.001.lwall/ext/POSIX/POSIX.pm	Thu Sep 21 19:14:19 1995
+--- perl5.002beta1/ext/POSIX/POSIX.pm	Wed Nov 15 14:54:09 1995
+
+Index: ext/POSIX/POSIX.xs
+Change whichsigname(sig) back to sig_name[sig].
+*** perl5.001.lwall/ext/POSIX/POSIX.xs	Mon Oct 23 14:11:01 1995
+--- perl5.002beta1/ext/POSIX/POSIX.xs	Wed Nov 15 14:56:22 1995
+
+Index: ext/SDBM_File/Makefile.PL
+Updated for MakeMaker 5.0x to allow compilation on non-unix systems.
+*** perl5.001.lwall/ext/SDBM_File/Makefile.PL	Thu Jan 19 18:59:02 1995
+--- perl5.002beta1/ext/SDBM_File/Makefile.PL	Tue Nov 14 11:16:43 1995
+
+Index: ext/SDBM_File/sdbm/Makefile.PL
+Updated for MakeMaker 5.0x to allow compilation on non-unix systems.
+*** perl5.001.lwall/ext/SDBM_File/sdbm/Makefile.PL	Wed Feb 22 14:36:47 1995
+--- perl5.002beta1/ext/SDBM_File/sdbm/Makefile.PL	Tue Nov 14 11:17:16 1995
+
+Index: ext/SDBM_File/sdbm/sdbm.c
+Include OS/2 O_BINARY flag.
+Prereq:  1.16 
+*** perl5.001.lwall/ext/SDBM_File/sdbm/sdbm.c	Wed Jun  7 19:46:57 1995
+--- perl5.002beta1/ext/SDBM_File/sdbm/sdbm.c	Mon Nov 13 23:01:41 1995
+
+Index: ext/Socket/Makefile.PL
+Updated to 1.3.  Actually we're up to 1.4, but I forgot to update
+the Makefile.PL.
+*** perl5.001.lwall/ext/Socket/Makefile.PL	Thu Jan 19 18:59:06 1995
+--- perl5.002beta1/ext/Socket/Makefile.PL	Sat Nov 18 15:36:56 1995
+
+Index: ext/Socket/Socket.pm
+Updated to 1.3.  Actually we're up to 1.4, but I forgot to update
+the version number.  This adds some non-portable stuff to manipulate
+structures in <sys/un.h>.  I'll have to #ifdef it out in the next
+patch.
+
+*** perl5.001.lwall/ext/Socket/Socket.pm	Sat Jul  1 15:51:54 1995
+--- perl5.002beta1/ext/Socket/Socket.pm	Sat Nov 18 15:37:03 1995
+
+Index: ext/Socket/Socket.xs
+Updated to 1.3.  Actually we're up to 1.4, but I forgot to update
+the version number.  This adds some non-portable stuff to manipulate
+structures in <sys/un.h>.  I'll have to #ifdef it out in the next
+patch.
+
+*** perl5.001.lwall/ext/Socket/Socket.xs	Sat Jul  1 15:51:56 1995
+--- perl5.002beta1/ext/Socket/Socket.xs	Sat Nov 18 15:36:57 1995
+
+Index: global.sym
+Remove unnecessary whichsigname that was added in patch.1n.
+*** perl5.001.lwall/global.sym	Tue Nov 14 15:21:11 1995
+--- perl5.002beta1/global.sym	Wed Nov 15 14:58:14 1995
+
+Index: h2ph.PL
+Converted from h2ph.SH.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/h2ph.PL	Sun Nov 19 23:00:39 1995
+
+Index: h2xs.PL
+Converted from h2xs.SH.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/h2xs.PL	Sun Nov 19 22:37:58 1995
+
+Index: hints/aix.sh
+Add gcc-specific -Xlinker, if you're using gcc.
+*** perl5.001.lwall/hints/aix.sh	Thu Oct 19 21:02:08 1995
+--- perl5.002beta1/hints/aix.sh	Mon Nov 13 23:03:33 1995
+
+Index: hints/freebsd.sh
+Warn about possible here-document problem.
+*** perl5.001.lwall/hints/freebsd.sh	Sat Jul  1 18:44:07 1995
+--- perl5.002beta1/hints/freebsd.sh	Sat Nov 18 16:21:20 1995
+
+Index: hints/hpux.sh
+Replace old hpux_9.sh, since this works for 9 and 10.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/hints/hpux.sh	Mon Nov 20 09:53:28 1995
+
+Index: hints/irix_6_2.sh
+New hint file.  This should be merged with irix_6.sh, since it's
+almost identical.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/hints/irix_6_2.sh	Mon Nov 20 11:16:55 1995
+
+Index: hints/ncr_tower.sh
+Give pointers about directory functions.
+*** perl5.001.lwall/hints/ncr_tower.sh	Tue Oct 18 12:33:25 1994
+--- perl5.002beta1/hints/ncr_tower.sh	Tue Oct 31 11:57:51 1995
+
+Index: hints/netbsd.sh
+Updated.
+*** perl5.001.lwall/hints/netbsd.sh	Wed Jun  7 19:47:45 1995
+--- perl5.002beta1/hints/netbsd.sh	Mon Nov 13 23:04:17 1995
+
+Index: hints/os2.sh
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/hints/os2.sh	Tue Nov 14 11:07:33 1995
+
+Index: hints/sco.sh
+Renamed from sco_3, since it should apply to most recent versions.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/hints/sco.sh	Mon Jun  5 11:50:11 1995
+
+Index: hints/solaris_2.sh
+Remove temporary file try.c.
+*** perl5.001.lwall/hints/solaris_2.sh	Thu Oct 19 21:02:37 1995
+--- perl5.002beta1/hints/solaris_2.sh	Mon Nov 20 16:01:50 1995
+
+Index: hints/ultrix_4.sh
+Note that you can substitute sh5 for sh to get a big speed up.
+*** perl5.001.lwall/hints/ultrix_4.sh	Mon Feb 13 20:15:05 1995
+--- perl5.002beta1/hints/ultrix_4.sh	Sat Nov 11 17:11:41 1995
+
+Index: installman
+Quit if they just asked for help with -h.
+*** perl5.001.lwall/installman	Sat Jul  1 18:44:09 1995
+--- perl5.002beta1/installman	Mon Nov  6 11:16:43 1995
+
+Index: installperl
+Updated to use Config rather than hand-reading config.sh again.
+
+Install h2ph.
+
+Create site_perl and site_perl/archname directories.
+
+*** perl5.001.lwall/installperl	Sat Jul  1 18:44:12 1995
+--- perl5.002beta1/installperl	Mon Nov 20 12:55:08 1995
+
+Index: lib/AutoSplit.pm
+Handle OS/2 backslashes.
+
+Tim's prototype patch.
+
+Less enthusiastic checking of autoloader_seen.
+
+*** perl5.001.lwall/lib/AutoSplit.pm	Sat Jul  1 15:52:03 1995
+--- perl5.002beta1/lib/AutoSplit.pm	Wed Nov 15 15:06:19 1995
+
+Index: lib/Cwd.pm
+Updated for Unix, NT, and OS/2.
+*** perl5.001.lwall/lib/Cwd.pm	Wed Jun  7 19:48:18 1995
+--- perl5.002beta1/lib/Cwd.pm	Mon Nov 13 23:01:38 1995
+
+Index: lib/ExtUtils/Liblist.pm
+Updated to MakeMaker 5.06.
+*** perl5.001.lwall/lib/ExtUtils/Liblist.pm	Wed Jun  7 19:48:27 1995
+--- perl5.002beta1/lib/ExtUtils/Liblist.pm	Mon Nov 13 22:03:29 1995
+
+Index: lib/ExtUtils/MakeMaker.pm
+Updated to MakeMaker 5.06.
+Prereq:  1.21 
+*** perl5.001.lwall/lib/ExtUtils/MakeMaker.pm	Thu Oct 19 21:02:57 1995
+--- perl5.002beta1/lib/ExtUtils/MakeMaker.pm	Sat Nov 18 16:01:05 1995
+
+Index: lib/ExtUtils/Manifest.pm
+Updated to MakeMaker 5.06.
+*** perl5.001.lwall/lib/ExtUtils/Manifest.pm	Sat Jul  1 15:52:11 1995
+--- perl5.002beta1/lib/ExtUtils/Manifest.pm	Mon Nov 13 22:03:30 1995
+
+Index: lib/ExtUtils/xsubpp
+Updated to xsubpp-1.923.
+*** perl5.001.lwall/lib/ExtUtils/xsubpp	Sat Jul  1 20:08:00 1995
+--- perl5.002beta1/lib/ExtUtils/xsubpp	Mon Nov 20 11:03:49 1995
+
+Index: lib/File/Find.pm
+OS/2 patch for nlink.
+*** perl5.001.lwall/lib/File/Find.pm	Sat Jul  1 15:52:13 1995
+--- perl5.002beta1/lib/File/Find.pm	Wed Nov 15 15:20:03 1995
+
+Index: lib/Net/Ping.pm
+Updated to Net::Ping 1.00.
+*** perl5.001.lwall/lib/Net/Ping.pm	Wed Jun  7 19:49:13 1995
+--- perl5.002beta1/lib/Net/Ping.pm	Tue Oct 31 11:15:55 1995
+
+Index: lib/Shell.pm
+Updated for OS/2 or Unix.
+*** perl5.001.lwall/lib/Shell.pm	Tue Oct 18 12:34:59 1994
+--- perl5.002beta1/lib/Shell.pm	Mon Nov 13 23:01:40 1995
+
+Index: lib/Test/Harness.pm
+Updated for OS/2 or Unix.
+*** perl5.001.lwall/lib/Test/Harness.pm	Tue Oct 18 12:38:35 1994
+--- perl5.002beta1/lib/Test/Harness.pm	Mon Nov 13 23:01:40 1995
+
+Index: lib/Text/Tabs.pm
+Updated.
+*** perl5.001.lwall/lib/Text/Tabs.pm	Wed Jun  7 19:49:20 1995
+--- perl5.002beta1/lib/Text/Tabs.pm	Sat Nov 18 16:08:55 1995
+
+Index: lib/Text/Wrap.pm
+New module.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/lib/Text/Wrap.pm	Sat Nov 18 16:08:56 1995
+
+Index: lib/diagnostics.pm
+New module.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/lib/diagnostics.pm	Tue Nov 14 16:16:36 1995
+
+Index: lib/lib.pm
+Automatically try to load an architecture-dependent library too.
+*** perl5.001.lwall/lib/lib.pm	Sat Jul  1 15:51:37 1995
+--- perl5.002beta1/lib/lib.pm	Fri Nov 10 16:50:43 1995
+
+Index: lib/overload.pm
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/lib/overload.pm	Sat Nov 18 16:03:33 1995
+
+Index: lib/perl5db.pl
+Emacs and OS/2 fixes.
+*** perl5.001.lwall/lib/perl5db.pl	Sun Mar 12 22:34:53 1995
+--- perl5.002beta1/lib/perl5db.pl	Wed Nov 15 22:37:45 1995
+
+Index: lib/splain
+New file -- same as diagnostics.pm.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/lib/splain	Tue Nov 14 16:16:36 1995
+
+Index: mg.c
+Remove unnecessary whichsigname introduced in 5.001n.
+*** perl5.001.lwall/mg.c	Tue Nov 14 15:31:03 1995
+--- perl5.002beta1/mg.c	Wed Nov 15 15:44:10 1995
+
+Index: minimod.PL
+Made c++ friendly.
+*** perl5.001.lwall/minimod.PL	Mon Feb 13 20:15:47 1995
+--- perl5.002beta1/minimod.PL	Sun Nov 19 23:01:02 1995
+
+Index: miniperlmain.c
+Made c++ friendly.
+*** perl5.001.lwall/miniperlmain.c	Mon Feb 13 21:48:50 1995
+--- perl5.002beta1/miniperlmain.c	Sat Nov 18 15:48:10 1995
+
+Index: op.c
+Larry's post 5.001mx prototype patch.
+*** perl5.001.lwall/op.c	Tue Nov 14 20:36:08 1995
+--- perl5.002beta1/op.c	Wed Nov 15 22:10:36 1995
+
+Index: os2/Makefile.SH
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/Makefile.SH	Tue Nov 14 11:07:32 1995
+
+Index: os2/POSIX.mkfifo
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/POSIX.mkfifo	Tue Nov 14 10:48:16 1995
+
+Index: os2/README
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/README	Tue Nov 14 14:42:13 1995
+
+Index: os2/diff.Makefile
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/diff.Makefile	Tue Nov 14 11:09:29 1995
+
+Index: os2/diff.configure
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/diff.configure	Sun Nov 12 01:31:34 1995
+
+Index: os2/diff.installperl
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/diff.installperl	Tue Nov 14 11:09:28 1995
+
+Index: os2/diff.mkdep
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/diff.mkdep	Tue Nov 14 11:09:28 1995
+
+Index: os2/diff.x2pMakefile
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/diff.x2pMakefile	Tue Nov 14 11:09:29 1995
+
+Index: os2/os2.c
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/os2.c	Tue Nov 14 11:07:33 1995
+
+Index: os2/os2ish.h
+New file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/os2/os2ish.h	Tue Nov 14 11:07:33 1995
+
+Index: perl.c
+Add -h option to print out usage.
+
+Add 'beta' to version number.
+
+Add new library hierarchy.  See INSTALL.
+
+*** perl5.001.lwall/perl.c	Tue Nov 14 20:09:28 1995
+--- perl5.002beta1/perl.c	Sun Nov 19 16:11:29 1995
+
+Index: perl.h
+
+Move around some includes for OS/2.
+
+Check for <locale.h>
+
+*** perl5.001.lwall/perl.h	Thu Nov  9 19:50:43 1995
+--- perl5.002beta1/perl.h	Wed Nov 15 17:13:16 1995
+
+Index: perldoc.PL
+
+Moved from perldoc.SH.  Updated to handle no nroff.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/perldoc.PL	Tue Nov 14 14:57:57 1995
+
+Index: pod/Makefile
+Updated for new pods and for new .PL format.
+*** perl5.001.lwall/pod/Makefile	Wed Jun  7 19:50:02 1995
+--- perl5.002beta1/pod/Makefile	Mon Nov 20 13:00:50 1995
+
+Index: pod/perl.pod
+Updated to refer to new pods.
+*** perl5.001.lwall/pod/perl.pod	Thu Oct  5 19:54:43 1995
+--- perl5.002beta1/pod/perl.pod	Sat Nov 18 17:23:58 1995
+
+Index: pod/perlbook.pod
+Updated info.
+*** perl5.001.lwall/pod/perlbook.pod	Wed Feb 22 18:32:35 1995
+--- perl5.002beta1/pod/perlbook.pod	Sat Nov 11 17:17:23 1995
+
+Index: pod/perlbot.pod
+Include SUPER stuff.
+*** perl5.001.lwall/pod/perlbot.pod	Wed Jun  7 19:50:14 1995
+--- perl5.002beta1/pod/perlbot.pod	Fri Nov 10 17:27:33 1995
+
+Index: pod/perlcall.pod
+Change perlapi to perlxs.
+*** perl5.001.lwall/pod/perlcall.pod	Wed Jun  7 19:50:17 1995
+--- perl5.002beta1/pod/perlcall.pod	Tue Oct 31 15:37:57 1995
+
+Index: pod/perldata.pod
+Tom's updates.
+*** perl5.001.lwall/pod/perldata.pod	Sun Mar 12 22:35:14 1995
+--- perl5.002beta1/pod/perldata.pod	Sat Nov 18 17:23:59 1995
+
+Index: pod/perldiag.pod
+Tom's updates.
+*** perl5.001.lwall/pod/perldiag.pod	Tue Nov 14 22:04:11 1995
+--- perl5.002beta1/pod/perldiag.pod	Sun Nov 19 22:10:58 1995
+
+Index: pod/perldsc.pod
+Tom's updates.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/perldsc.pod	Sat Nov 18 17:24:22 1995
+
+Index: pod/perlform.pod
+Tom's updates.
+*** perl5.001.lwall/pod/perlform.pod	Wed Feb 22 18:32:41 1995
+--- perl5.002beta1/pod/perlform.pod	Sat Nov 18 17:23:59 1995
+
+Index: pod/perlfunc.pod
+Tom's updates.
+*** perl5.001.lwall/pod/perlfunc.pod	Tue Nov 14 15:31:33 1995
+--- perl5.002beta1/pod/perlfunc.pod	Sat Nov 18 17:24:01 1995
+
+Index: pod/perlguts.pod
+Change perlapi to perlxs.
+*** perl5.001.lwall/pod/perlguts.pod	Wed Jun  7 19:50:25 1995
+--- perl5.002beta1/pod/perlguts.pod	Tue Oct 31 15:38:18 1995
+
+Index: pod/perlipc.pod
+New file from Tom.
+*** perl5.001.lwall/pod/perlipc.pod	Wed Feb 22 18:32:48 1995
+--- perl5.002beta1/pod/perlipc.pod	Sat Nov 18 17:24:02 1995
+
+Index: pod/perllol.pod
+New file from Tom.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/perllol.pod	Sat Nov 18 17:24:22 1995
+
+Index: pod/perlmod.pod
+Updates from Tom.
+*** perl5.001.lwall/pod/perlmod.pod	Wed Feb 22 18:32:51 1995
+--- perl5.002beta1/pod/perlmod.pod	Sat Nov 18 17:24:03 1995
+
+Index: pod/perlop.pod
+Add missing '>'.
+*** perl5.001.lwall/pod/perlop.pod	Tue Nov 14 15:31:37 1995
+--- perl5.002beta1/pod/perlop.pod	Sat Nov 18 17:24:03 1995
+
+Index: pod/perlpod.pod
+Add note about =cut operator.
+*** perl5.001.lwall/pod/perlpod.pod	Tue Oct 18 12:39:53 1994
+--- perl5.002beta1/pod/perlpod.pod	Sun Nov 19 22:22:59 1995
+
+Index: pod/perlref.pod
+Updates from Tom.
+*** perl5.001.lwall/pod/perlref.pod	Tue Mar  7 00:56:46 1995
+--- perl5.002beta1/pod/perlref.pod	Sat Nov 18 17:24:04 1995
+
+Index: pod/perlsyn.pod
+Updates from Tom.
+*** perl5.001.lwall/pod/perlsyn.pod	Sat Mar 11 14:13:48 1995
+--- perl5.002beta1/pod/perlsyn.pod	Sat Nov 18 17:24:04 1995
+
+Index: pod/perlxs.pod
+Updated.
+*** perl5.001.lwall/pod/perlxs.pod	Tue Nov 14 15:31:42 1995
+--- perl5.002beta1/pod/perlxs.pod	Sun Nov 19 22:12:44 1995
+
+Index: pod/perlxstut.pod
+New file from Jeff.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/perlxstut.pod	Mon Nov 20 13:02:12 1995
+
+Index: pod/pod2html.PL
+Updated -- version 1.15 merges Tom's suggestions and ideas from
+pod2fm.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/pod2html.PL	Sun Nov 19 22:11:59 1995
+
+Index: pod/pod2latex.PL
+Changed to a .PL file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/pod2latex.PL	Wed Nov 15 22:32:39 1995
+
+Index: pod/pod2man.PL
+Changed to a .PL file.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/pod/pod2man.PL	Wed Nov 15 22:32:51 1995
+
+Index: pp_ctl.c
+Add OS/2 stuff.
+*** perl5.001.lwall/pp_ctl.c	Wed Nov 15 00:37:25 1995
+--- perl5.002beta1/pp_ctl.c	Wed Nov 15 21:46:37 1995
+
+Index: pp_sys.c
+Add OS/2 stuff.
+*** perl5.001.lwall/pp_sys.c	Tue Nov 14 21:03:06 1995
+--- perl5.002beta1/pp_sys.c	Wed Nov 15 21:51:33 1995
+
+Index: proto.h
+Add OS/2 stuff to better protect MYMALLOC.
+*** perl5.001.lwall/proto.h	Tue Nov 14 21:01:28 1995
+--- perl5.002beta1/proto.h	Wed Nov 15 21:55:23 1995
+
+Index: t/TEST
+Add OS/2 check for perl.exe.
+*** perl5.001.lwall/t/TEST	Sat Jan 14 19:35:33 1995
+--- perl5.002beta1/t/TEST	Tue Nov 14 11:22:08 1995
+
+Index: t/lib/db-btree.t
+Updated.
+*** perl5.001.lwall/t/lib/db-btree.t	Tue Oct 18 12:44:05 1994
+--- perl5.002beta1/t/lib/db-btree.t	Tue Oct 31 11:53:29 1995
+
+Index: t/op/overload.t
+Updated.
+*** perl5.001.lwall/t/op/overload.t	Tue Nov 14 20:56:57 1995
+--- perl5.002beta1/t/op/overload.t	Mon Nov 20 15:48:56 1995
+
+Index: t/op/stat.t
+Add note about tmpfs failures.
+*** perl5.001.lwall/t/op/stat.t	Tue Oct 18 12:46:23 1994
+--- perl5.002beta1/t/op/stat.t	Wed Nov 15 22:00:50 1995
+
+Index: toke.c
+Patch from Paul M. for source filters.
+*** perl5.001.lwall/toke.c	Tue Nov 14 21:59:50 1995
+--- perl5.002beta1/toke.c	Wed Nov 15 22:08:23 1995
+
+Index: util.c
+Varargs fixes.
+*** perl5.001.lwall/util.c	Wed Jun  7 19:51:19 1995
+--- perl5.002beta1/util.c	Tue Nov 14 10:46:37 1995
+
+Index: writemain.SH
+Make c++ friendly.
+*** perl5.001.lwall/writemain.SH	Wed Feb  8 19:44:20 1995
+--- perl5.002beta1/writemain.SH	Sat Nov 18 15:51:55 1995
+
+Index: x2p/Makefile.SH
+Updated for .PL extraction.
+*** perl5.001.lwall/x2p/Makefile.SH	Wed Jun  7 19:51:37 1995
+--- perl5.002beta1/x2p/Makefile.SH	Sun Nov 19 23:17:39 1995
+
+Index: x2p/a2p.h
+Add OS/2 stuff.
+*** perl5.001.lwall/x2p/a2p.h	Thu Oct 19 21:03:58 1995
+--- perl5.002beta1/x2p/a2p.h	Tue Nov 14 10:46:57 1995
+
+Index: x2p/cflags.SH
+Add .obj for OS/2.
+*** perl5.001.lwall/x2p/cflags.SH	Tue Oct 18 12:47:34 1994
+--- perl5.002beta1/x2p/cflags.SH	Tue Nov 14 15:18:27 1995
+
+Index: x2p/find2perl.PL
+Changed from .SH to .PL.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/x2p/find2perl.PL	Sun Nov 19 23:11:58 1995
+
+Index: x2p/s2p.PL
+Changed from .SH to .PL extraction.
+*** /dev/null	Mon Nov 20 17:28:51 1995
+--- perl5.002beta1/x2p/s2p.PL	Sun Nov 19 23:14:59 1995
+
+-------------
+Version 5.001
+-------------
+
+Summary of user-visible Configure and build changes since 5.000:
+
+A large number of enhancements and fixes have been made to the
+Configure and build process for perl.  Most of these will not be
+visible to the ordinary user--they just make the process more robust
+and likely to work on a wider range of platforms.
+
+This is a brief summary of the most important changes.
+
+Configure changes:
+    New and improved Configure command line options.  -O now overrides
+    config.sh settings.  -D options can now include spaces, if
+    protected in quotes (e.g. -Dcc='gcc -posix').  Type Configure -h
+    for a full listing of options.
+
+    Users can now turn on the defaults for the rest of Configure by
+    typing &-d at any Configure prompt.  This is useful if you just
+    want to change one or two answers.
+
+    Support on (non-Sun) SVR4 systems for dynamic loading and shared 
+    libperl.so
+
+    Numerous new or updated hints files: PowerUnix, aix 3.x and 4.x,
+    bsd386, convexos, cxux, DEC OSF, Esix, FreeBSD, HP-UX (especially if
+    you're using the bundled compiler), irix 4.x, 5.x, and 6.x,  Linux,
+    MPE/IX, NeXT 3.0 and 3.2, Solaris, SVR4, Ultrix (especially 4.3),
+    and Unicos.
+
+    Improved generation of a suitable name for architecture-dependent
+    library files.  NOTE:  This may differ from the name you had from
+    your 5.000 installation.
+
+    Many many portability enhancements and fixes.
+
+Build process:
+
+    The process for building extensions has been extensively revised.  See
+    lib/ExtUtils/MakeMaker.pm for complete documentation.  Basically, with
+    just a simple Makefile.PL (such as the one generated by h2xs), you can
+    now build an extension from anywhere on your system, even if you've
+    deleted the perl source.
+
+    Improved build/install documentation in README.  A little.
+
+    Improved dynamic loading on HP-UX.  Support dynamic loading on SVR4.
+
+    Installperl now gets the version correct :-)
+
+    Installperl now saves the perl *.h files and the libperl.a library
+    in your architecture-dependent library directory so that you can
+    later build extensions without having to re-install the perl
+    source.
+
+    Include x2p/a2p.c generated by byacc from x2p/a2p.y.
+
+    Many many portability fixes.
+
+Upgrade Traps and Pitfalls:
+
+Since a lot has changed in the build process, you are probably best
+off starting with a fresh copy of the perl5.000 sources.  In particular,
+your 5.000 config.sh will contain several variables that are no longer
+needed.  Further, improvements in the Configure tests may mean that some
+of the answers will be different than they were in 5.000, and which answer
+to keep can be difficult to sort out.   Therefore, you are probably
+better off ignoring your old config.sh.
+
+One big change is that architecture-dependent library files may well
+be stored in a different location in 5.001.  This is because the default
+name used in the 5.000 release was not sufficiently specific to
+distinguish incompatible architectures.  The relevant variable is $archlib
+in config.sh.  Before you run ``make install'' you should rename your old
+$archlib.  Thus if your $archlib for version 5.000 was
+/usr/local/lib/perl5/foo, and your new value for 5.001 is
+/usr/local/lib/perl5/foo-bar, then you should
+	mv /usr/local/lib/perl5/foo /usr/local/lib/perl5/foo-bar
+before running  ``make install''.
+
+Alternatively, you could override Configure's default guess for $archlib
+either by  sh Configure -Darchname='foo', or by answering 'foo' when 
+prompted by Configure for the architecture name.
+
+The following is the sequence of steps to upgrade to 5.001:
+	cd perl5.000
+	make realclean
+	rm config.sh
+	<apply 5.001 patch>
+	sh Configure
+	make depend
+	make
+	make test
+	<mv old architecture-dependent library to new location, if needed>
+	make install
+
diff --git a/gnu/usr.bin/perl/Configure b/gnu/usr.bin/perl/Configure
new file mode 100644
index 00000000000..34c39ce30c6
--- /dev/null
+++ b/gnu/usr.bin/perl/Configure
@@ -0,0 +1,9493 @@
+#! /bin/sh
+#
+# If these # comments don't work, trim them. Don't worry about any other
+# shell scripts, Configure will trim # comments from them for you.
+#
+# (If you are trying to port this package to a machine without sh,
+# I would suggest you have a look at the prototypical config_h.SH file
+# and edit it to reflect your system. Some packages may include samples
+# of config.h for certain machines, so you might look for one of those.)
+#
+# Yes, you may rip this off to use in other distribution packages. This
+# script belongs to the public domain and cannot be copyrighted.
+#
+# (Note: this Configure script was generated automatically. Rather than
+# working with this copy of Configure, you may wish to get metaconfig.
+# The dist-3.0 package (which contains metaconfig) was posted in
+# comp.sources.misc so you may fetch it yourself from your nearest
+# archive site. Check with Archie if you don't know where that can be.)
+#
+
+# $Id: Head.U,v 3.0.1.8 1995/07/25 13:40:02 ram Exp $
+#
+# Generated on Wed Feb 21 14:26:18 EST 1996 [metaconfig 3.0 PL60]
+
+cat >/tmp/c1$$ <<EOF
+ARGGGHHHH!!!!!
+
+SCO csh still thinks true is false.  Write to SCO today and tell them that next
+year Configure ought to "rm /bin/csh" unless they fix their blasted shell. :-)
+
+(Actually, Configure ought to just patch csh in place.  Hmm.  Hmmmmm.  All
+we'd have to do is go in and swap the && and || tokens, wherever they are.)
+
+[End of diatribe. We now return you to your regularly scheduled programming...]
+EOF
+cat >/tmp/c2$$ <<EOF
+
+OOPS!  You naughty creature!  You didn't run Configure with sh!
+I will attempt to remedy the situation by running sh for you...
+EOF
+
+true || cat /tmp/c1$$ /tmp/c2$$
+true || exec sh $0 $argv:q
+
+(exit $?0) || cat /tmp/c2$$
+(exit $?0) || exec sh $0 $argv:q
+rm -f /tmp/c1$$ /tmp/c2$$
+
+: compute my invocation name
+me=$0
+case "$0" in
+*/*)
+	me=`echo $0 | sed -e 's!.*/\(.*\)!\1!' 2>/dev/null`
+	test "$me" || me=$0
+	;;
+esac
+
+: Proper PATH separator
+p_=:
+: On OS/2 this directory should exist if this is not floppy only system :-]
+if test -d c:/.; then
+	p_=\;
+	PATH=`cmd /c "echo %PATH%" | tr '\\\\' / `
+	OS2_SHELL=`cmd /c "echo %OS2_SHELL%" | tr '\\\\' / | tr '[A-Z]' '[a-z]'`
+fi
+
+: Proper PATH setting
+paths='/bin /usr/bin /usr/local/bin /usr/ucb /usr/local /usr/lbin'
+paths="$paths /opt/bin /opt/local/bin /opt/local /opt/lbin"
+paths="$paths /usr/5bin /etc /usr/gnu/bin /usr/new /usr/new/bin /usr/nbin"
+paths="$paths /opt/gnu/bin /opt/new /opt/new/bin /opt/nbin"
+paths="$paths /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/ucb"
+paths="$paths /bsd4.3/usr/bin /usr/bsd /bsd43/bin /usr/ccs/bin"
+paths="$paths /etc /usr/lib /usr/ucblib /lib /usr/ccs/lib"
+paths="$paths /sbin /usr/sbin /usr/libexec"
+
+for p in $paths
+do
+	case "$p_$PATH$p_" in
+	*$p_$p$p_*) ;;
+	*) test -d $p && PATH=$PATH$p_$p ;;
+	esac
+done
+
+PATH=.$p_$PATH
+export PATH
+
+: Sanity checks
+if test ! -t 0; then
+	echo "Say 'sh $me', not 'sh <$me'"
+	exit 1
+fi
+
+: On HP-UX, large Configure scripts may exercise a bug in /bin/sh
+if test -f /hp-ux -a -f /bin/ksh; then
+	if (PATH=.; alias -x) >/dev/null 2>&1; then
+		: already under /bin/ksh
+	else
+		cat <<'EOM'
+(Feeding myself to ksh to avoid nasty sh bug in "here document" expansion.)
+EOM
+		unset ENV
+		exec /bin/ksh $0 "$@"
+	fi
+else
+	: Warn them if they use ksh on other systems
+	(PATH=.; alias -x) >/dev/null 2>&1 && \
+		cat <<EOM
+(I see you are using the Korn shell.  Some ksh's blow up on $me,
+especially on exotic machines.  If yours does, try the Bourne shell instead.)
+EOM
+fi
+
+: Configure runs within the UU subdirectory
+test -d UU || mkdir UU
+cd UU && rm -f ./*
+
+dynamic_ext=''
+extensions=''
+known_extensions=''
+static_ext=''
+useposix=''
+usesafe=''
+d_bsd=''
+d_eunice=''
+d_xenix=''
+eunicefix=''
+Mcc=''
+awk=''
+bash=''
+bison=''
+byacc=''
+cat=''
+chgrp=''
+chmod=''
+chown=''
+comm=''
+compress=''
+cp=''
+cpio=''
+cpp=''
+csh=''
+date=''
+echo=''
+egrep=''
+emacs=''
+expr=''
+find=''
+flex=''
+gcc=''
+grep=''
+inews=''
+ksh=''
+less=''
+line=''
+lint=''
+ln=''
+lp=''
+lpr=''
+ls=''
+mail=''
+mailx=''
+make=''
+mkdir=''
+more=''
+mv=''
+nroff=''
+perl=''
+pg=''
+pmake=''
+pr=''
+rm=''
+rmail=''
+sed=''
+sendmail=''
+sh=''
+shar=''
+sleep=''
+smail=''
+sort=''
+submit=''
+tail=''
+tar=''
+tbl=''
+test=''
+touch=''
+tr=''
+troff=''
+uname=''
+uniq=''
+uuname=''
+vi=''
+zcat=''
+full_sed=''
+libswanted=''
+hint=''
+myuname=''
+osname=''
+osvers=''
+Author=''
+Date=''
+Header=''
+Id=''
+Locker=''
+Log=''
+RCSfile=''
+Revision=''
+Source=''
+State=''
+ar=''
+archobjs=''
+exe_ext=''
+firstmakefile=''
+lib_ext=''
+obj_ext=''
+path_sep=''
+afs=''
+alignbytes=''
+archlib=''
+archlibexp=''
+d_archlib=''
+installarchlib=''
+archname=''
+myarchname=''
+baserev=''
+bin=''
+binexp=''
+installbin=''
+byteorder=''
+cc=''
+gccversion=''
+ccflags=''
+cppflags=''
+ldflags=''
+lkflags=''
+locincpth=''
+optimize=''
+cf_email=''
+cf_by=''
+cf_time=''
+contains=''
+cpp_stuff=''
+cpplast=''
+cppminus=''
+cpprun=''
+cppstdin=''
+d_access=''
+d_alarm=''
+d_attribut=''
+d_bcmp=''
+d_bcopy=''
+d_bzero=''
+d_casti32=''
+castflags=''
+d_castneg=''
+d_chown=''
+d_chroot=''
+d_chsize=''
+d_closedir=''
+d_void_closedir=''
+d_const=''
+cryptlib=''
+d_crypt=''
+d_csh=''
+full_csh=''
+d_cuserid=''
+d_dbl_dig=''
+d_difftime=''
+d_dlerror=''
+d_dlopen=''
+d_dlsymun=''
+d_dosuid=''
+d_suidsafe=''
+d_dup2=''
+d_fchmod=''
+d_fchown=''
+d_fcntl=''
+d_fd_macros=''
+d_fd_set=''
+d_fds_bits=''
+d_fgetpos=''
+d_flexfnam=''
+d_flock=''
+d_fork=''
+d_fsetpos=''
+d_Gconvert=''
+d_getgrps=''
+d_gethent=''
+aphostname=''
+d_gethname=''
+d_phostname=''
+d_uname=''
+d_getlogin=''
+d_getpgrp2=''
+d_getpgrp=''
+d_getppid=''
+d_getprior=''
+d_htonl=''
+d_isascii=''
+d_killpg=''
+d_link=''
+d_locconv=''
+d_lockf=''
+d_lstat=''
+d_mblen=''
+d_mbstowcs=''
+d_mbtowc=''
+d_memcmp=''
+d_memcpy=''
+d_memmove=''
+d_memset=''
+d_mkdir=''
+d_mkfifo=''
+d_mktime=''
+d_msg=''
+d_msgctl=''
+d_msgget=''
+d_msgrcv=''
+d_msgsnd=''
+d_nice=''
+d_open3=''
+d_fpathconf=''
+d_pathconf=''
+d_pause=''
+d_pipe=''
+d_poll=''
+d_portable=''
+d_readdir=''
+d_rewinddir=''
+d_seekdir=''
+d_telldir=''
+d_readlink=''
+d_rename=''
+d_rmdir=''
+d_safebcpy=''
+d_safemcpy=''
+d_select=''
+d_sem=''
+d_semctl=''
+d_semget=''
+d_semop=''
+d_setegid=''
+d_seteuid=''
+d_setlinebuf=''
+d_setlocale=''
+d_setpgid=''
+d_setpgrp2=''
+d_bsdpgrp=''
+d_setpgrp=''
+d_setprior=''
+d_setregid=''
+d_setresgid=''
+d_setresuid=''
+d_setreuid=''
+d_setrgid=''
+d_setruid=''
+d_setsid=''
+d_shm=''
+d_shmat=''
+d_shmatprototype=''
+shmattype=''
+d_shmctl=''
+d_shmdt=''
+d_shmget=''
+d_sigsetjmp=''
+d_sigaction=''
+d_sigintrp=''
+d_sigvec=''
+d_sigvectr=''
+d_oldsock=''
+d_socket=''
+d_sockpair=''
+sockethdr=''
+socketlib=''
+d_statblks=''
+d_stdio_cnt_lval=''
+d_stdio_ptr_lval=''
+d_stdiobase=''
+d_stdstdio=''
+stdio_base=''
+stdio_bufsiz=''
+stdio_cnt=''
+stdio_ptr=''
+d_index=''
+d_strchr=''
+d_strcoll=''
+d_strctcpy=''
+d_strerrm=''
+d_strerror=''
+d_sysernlst=''
+d_syserrlst=''
+d_strxfrm=''
+d_symlink=''
+d_syscall=''
+d_sysconf=''
+d_system=''
+d_tcgetpgrp=''
+d_tcsetpgrp=''
+d_time=''
+timetype=''
+clocktype=''
+d_times=''
+d_truncate=''
+d_tzname=''
+d_umask=''
+d_vfork=''
+usevfork=''
+d_voidsig=''
+signal_t=''
+d_volatile=''
+d_charvspr=''
+d_vprintf=''
+d_wait4=''
+d_waitpid=''
+d_wcstombs=''
+d_wctomb=''
+dlext=''
+cccdlflags=''
+ccdlflags=''
+d_shrplib=''
+dlsrc=''
+ld=''
+lddlflags=''
+shrpdir=''
+usedl=''
+fpostype=''
+gidtype=''
+groupstype=''
+h_fcntl=''
+h_sysfile=''
+db_hashtype=''
+db_prefixtype=''
+i_db=''
+i_dbm=''
+i_rpcsvcdbm=''
+d_dirnamlen=''
+direntrytype=''
+i_dirent=''
+i_dld=''
+i_dlfcn=''
+i_fcntl=''
+i_float=''
+i_gdbm=''
+i_grp=''
+i_limits=''
+i_locale=''
+i_malloc=''
+i_math=''
+i_memory=''
+i_ndbm=''
+i_neterrno=''
+i_niin=''
+i_sysin=''
+d_pwage=''
+d_pwchange=''
+d_pwclass=''
+d_pwcomment=''
+d_pwexpire=''
+d_pwquota=''
+i_pwd=''
+i_stddef=''
+i_stdlib=''
+i_string=''
+strings=''
+i_sysdir=''
+i_sysfile=''
+d_voidtty=''
+i_bsdioctl=''
+i_sysfilio=''
+i_sysioctl=''
+i_syssockio=''
+i_sysndir=''
+i_sysparam=''
+i_sysselct=''
+i_sysstat=''
+i_systimes=''
+i_systypes=''
+i_sysun=''
+i_sgtty=''
+i_termio=''
+i_termios=''
+i_systime=''
+i_systimek=''
+i_time=''
+timeincl=''
+i_unistd=''
+i_utime=''
+i_stdarg=''
+i_varargs=''
+i_varhdr=''
+i_vfork=''
+intsize=''
+libc=''
+glibpth=''
+libpth=''
+loclibpth=''
+plibpth=''
+xlibpth=''
+libs=''
+lns=''
+lseektype=''
+d_mymalloc=''
+freetype=''
+mallocobj=''
+mallocsrc=''
+malloctype=''
+usemymalloc=''
+installman1dir=''
+man1dir=''
+man1direxp=''
+man1ext=''
+installman3dir=''
+man3dir=''
+man3direxp=''
+man3ext=''
+huge=''
+large=''
+medium=''
+models=''
+small=''
+split=''
+modetype=''
+mydomain=''
+myhostname=''
+phostname=''
+c=''
+n=''
+d_eofnblk=''
+eagain=''
+o_nonblock=''
+rd_nodata=''
+groupcat=''
+hostcat=''
+passcat=''
+d_oldarchlib=''
+oldarchlib=''
+oldarchlibexp=''
+orderlib=''
+ranlib=''
+package=''
+spackage=''
+pager=''
+patchlevel=''
+perladmin=''
+perlpath=''
+prefix=''
+prefixexp=''
+installprivlib=''
+privlib=''
+privlibexp=''
+prototype=''
+randbits=''
+installscript=''
+scriptdir=''
+scriptdirexp=''
+selecttype=''
+sig_name=''
+sig_num=''
+installsitearch=''
+sitearch=''
+sitearchexp=''
+installsitelib=''
+sitelib=''
+sitelibexp=''
+sizetype=''
+so=''
+sharpbang=''
+shsharp=''
+spitshell=''
+ssizetype=''
+startperl=''
+startsh=''
+stdchar=''
+subversion=''
+sysman=''
+uidtype=''
+nm_opt=''
+nm_so_opt=''
+runnm=''
+usenm=''
+incpath=''
+mips=''
+mips_type=''
+usrinc=''
+defvoidused=''
+voidflags=''
+CONFIG=''
+
+define='define'
+undef='undef'
+smallmach='pdp11 i8086 z8000 i80286 iAPX286'
+rmlist=''
+
+: We must find out about Eunice early
+eunicefix=':'
+if test -f /etc/unixtovms; then
+	eunicefix=/etc/unixtovms
+fi
+if test -f /etc/unixtovms.exe; then
+	eunicefix=/etc/unixtovms.exe
+fi
+
+: list of known cpp symbols, sorted alphabetically
+al="AMIX BIT_MSF BSD BSD4_3 BSD_NET2 CMU CRAY DGUX DOLPHIN DPX2"
+al="$al GO32 GOULD_PN HP700 I386 I80960 I960 Lynx M68000 M68K MACH"
+al="$al MIPSEB MIPSEL MSDOS MTXINU MULTIMAX MVS"
+al="$al M_COFF M_I186 M_I286 M_I386 M_I8086 M_I86 M_I86SM"
+al="$al M_SYS3 M_SYS5 M_SYSIII M_SYSV M_UNIX M_XENIX"
+al="$al NeXT OCS88 OSF1 PARISC PC532 PORTAR POSIX"
+al="$al PWB R3000 RES RISC6000 RT Sun386i SVR3 SVR4"
+al="$al SYSTYPE_BSD SYSTYPE_SVR4 SYSTYPE_SYSV Tek4132 Tek4300"
+al="$al UMAXV USGr4 USGr4_2 UTEK UTS UTek UnicomPBB UnicomPBD Utek"
+al="$al VMS Xenix286"
+al="$al _AIX _AIX32 _AIX370 _AM29000 _COFF _CRAY _CX_UX _EPI"
+al="$al _IBMESA _IBMR2 _M88K _M88KBCS_TARGET"
+al="$al _MIPSEB _MIPSEL _M_COFF _M_I86 _M_I86SM _M_SYS3"
+al="$al _M_SYS5 _M_SYSIII _M_SYSV _M_UNIX _M_XENIX _NLS _PGC_ _R3000"
+al="$al _SYSTYPE_BSD _SYSTYPE_BSD43 _SYSTYPE_SVR4"
+al="$al _SYSTYPE_SYSV _SYSV3 _U370 _UNICOS"
+al="$al __386BSD__ __BIG_ENDIAN __BIG_ENDIAN__ __BSD_4_4__"
+al="$al __DGUX__ __DPX2__ __H3050R __H3050RX"
+al="$al __LITTLE_ENDIAN __LITTLE_ENDIAN__ __MACH__"
+al="$al __MIPSEB __MIPSEB__ __MIPSEL __MIPSEL__"
+al="$al __Next__ __OSF1__ __PARAGON__ __PGC__ __PWB __STDC__"
+al="$al __SVR4_2__ __UMAXV__"
+al="$al ____386BSD____ __alpha __alpha__ __amiga"
+al="$al __bsd4_2 __bsd4_2__ __bsdi__ __convex__"
+al="$al __host_mips__"
+al="$al __hp9000s200 __hp9000s300 __hp9000s400 __hp9000s500"
+al="$al __hp9000s500 __hp9000s700 __hp9000s800"
+al="$al __hppa __hpux __hp_osf __i286 __i286__ __i386 __i386__"
+al="$al __i486 __i486__ __i860 __i860__ __ibmesa __ksr1__ __linux__"
+al="$al __m68k __m68k__ __m88100__ __m88k __m88k__"
+al="$al __mc68000 __mc68000__ __mc68020 __mc68020__"
+al="$al __mc68030 __mc68030__ __mc68040 __mc68040__"
+al="$al __mc88100 __mc88100__ __mips __mips__"
+al="$al __motorola__ __osf__ __pa_risc __sparc__ __stdc__"
+al="$al __sun __sun__ __svr3__ __svr4__ __ultrix __ultrix__"
+al="$al __unix __unix__ __uxpm__ __uxps__ __vax __vax__"
+al="$al _host_mips _mips _unix"
+al="$al a29k aegis aix aixpc alliant alpha am29000 amiga ansi ardent"
+al="$al apollo ardent att386 att3b"
+al="$al bsd bsd43 bsd4_2 bsd4_3 bsd4_4 bsdi bull"
+al="$al cadmus clipper concurrent convex cray ctix"
+al="$al dmert encore gcos gcx gimpel gould"
+al="$al hbullx20 hcx host_mips hp200 hp300 hp700 hp800"
+al="$al hp9000 hp9000s300 hp9000s400 hp9000s500"
+al="$al hp9000s700 hp9000s800 hp9k8 hppa hpux"
+al="$al i186 i286 i386 i486 i8086"
+al="$al i80960 i860 iAPX286 ibm ibm032 ibmrt interdata is68k"
+al="$al ksr1 linux luna luna88k m68k m88100 m88k"
+al="$al mc300 mc500 mc68000 mc68010 mc68020 mc68030"
+al="$al mc68040 mc68060 mc68k mc68k32 mc700"
+al="$al mc88000 mc88100 merlin mert mips mvs n16"
+al="$al ncl_el ncl_mr"
+al="$al news1500 news1700 news1800 news1900 news3700"
+al="$al news700 news800 news900 ns16000 ns32000"
+al="$al ns32016 ns32332 ns32k nsc32000 os osf"
+al="$al parisc pc532 pdp11 plexus posix pyr"
+al="$al riscix riscos scs sequent sgi sinix sony sony_news"
+al="$al sonyrisc sparc sparclite spectrum stardent stratos"
+al="$al sun sun3 sun386 svr4 sysV68 sysV88"
+al="$al titan tower tower32 tower32_200 tower32_600 tower32_700"
+al="$al tower32_800 tower32_850 tss u370 u3b u3b2 u3b20 u3b200"
+al="$al u3b20d u3b5 ultrix unix unixpc unos vax venix vms"
+al="$al xenix z8000"
+
+groupstype=''
+i_whoami=''
+: default library list
+libswanted=''
+: set useposix=false in your hint file to disable the POSIX extension.
+useposix=true
+: set usesafe=false in your hint if you want to skip the Safe extension.
+usesafe=true
+: Define several unixisms.  These can be used in hint files.
+exe_ext='' 
+: Extra object files, if any, needed on this platform.
+archobjs=''
+: Possible local include directories to search.
+: Set locincpth to "" in a hint file to defeat local include searches.
+locincpth="/usr/local/include /opt/local/include /usr/gnu/include"
+locincpth="$locincpth /opt/gnu/include /usr/GNU/include /opt/GNU/include"
+:
+: no include file wanted by default
+inclwanted=''
+
+: change the next line if compiling for Xenix/286 on Xenix/386
+xlibpth='/usr/lib/386 /lib/386'
+
+: Possible local library directories to search.
+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
+
+: general looking path for locating libraries
+glibpth="/lib/pa1.1 /usr/shlib /usr/lib/large /lib /usr/lib"
+glibpth="$glibpth $xlibpth /lib/large /usr/lib/small /lib/small"
+glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/shlib"
+
+: Private path used by Configure to find libraries.  Its value
+: is prepended to libpth. This variable takes care of special
+: machines, like the mips.  Usually, it should be empty.
+plibpth=''
+
+: full support for void wanted by default
+defvoidused=15
+
+: List of libraries we want.
+libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl'
+libswanted="$libswanted dld ld sun m c cposix posix ndir dir crypt"
+libswanted="$libswanted ucb bsd BSD PW x"
+: We probably want to search /usr/shlib before most other libraries.
+: This is only used by the lib/ExtUtils/MakeMaker.pm routine extliblist.
+glibpth=`echo " $glibpth " | sed -e 's! /usr/shlib ! !'`
+glibpth="/usr/shlib $glibpth"
+: Do not use vfork unless overridden by a hint file.
+usevfork=false
+
+: script used to extract .SH files with variable substitutions
+cat >extract <<'EOS'
+CONFIG=true
+echo "Doing variable substitutions on .SH files..."
+if test -f MANIFEST; then
+	shlist=`awk '{print $1}' <MANIFEST | grep '\.SH'`
+	: Pick up possible extension manifests.
+	for dir in ext/* ; do
+		if test -f $dir/MANIFEST; then
+			xxx=`awk '{print $1}' < $dir/MANIFEST | 
+				sed -n "/\.SH$/ s@^@$dir/@p"`
+			shlist="$shlist $xxx"
+		fi
+	done
+	set x $shlist
+else
+	echo "(Looking for .SH files under the current directory.)"
+	set x `find . -name "*.SH" -print`
+fi
+shift
+case $# in
+0) set x *.SH; shift;;
+esac
+if test ! -f $1; then
+	shift
+fi
+for file in $*; do
+	case "$file" in
+	*/*)
+		dir=`expr X$file : 'X\(.*\)/'`
+		file=`expr X$file : 'X.*/\(.*\)'`
+		(cd $dir && . ./$file)
+		;;
+	*)
+		. ./$file
+		;;
+	esac
+done
+if test -f config_h.SH; then
+	if test ! -f config.h; then
+	: oops, they left it out of MANIFEST, probably, so do it anyway.
+	. ./config_h.SH
+	fi
+fi
+EOS
+
+: produce awk script to parse command line options
+cat >options.awk <<'EOF'
+BEGIN {
+	optstr = "dD:eEf:hKOrsSU:V";	# getopt-style specification
+
+	len = length(optstr);
+	for (i = 1; i <= len; i++) {
+		c = substr(optstr, i, 1);
+		if (i < len) a = substr(optstr, i + 1, 1); else a = "";
+		if (a == ":") {
+			arg[c] = 1;
+			i++;
+		}
+		opt[c] = 1;
+	}
+}
+{
+	expect = 0;
+	str = $0;
+	if (substr(str, 1, 1) != "-") {
+		printf("'%s'\n", str);
+		next;
+	}
+	len = length($0);
+	for (i = 2; i <= len; i++) {
+		c = substr(str, i, 1);
+		if (!opt[c]) {
+			printf("-%s\n", substr(str, i));
+			next;
+		}
+		printf("-%s\n", c);
+		if (arg[c]) {
+			if (i < len)
+				printf("'%s'\n", substr(str, i + 1));
+			else
+				expect = 1;
+			next;
+		}
+	}
+}
+END {
+	if (expect)
+		print "?";
+}
+EOF
+
+: process the command line options
+set X `for arg in "$@"; do echo "X$arg"; done |
+	sed -e s/X// | awk -f options.awk`
+eval "set $*"
+shift
+rm -f options.awk
+
+: set up default values
+fastread=''
+reuseval=false
+config_sh=''
+alldone=''
+error=''
+silent=''
+extractsh=''
+override=''
+knowitall=''
+rm -f optdef.sh
+
+: option parsing
+while test $# -gt 0; do
+	case "$1" in
+	-d) shift; fastread=yes;;
+	-e) shift; alldone=cont;;
+	-f)
+		shift
+		cd ..
+		if test -r "$1"; then
+			config_sh="$1"
+		else
+			echo "$me: cannot read config file $1." >&2
+			error=true
+		fi
+		cd UU
+		shift;;
+	-h) shift; error=true;;
+	-r) shift; reuseval=true;;
+	-s) shift; silent=true;;
+	-E) shift; alldone=exit;;
+	-K) shift; knowitall=true;;
+	-O) shift; override=true;;
+	-S) shift; extractsh=true;;
+	-D)
+		shift
+		case "$1" in
+		*=)
+			echo "$me: use '-U symbol=', not '-D symbol='." >&2
+			echo "$me: ignoring -D $1" >&2
+			;;
+		*=*) echo "$1" | \
+				sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> optdef.sh;;
+		*) echo "$1='define'" >> optdef.sh;;
+		esac
+		shift
+		;;
+	-U)
+		shift
+		case "$1" in
+		*=) echo "$1" >> optdef.sh;;
+		*=*)
+			echo "$me: use '-D symbol=val', not '-U symbol=val'." >&2
+			echo "$me: ignoring -U $1" >&2
+			;;
+		*) echo "$1='undef'" >> optdef.sh;;
+		esac
+		shift
+		;;
+	-V) echo "$me generated by metaconfig 3.0 PL60." >&2
+		exit 0;;
+	--) break;;
+	-*) echo "$me: unknown option $1" >&2; shift; error=true;;
+	*) break;;
+	esac
+done
+
+case "$error" in
+true)
+	cat >&2 <<EOM
+Usage: $me [-dehrEKOSV] [-f config.sh] [-D symbol] [-D symbol=value]
+                 [-U symbol] [-U symbol=]
+  -d : use defaults for all answers.
+  -e : go on without questioning past the production of config.sh.
+  -f : specify an alternate default configuration file.
+  -h : print this help message and exit (with an error status).
+  -r : reuse C symbols value if possible (skips costly nm extraction).
+  -s : silent mode, only echoes questions and essential information.
+  -D : define symbol to have some value:
+         -D symbol         symbol gets the value 'define'
+         -D symbol=value   symbol gets the value 'value'
+  -E : stop at the end of questions, after having produced config.sh.
+  -K : do not use unless you know what you are doing.
+  -O : let -D and -U override definitions from loaded configuration file.
+  -S : perform variable substitutions on all .SH files (can mix with -f)
+  -U : undefine symbol:
+         -U symbol    symbol gets the value 'undef'
+         -U symbol=   symbol gets completely empty
+  -V : print version number and exit (with a zero status).
+EOM
+	exit 1
+	;;
+esac
+
+exec 4>&1
+case "$silent" in
+true) exec 1>/dev/null;;
+esac
+
+: run the defines and the undefines, if any, but leave the file out there...
+touch optdef.sh
+. ./optdef.sh
+
+case "$extractsh" in
+true)
+	case "$config_sh" in
+	'') config_sh='config.sh'; config='./config.sh';;
+	/*) config="$config_sh";;
+	*) config="./$config_sh";;
+	esac
+	echo " "
+	echo "Fetching answers from $config_sh..."
+	cd ..
+	. $config
+	test "$override" && . ./optdef.sh
+	echo " "
+	. ./UU/extract
+	rm -rf UU
+	echo "Done."
+	exit 0
+	;;
+esac
+
+: set package name
+package=perl5
+first=`echo $package | sed -e 's/^\(.\).*/\1/'`
+last=`echo $package | sed -e 's/^.\(.*\)/\1/'`
+case "`echo AbyZ | tr '[:lower:]' '[:upper:]' 2>/dev/null`" in
+ABYZ) spackage=`echo $first | tr '[:lower:]' '[:upper:]'`$last;;
+*) spackage=`echo $first | tr '[a-z]' '[A-Z]'`$last;;
+esac
+
+: Eunice requires " " instead of "", can you believe it
+echo " "
+: Here we go...
+echo "Beginning of configuration questions for $package."
+
+trap 'echo " "; test -d ../UU && rm -rf X $rmlist; exit 1' 1 2 3 15
+
+: Some greps do not return status, grrr.
+echo "grimblepritz" >grimble
+if grep blurfldyick grimble >/dev/null 2>&1 ; then
+	contains=contains
+elif grep grimblepritz grimble >/dev/null 2>&1 ; then
+	contains=grep
+else
+	contains=contains
+fi
+rm -f grimble
+: the following should work in any shell
+case "$contains" in
+contains*)
+	echo " "
+	echo "AGH!  Grep doesn't return a status.  Attempting remedial action."
+	cat >contains <<'EOSS'
+grep "$1" "$2" >.greptmp && cat .greptmp && test -s .greptmp
+EOSS
+chmod +x contains
+esac
+
+: first determine how to suppress newline on echo command
+echo " "
+echo "Checking echo to see how to suppress newlines..."
+(echo "hi there\c" ; echo " ") >.echotmp
+if $contains c .echotmp >/dev/null 2>&1 ; then
+	echo "...using -n."
+	n='-n'
+	c=''
+else
+	cat <<'EOM'
+...using \c
+EOM
+	n=''
+	c='\c'
+fi
+echo $n "The star should be here-->$c"
+echo '*'
+rm -f .echotmp
+
+: Now test for existence of everything in MANIFEST
+echo " "
+if test -f ../MANIFEST; then
+	echo "First let's make sure your kit is complete.  Checking..." >&4
+	awk '$1 !~ /PACK[A-Z]+/ {print $1}' ../MANIFEST | split -50
+	rm -f missing
+	for filelist in x??; do
+		(cd ..; ls `cat UU/$filelist` >/dev/null 2>>UU/missing)
+	done
+	if test -s missing; then
+		cat missing >&4
+		cat >&4 <<'EOM'
+
+THIS PACKAGE SEEMS TO BE INCOMPLETE.
+
+You have the option of continuing the configuration process, despite the
+distinct possibility that your kit is damaged, by typing 'y'es.  If you
+do, don't blame me if something goes wrong.  I advise you to type 'n'o
+and contact the author (doughera@lafcol.lafayette.edu).
+
+EOM
+		echo $n "Continue? [n] $c" >&4
+		read ans
+		case "$ans" in
+		y*)
+			echo "Continuing..." >&4
+			rm -f missing
+			;;
+		*)
+			echo "ABORTING..." >&4
+			kill $$
+			;;
+		esac
+	else
+		echo "Looks good..." >&4
+	fi
+else
+	echo "There is no MANIFEST file.  I hope your kit is complete !"
+fi
+rm -f missing x??
+
+: compute the number of columns on the terminal for proper question formatting
+case "$COLUMNS" in
+'') COLUMNS='80';;
+esac
+
+: set up the echo used in my read
+myecho="case \"\$xxxm\" in
+'') echo $n \"\$rp $c\" >&4;;
+*) case \"\$rp\" in
+	'') echo $n \"[\$xxxm] $c\";;
+	*)
+		if test \`echo \"\$rp [\$xxxm]  \" | wc -c\` -ge $COLUMNS; then
+			echo \"\$rp\" >&4
+			echo $n \"[\$xxxm] $c\" >&4
+		else
+			echo $n \"\$rp [\$xxxm] $c\" >&4
+		fi
+		;;
+	esac;;
+esac"
+
+: now set up to do reads with possible shell escape and default assignment
+cat <<EOSC >myread
+xxxm=\$dflt
+$myecho
+ans='!'
+case "\$fastread" in
+yes) case "\$dflt" in
+	'') ;;
+	*) ans='';
+		case "\$silent-\$rp" in
+		true-) ;;
+		*) echo " " >&4;;
+		esac;;
+	esac;;
+*) case "\$silent" in
+	true) case "\$rp" in
+		'') ans='';;
+		esac;;
+	esac;;
+esac
+while expr "X\$ans" : "X!" >/dev/null; do
+	read answ
+	set x \$xxxm
+	shift
+	aok=''; eval "ans=\"\$answ\"" && aok=y
+	case  "\$answ" in
+	"\$ans")
+		case "\$ans" in
+		\\&*)
+			set x \`expr "X\$ans" : "X&\(.*\)\$"\`
+			shift
+			case "\$1" in
+			-d)
+				fastread=yes
+				echo "(OK, I'll run with -d after this question.)" >&4
+				;;
+			-*)
+				echo "*** Sorry, \$1 not supported yet." >&4
+				;;
+			esac
+			$myecho
+			ans=!
+			;;
+		"!")
+			sh 1>&4
+			echo " "
+			$myecho
+			;;
+		!*)
+			set x \`expr "X\$ans" : "X!\(.*\)\$"\`
+			shift
+			sh 1>&4 -c "\$*"
+			echo " "
+			$myecho
+			;;
+		esac;;
+	*)
+		case "\$aok" in
+		y)
+			echo "*** Substitution done -- please confirm."
+			xxxm="\$ans"
+			ans=\`echo $n "\$ans$c" | tr '\012' ' '\`
+			xxxm="\$ans"
+			ans=!
+			;;
+		*)
+			echo "*** Error -- try again."
+			ans=!
+			;;
+		esac
+		$myecho
+		;;
+	esac
+	case "\$ans\$xxxm\$nostick" in
+	'')
+		ans=!
+		$myecho
+		;;
+	esac
+done
+case "\$ans" in
+'') ans="\$xxxm";;
+esac
+EOSC
+
+: create .config dir to save info across Configure sessions
+test -d ../.config || mkdir ../.config
+cat >../.config/README <<EOF
+This directory created by Configure to save information that should
+persist across sessions.
+
+You may safely delete it if you wish.
+EOF
+
+: general instructions
+needman=true
+firsttime=true
+user=`( (logname) 2>/dev/null || whoami) 2>&1`
+if $contains "^$user\$" ../.config/instruct >/dev/null 2>&1; then
+	firsttime=false
+	echo " "
+	rp='Would you like to see the instructions?'
+	dflt=n
+	. ./myread
+	case "$ans" in
+	[yY]*) ;;
+	*) needman=false;;
+	esac
+fi
+if $needman; then
+	cat <<EOH
+ 
+This installation shell script will examine your system and ask you questions
+to determine how the perl5 package should be installed. If you get
+stuck on a question, you may use a ! shell escape to start a subshell or
+execute a command.  Many of the questions will have default answers in square
+brackets; typing carriage return will give you the default.
+
+On some of the questions which ask for file or directory names you are allowed
+to use the ~name construct to specify the login directory belonging to "name",
+even if you don't have a shell which knows about that.  Questions where this is
+allowed will be marked "(~name ok)".
+
+EOH
+	rp=''
+	dflt='Type carriage return to continue'
+	. ./myread
+	cat <<'EOH'
+
+The prompter used in this script allows you to use shell variables and
+backticks in your answers.  You may use $1, $2, etc...  to refer to the words
+in the default answer, as if the default line was a set of arguments given to a
+script shell.  This means you may also use $* to repeat the whole default line,
+so you do not have to re-type everything to add something to the default.
+
+Everytime there is a substitution, you will have to confirm.  If there is an
+error (e.g. an unmatched backtick), the default answer will remain unchanged
+and you will be prompted again.
+
+If you are in a hurry, you may run 'Configure -d'.  This will bypass nearly all
+the questions and use the computed defaults (or the previous answers if there
+was already a config.sh file). Type 'Configure -h' for a list of options.
+You may also start interactively and then answer '& -d' at any prompt to turn
+on the non-interactive behaviour for the remaining of the execution.
+
+EOH
+	. ./myread
+	cat <<EOH
+
+Much effort has been expended to ensure that this shell script will run on any
+Unix system.  If despite that it blows up on yours, your best bet is to edit
+Configure and run it again.  If you can't run Configure for some reason,
+you'll have to generate a config.sh file by hand.  Whatever problems you
+have, let me (doughera@lafcol.lafayette.edu) know how I blew it.
+
+This installation script affects things in two ways:
+
+1) it may do direct variable substitutions on some of the files included
+   in this kit.
+2) it builds a config.h file for inclusion in C programs.  You may edit
+   any of these files as the need arises after running this script.
+
+If you make a mistake on a question, there is no easy way to back up to it
+currently.  The easiest thing to do is to edit config.sh and rerun all the SH
+files.  Configure will offer to let you do this before it runs the SH files.
+
+EOH
+	dflt='Type carriage return to continue'
+	. ./myread
+	case "$firsttime" in
+	true) echo $user >>../.config/instruct;;
+	esac
+fi
+
+: see if sh knows # comments
+echo " "
+echo "Checking your sh to see if it knows about # comments..." >&4
+if `sh -c '#' >/dev/null 2>&1`; then
+	echo "Your sh handles # comments correctly."
+	shsharp=true
+	spitshell=cat
+	echo " "
+	echo "Okay, let's see if #! works on this system..."
+	xcat=/bin/cat
+	test -f $xcat || xcat=/usr/bin/cat
+	echo "#!$xcat" >try
+	$eunicefix try
+	chmod +x try
+	./try > today
+	if test -s today; then
+		echo "It does."
+		sharpbang='#!'
+	else
+		echo "#! $xcat" > try
+		$eunicefix try
+		chmod +x try
+		./try > today
+		if test -s today; then
+			echo "It does."
+			sharpbang='#! '
+		else
+			echo "It's just a comment."
+			sharpbang=': use '
+		fi
+	fi
+else
+	echo "Your sh doesn't grok # comments--I will strip them later on."
+	shsharp=false
+	cd ..
+	echo "exec grep -v '^[ 	]*#'" >spitshell
+	chmod +x spitshell
+	$eunicefix spitshell
+	spitshell=`pwd`/spitshell
+	cd UU
+	echo "I presume that if # doesn't work, #! won't work either!"
+	sharpbang=': use '
+fi
+rm -f try today
+
+: figure out how to guarantee sh startup
+echo " "
+echo "Checking out how to guarantee sh startup..." >&4
+case "$SYSTYPE" in
+*bsd*|sys5*) startsh=$sharpbang"/$SYSTYPE/bin/sh";;
+*) startsh=$sharpbang'/bin/sh';;
+esac
+echo "Let's see if '$startsh' works..."
+cat >try <<EOSS
+$startsh
+set abc
+test "$?abc" != 1
+EOSS
+
+chmod +x try
+$eunicefix try
+if ./try; then
+	echo "Yup, it does."
+else
+echo "Nope.  You may have to fix up the shell scripts to make sure sh runs them."
+fi
+rm -f try
+
+: find out where common programs are
+echo " "
+echo "Locating common programs..." >&4
+cat <<EOSC >loc
+$startsh
+case \$# in
+0) exit 1;;
+esac
+thing=\$1
+shift
+dflt=\$1
+shift
+for dir in \$*; do
+	case "\$thing" in
+	.)
+	if test -d \$dir/\$thing; then
+		echo \$dir
+		exit 0
+	fi
+	;;
+	*)
+	for thisthing in \$dir/\$thing; do
+		: just loop through to pick last item
+	done
+	if test -f \$thisthing; then
+		echo \$thisthing
+		exit 0
+	elif test -f \$dir/\$thing.exe; then
+		: on Eunice apparently
+		echo \$dir/\$thing
+		exit 0
+	fi
+	;;
+	esac
+done
+echo \$dflt
+exit 1
+EOSC
+chmod +x loc
+$eunicefix loc
+loclist="
+awk
+cat
+comm
+cp
+echo
+expr
+find
+grep
+ln
+ls
+mkdir
+rm
+sed
+sort
+touch
+tr
+uniq
+"
+trylist="
+Mcc
+byacc
+cpp
+csh
+date
+egrep
+less
+line
+more
+nroff
+perl
+pg
+sendmail
+test
+uname
+"
+pth=`echo $PATH | sed -e "s/$p_/ /g"`
+pth="$pth /lib /usr/lib"
+for file in $loclist; do
+	xxx=`./loc $file $file $pth`
+	eval $file=$xxx
+	eval _$file=$xxx
+	case "$xxx" in
+	/*)
+		echo $file is in $xxx.
+		;;
+	?:[\\/]*)
+		echo $file is in $xxx.
+		;;
+	*)
+		echo "I don't know where '$file' is, and my life depends on it." >&4
+		echo "Go find a public domain implementation or fix your PATH setting!" >&4
+		exit 1
+		;;
+	esac
+done
+echo " "
+echo "Don't worry if any of the following aren't found..."
+say=offhand
+for file in $trylist; do
+	xxx=`./loc $file $file $pth`
+	eval $file=$xxx
+	eval _$file=$xxx
+	case "$xxx" in
+	/*)
+		echo $file is in $xxx.
+		;;
+	?:[\\/]*)
+		echo $file is in $xxx.
+		;;
+	*)
+		echo "I don't see $file out there, $say."
+		say=either
+		;;
+	esac
+done
+case "$egrep" in
+egrep)
+	echo "Substituting grep for egrep."
+	egrep=$grep
+	;;
+esac
+case "$test" in
+test)
+	echo "Hopefully test is built into your sh."
+	;;
+*)
+	if `sh -c "PATH= test true" >/dev/null 2>&1`; then
+		echo "Using the test built into your sh."
+		test=test
+		_test=test
+	fi
+	;;
+esac
+case "$echo" in
+echo)
+	echo "Hopefully echo is built into your sh."
+	;;
+'') ;;
+*)
+	echo " "
+echo "Checking compatibility between $echo and builtin echo (if any)..." >&4
+	$echo $n "hi there$c" >foo1
+	echo $n "hi there$c" >foo2
+	if cmp foo1 foo2 >/dev/null 2>&1; then
+		echo "They are compatible.  In fact, they may be identical."
+	else
+		case "$n" in
+		'-n') n='' c='\c';;
+		*) n='-n' c='';;
+		esac
+		cat <<FOO
+They are not compatible!  You are probably running ksh on a non-USG system.
+I'll have to use $echo instead of the builtin, since Bourne shell doesn't
+have echo built in and we may have to run some Bourne shell scripts.  That
+means I'll have to use '$n$c' to suppress newlines now.  Life is ridiculous.
+
+FOO
+		$echo $n "The star should be here-->$c"
+		$echo "*"
+	fi
+	$rm -f foo1 foo2
+	;;
+esac
+
+: determine whether symbolic links are supported
+echo " "
+$touch blurfl
+if $ln -s blurfl sym > /dev/null 2>&1 ; then
+	echo "Symbolic links are supported." >&4
+	lns="$ln -s"
+else
+	echo "Symbolic links are NOT supported." >&4
+	lns="$ln"
+fi
+$rm -f blurfl sym
+
+: see whether [:lower:] and [:upper:] are supported character classes
+echo " "
+up='[A-Z]'
+low='[a-z]'
+case "`echo AbyZ | $tr '[:lower:]' '[:upper:]' 2>/dev/null`" in
+ABYZ)
+	echo "Good, your tr supports [:lower:] and [:upper:] to convert case." >&4
+	up='[:upper:]'
+	low='[:lower:]'
+	;;
+*)
+	echo "Your tr only supports [a-z] and [A-Z] to convert case." >&4
+	;;
+esac
+: set up the translation script tr, must be called with ./tr of course
+cat >tr <<EOSC
+$startsh
+case "\$1\$2" in
+'[A-Z][a-z]') exec $tr '$up' '$low';;
+'[a-z][A-Z]') exec $tr '$low' '$up';;
+esac
+exec $tr "\$@"
+EOSC
+chmod +x tr
+$eunicefix tr
+
+: Try to determine whether config.sh was made on this system
+case "$config_sh" in
+'')
+myuname=`( ($uname -a) 2>/dev/null || hostname) 2>&1`
+myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \
+	./tr '[A-Z]' '[a-z]' | tr '\012' ' '`
+newmyuname="$myuname"
+dflt=n
+case "$knowitall" in
+'')
+	if test -f ../config.sh; then
+		if $contains myuname= ../config.sh >/dev/null 2>&1; then
+			eval "`grep myuname= ../config.sh`"
+		fi
+		if test "X$myuname" = "X$newmyuname"; then
+			dflt=y
+		fi
+	fi
+	;;
+*) dflt=y;;
+esac
+
+: Get old answers from old config file if Configure was run on the
+: same system, otherwise use the hints.
+hint=default
+cd ..
+if test -f config.sh; then
+	echo " "
+	rp="I see a config.sh file.  Shall I use it to set the defaults?"
+	. UU/myread
+	case "$ans" in
+	n*|N*) echo "OK, I'll ignore it."; mv config.sh config.sh.old;;
+	*)  echo "Fetching default answers from your old config.sh file..." >&4
+		tmp_n="$n"
+		tmp_c="$c"
+		. ./config.sh
+		cp config.sh UU
+		n="$tmp_n"
+		c="$tmp_c"
+		hint=previous
+		;;
+	esac
+fi
+if test ! -f config.sh; then
+	$cat <<EOM
+
+First time through, eh?  I have some defaults handy for the following systems:
+
+EOM
+	cd hints; ls -C *.sh | $sed 's/\.sh/   /g' >&4
+	dflt=''
+	: Half the following guesses are probably wrong... If you have better
+	: tests or hints, please send them to doughera@lafcol.lafayette.edu
+	: The metaconfig authors would also appreciate a copy...
+	$test -f /irix && osname=irix
+	$test -f /xenix && osname=sco_xenix
+	$test -f /dynix && osname=dynix
+	$test -f /dnix && osname=dnix
+ 	$test -f /unicos && osname=unicos && osvers=`$uname -r`
+	$test -f /bin/mips && /bin/mips && osname=mips
+	$test -d /NextApps && set X `hostinfo | grep 'NeXT Mach.*:' | \
+		$sed -e 's/://' -e 's/\./_/'` && osname=next && osvers=$4
+	$test -d /usr/apollo/bin && osname=apollo
+	$test -f /etc/saf/_sactab && osname=svr4
+	$test -d /usr/include/minix && osname=minix
+	if $test -d /MachTen; then
+		osname=machten 
+		if $test -x /sbin/version; then
+			osvers=`/sbin/version | $awk '{print $2}' | 
+			$sed -e 's/[A-Za-z]$//'`
+		elif $test -x /usr/etc/version; then
+			osvers=`/usr/etc/version | $awk '{print $2}' | 
+			$sed -e 's/[A-Za-z]$//'`
+		else
+			osvers="$2.$3"
+		fi
+	fi
+	if $test -f $uname; then
+		set X $myuname
+		shift
+
+		case "$5" in
+		fps*) osname=fps ;;
+		mips*)
+			case "$4" in
+			umips) osname=umips ;;
+			*) osname=mips ;;
+			esac;;
+		[23]100) osname=mips ;;
+		next*) osname=next ;;
+		news*) osname=news ;;
+		i386*)
+			if $test -f /etc/kconfig; then
+				osname=isc
+				if test "$lns" = "ln -s"; then
+					osvers=4
+				elif $contains _SYSV3 /usr/include/stdio.h > /dev/null 2>&1 ; then
+					osvers=3
+				elif $contains _POSIX_SOURCE /usr/include/stdio.h > /dev/null 2>&1 ; then
+					osvers=2
+				fi
+			fi
+			;;
+		esac
+
+		case "$1" in
+		aix) osname=aix
+			tmp=`( (oslevel) 2>/dev/null || echo "not found") 2>&1`
+			case "$tmp" in
+			'not found') osvers="$4"."$3" ;;
+			'<3240'|'<>3240') osvers=3.2.0 ;;
+			'=3240'|'>3240'|'<3250'|'<>3250') osvers=3.2.4 ;;
+			'=3250'|'>3250') osvers=3.2.5 ;;
+			*) osvers=$tmp;;
+			esac
+			;;
+		dnix) osname=dnix
+			osvers="$3"
+			;;
+		domainos) osname=apollo
+			osvers="$3"
+			;;
+		dgux) osname=dgux 
+			osvers="$3"
+			;;
+		freebsd) osname=freebsd 
+			osvers="$3" ;;
+		genix) osname=genix ;;
+		hp*) osname=hpux 
+			case "$3" in
+			*.08.*) osvers=9 ;;
+			*.09.*) osvers=9 ;;
+			*.10.*) osvers=10 ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		irix) osname=irix
+			case "$3" in
+			4*) osvers=4 ;;
+			5*) osvers=5 ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		linux) osname=linux
+			case "$3" in
+			1*) osvers=1 ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		netbsd*) osname=netbsd 
+			osvers="$3"
+			;;
+		bsd386) osname=bsd386
+			osvers=`$uname -r`
+			;;
+		next*) osname=next ;;
+		solaris) osname=solaris
+			case "$3" in
+			5*) osvers=`echo $3 | $sed 's/^5/2/g'` ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		sunos) osname=sunos
+			case "$3" in
+			5*) osname=solaris
+				osvers=`echo $3 | $sed 's/^5/2/g'` ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		titanos) osname=titanos
+			case "$3" in
+			1*) osvers=1 ;;
+			2*) osvers=2 ;;
+			3*) osvers=3 ;;
+			4*) osvers=4 ;;
+			*)	osvers="$3" ;;
+			esac
+			;;
+		ultrix) osname=ultrix
+			osvers="$3"
+			;;
+		osf1)	case "$5" in
+				alpha)
+					osname=dec_osf
+					osvers=`echo "$3" | sed 's/^[vt]//'`
+					;;
+			hp*)	osname=hp_osf1	;;
+			mips)	osname=mips_osf1 ;;
+			esac
+			;;
+		uts) osname=uts 
+			osvers="$3"
+			;;
+		$2) case "$osname" in
+			*isc*) ;;
+			*freebsd*) ;;
+ 			svr*)
+				: svr4.x or possibly later
+				case "svr$3" in	
+				${osname}*)
+					osname=svr$3
+					osvers=$4
+					;;
+				esac
+				case "$osname" in
+				svr4.0)
+					: Check for ESIX
+					if test -f /stand/boot ; then
+						eval `grep '^INITPROG=[a-z/0-9]*$' /stand/boot`
+						if test -n "$INITPROG" -a -f "$INITPROG"; then
+			isesix=`strings -a $INITPROG|grep 'ESIX SYSTEM V/386 Release 4.0'`
+							if test -n "$isesix"; then
+								osname=esix4
+							fi
+						fi
+					fi
+					;;
+				esac
+				;;
+			*)	if test -f /etc/systemid; then
+					osname=sco
+					set `echo $3 | $sed 's/\./ /g'` $4
+					if $test -f sco_$1_$2_$3.sh; then
+						osvers=$1.$2.$3
+					elif $test -f sco_$1_$2.sh; then
+						osvers=$1.$2
+					elif $test -f sco_$1.sh; then
+						osvers=$1
+					fi
+				else
+					case "$osname" in
+					'') : Still unknown.  Probably a generic Sys V.
+						osname="sysv"
+						osvers="$3"
+						;;
+					esac
+				fi
+				;;
+			esac
+			;;
+		*)	case "$osname" in
+			'') : Still unknown.  Probably a generic BSD.
+				osname="$1"
+				osvers="$3"
+				;;
+			esac
+			;;
+		esac
+	else
+		if test -f /vmunix -a -f news_os.sh; then
+			(what /vmunix | ../UU/tr '[A-Z]' '[a-z]') > ../UU/kernel.what 2>&1
+			if $contains news-os ../UU/kernel.what >/dev/null 2>&1; then
+				osname=news_os
+			fi
+			$rm -f ../UU/kernel.what
+		elif test -d c:/.; then
+			set X $myuname
+			osname=os2
+			osvers="$5"
+		fi
+	fi
+	
+	: Now look for a hint file osname_osvers, unless one has been
+	: specified already.
+	case "$hintfile" in
+	''|' ')
+		file=`echo "${osname}_${osvers}" | $sed -e 's@\.@_@g' -e 's@_$@@'`
+		: Also try without trailing minor version numbers.
+		xfile=`echo $file | $sed -e 's@_[^_]*$@@'`
+		xxfile=`echo $xfile | $sed -e 's@_[^_]*$@@'`
+		xxxfile=`echo $xxfile | $sed -e 's@_[^_]*$@@'`
+		xxxxfile=`echo $xxxfile | $sed -e 's@_[^_]*$@@'`
+		case "$file" in
+		'') dflt=none ;;
+		*)  case "$osvers" in
+			'') dflt=$file
+				;;
+			*)  if $test -f $file.sh ; then
+					dflt=$file
+				elif $test -f $xfile.sh ; then
+					dflt=$xfile
+				elif $test -f $xxfile.sh ; then
+					dflt=$xxfile
+				elif $test -f $xxxfile.sh ; then
+					dflt=$xxxfile
+				elif $test -f $xxxxfile.sh ; then
+					dflt=$xxxxfile
+				elif $test -f "${osname}.sh" ; then
+					dflt="${osname}"
+				else
+					dflt=none
+				fi
+				;;
+			esac
+			;;
+		esac
+		;;
+	*)
+		dflt=`echo $hintfile | $sed 's/\.sh$//'`
+		;;
+	esac
+
+	$cat <<EOM
+
+You may give one or more space-separated answers, or "none" if appropriate.
+If your OS version has no hints, DO NOT give a wrong version -- say "none".
+
+EOM
+	rp="Which of these apply, if any?"
+	. ../UU/myread
+	tans=$ans
+	for file in $tans; do
+		if $test -f $file.sh; then
+			. ./$file.sh
+			$cat $file.sh >> ../UU/config.sh
+		elif $test X$tans = X -o X$tans = Xnone ; then
+			: nothing
+		else
+			: Give one chance to correct a possible typo.
+			echo "$file.sh does not exist"
+			dflt=$file
+			rp="hint to use instead?"
+			. ../UU/myread
+			for file in $ans; do
+				if $test -f "$file.sh"; then
+					. ./$file.sh
+					$cat $file.sh >> ../UU/config.sh
+				elif $test X$ans = X -o X$ans = Xnone ; then
+					: nothing
+				else
+					echo "$file.sh does not exist -- ignored."
+				fi
+			done
+		fi
+	done
+
+	hint=recommended
+	: Remember our hint file for later.
+	if $test -f "$file.sh" ; then
+		hintfile="$file"
+	else
+		hintfile=''
+	fi
+
+	cd ..
+fi
+cd UU
+;;
+*)
+	echo " "
+	echo "Fetching default answers from $config_sh..." >&4
+	tmp_n="$n"
+	tmp_c="$c"
+	cd ..
+	cp $config_sh config.sh 2>/dev/null
+	. ./config.sh
+	cd UU
+	cp ../config.sh .
+	n="$tmp_n"
+	c="$tmp_c"
+	hint=previous
+	;;
+esac
+test "$override" && . ./optdef.sh
+myuname="$newmyuname"
+
+: Restore computed paths
+for file in $loclist $trylist; do
+	eval $file="\$_$file"
+done
+
+cat << EOM
+
+Configure uses the operating system name and version to set some defaults.
+The default value is probably right if the name rings a bell. Otherwise,
+since spelling matters for me, either accept the default or answer "none"
+to leave it blank.
+
+EOM
+case "$osname" in
+	''|' ')
+		case "$hintfile" in
+		''|' '|none) dflt=none ;;
+		*)  dflt=`echo $hintfile | $sed -e 's/\.sh$//' -e 's/_.*$//'` ;;
+		esac
+		;;
+	*) dflt="$osname" ;;
+esac
+rp="Operating system name?"
+. ./myread
+case "$ans" in
+none)  osname='' ;;
+*) osname=`echo "$ans" | $sed -e 's/[ 	][	]*/_/g' | ./tr '[A-Z]' '[a-z]'`;;
+esac
+: who configured the system
+cf_time=`$date 2>&1`
+(logname > .temp) >/dev/null 2>&1
+$test -s .temp || (whoami > .temp) >/dev/null 2>&1
+$test -s .temp || echo unknown > .temp
+cf_by=`$cat .temp`
+$rm -f .temp
+
+: determine the architecture name
+echo " "
+if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
+	tarch=`arch`"-$osname"
+elif xxx=`./loc uname blurfl $pth`; $test -f "$xxx" ; then
+	if uname -m > tmparch 2>&1 ; then
+		tarch=`$sed -e 's/ /_/g' -e 's/$/'"-$osname/" tmparch`
+	else
+		tarch="$osname"
+	fi
+	$rm -f tmparch
+else
+	tarch="$osname"
+fi
+case "$myarchname" in
+''|"$tarch") ;;
+*)
+	echo "(Your architecture name used to be $myarchname.)"
+	archname=''
+	;;
+esac
+case "$archname" in
+'') dflt="$tarch";;
+*) dflt="$archname";;
+esac
+rp='What is your architecture name'
+. ./myread
+archname="$ans"
+myarchname="$tarch"
+
+: is AFS running?
+echo " "
+if test -d /afs; then
+	echo "AFS may be running... I'll be extra cautious then..." >&4
+	afs=true
+else
+	echo "AFS does not seem to be running..." >&4
+	afs=false
+fi
+
+: decide how portable to be.  Allow command line overrides.
+case "$d_portable" in
+"$undef") ;;
+*)	d_portable="$define" ;;
+esac
+
+: set up shell script to do ~ expansion
+cat >filexp <<EOSS
+$startsh
+: expand filename
+case "\$1" in
+ ~/*|~)
+	echo \$1 | $sed "s|~|\${HOME-\$LOGDIR}|"
+	;;
+ ~*)
+	if $test -f /bin/csh; then
+		/bin/csh -f -c "glob \$1"
+		failed=\$?
+		echo ""
+		exit \$failed
+	else
+		name=\`$expr x\$1 : '..\([^/]*\)'\`
+		dir=\`$sed -n -e "/^\${name}:/{s/^[^:]*:[^:]*:[^:]*:[^:]*:[^:]*:\([^:]*\).*"'\$'"/\1/" -e p -e q -e '}' </etc/passwd\`
+		if $test ! -d "\$dir"; then
+			me=\`basename \$0\`
+			echo "\$me: can't locate home directory for: \$name" >&2
+			exit 1
+		fi
+		case "\$1" in
+		*/*)
+			echo \$dir/\`$expr x\$1 : '..[^/]*/\(.*\)'\`
+			;;
+		*)
+			echo \$dir
+			;;
+		esac
+	fi
+	;;
+*)
+	echo \$1
+	;;
+esac
+EOSS
+chmod +x filexp
+$eunicefix filexp
+
+: now set up to get a file name
+cat <<'EOSC' >getfile
+tilde=''
+fullpath=''
+already=''
+skip=''
+none_ok=''
+exp_file=''
+nopath_ok=''
+orig_rp="$rp"
+orig_dflt="$dflt"
+
+case "$fn" in
+*\(*)
+	expr $fn : '.*(\(.*\)).*' | tr ',' '\012' >getfile.ok
+	fn=`echo $fn | sed 's/(.*)//'`
+	;;
+esac
+
+case "$fn" in
+*:*)
+	loc_file=`expr $fn : '.*:\(.*\)'`
+	fn=`expr $fn : '\(.*\):.*'`
+	;;
+esac
+
+case "$fn" in
+*~*) tilde=true;;
+esac
+case "$fn" in
+*/*) fullpath=true;;
+esac
+case "$fn" in
+*+*) skip=true;;
+esac
+case "$fn" in
+*n*) none_ok=true;;
+esac
+case "$fn" in
+*e*) exp_file=true;;
+esac
+case "$fn" in
+*p*) nopath_ok=true;;
+esac
+
+case "$fn" in
+*f*) type='File';;
+*d*) type='Directory';;
+*l*) type='Locate';;
+esac
+
+what="$type"
+case "$what" in
+Locate) what='File';;
+esac
+
+case "$exp_file" in
+'')
+	case "$d_portable" in
+	"$define") ;;
+	*) exp_file=true;;
+	esac
+	;;
+esac
+
+cd ..
+while test "$type"; do
+	redo=''
+	rp="$orig_rp"
+	dflt="$orig_dflt"
+	case "$tilde" in
+	true) rp="$rp (~name ok)";;
+	esac
+	. UU/myread
+	if test -f UU/getfile.ok && \
+		$contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1
+	then
+		value="$ans"
+		ansexp="$ans"
+		break
+	fi
+	case "$ans" in
+	none)
+		value=''
+		ansexp=''
+		case "$none_ok" in
+		true) type='';;
+		esac
+		;;
+	*)
+		case "$tilde" in
+		'') value="$ans"
+			ansexp="$ans";;
+		*)
+			value=`UU/filexp $ans`
+			case $? in
+			0)
+				if test "$ans" != "$value"; then
+					echo "(That expands to $value on this system.)"
+				fi
+				;;
+			*) value="$ans";;
+			esac
+			ansexp="$value"
+			case "$exp_file" in
+			'') value="$ans";;
+			esac
+			;;
+		esac
+		case "$fullpath" in
+		true)
+			case "$ansexp" in
+			/*) value="$ansexp" ;;
+			*)
+				redo=true
+				case "$already" in
+				true)
+				echo "I shall only accept a full path name, as in /bin/ls." >&4
+				echo "Use a ! shell escape if you wish to check pathnames." >&4
+					;;
+				*)
+				echo "Please give a full path name, starting with slash." >&4
+					case "$tilde" in
+					true)
+				echo "Note that using ~name is ok provided it expands well." >&4
+						already=true
+						;;
+					esac
+				esac
+				;;
+			esac
+			;;
+		esac
+		case "$redo" in
+		'')
+			case "$type" in
+			File)
+				if test -f "$ansexp"; then
+					type=''
+				elif test -r "$ansexp" || (test -h "$ansexp") >/dev/null 2>&1
+				then
+					echo "($value is not a plain file, but that's ok.)"
+					type=''
+				fi
+				;;
+			Directory)
+				if test -d "$ansexp"; then
+					type=''
+				fi
+				;;
+			Locate)
+				if test -d "$ansexp"; then
+					echo "(Looking for $loc_file in directory $value.)"
+					value="$value/$loc_file"
+					ansexp="$ansexp/$loc_file"
+				fi
+				if test -f "$ansexp"; then
+					type=''
+				fi
+				case "$nopath_ok" in
+				true)	case "$value" in
+					*/*) ;;
+					*)	echo "Assuming $value will be in people's path."
+						type=''
+						;;
+					esac
+					;;
+				esac
+				;;
+			esac
+
+			case "$skip" in
+			true) type='';
+			esac
+
+			case "$type" in
+			'') ;;
+			*)
+				if test "$fastread" = yes; then
+					dflt=y
+				else
+					dflt=n
+				fi
+				rp="$what $value doesn't exist.  Use that name anyway?"
+				. UU/myread
+				dflt=''
+				case "$ans" in
+				y*) type='';;
+				*) echo " ";;
+				esac
+				;;
+			esac
+			;;
+		esac
+		;;
+	esac
+done
+cd UU
+ans="$value"
+rp="$orig_rp"
+dflt="$orig_dflt"
+rm -f getfile.ok
+EOSC
+
+: determine root of directory hierarchy where package will be installed.
+case "$prefix" in
+'')
+	dflt=`./loc . /usr/local /usr/local /local /opt /usr`
+	;;
+*)
+	dflt="$prefix"
+	;;
+esac
+$cat <<EOM
+
+By default, $package will be installed in $dflt/bin, manual
+pages under $dflt/man, etc..., i.e. with $dflt as prefix for
+all installation directories. Typically set to /usr/local, but you
+may choose /usr if you wish to install $package among your system
+binaries. If you wish to have binaries under /bin but manual pages
+under /usr/local/man, that's ok: you will be prompted separately
+for each of the installation directories, the prefix being only used
+to set the defaults.
+
+EOM
+fn=d~
+rp='Installation prefix to use?'
+. ./getfile
+oldprefix=''
+case "$prefix" in
+'') ;;
+*)
+	case "$ans" in
+	"$prefix") ;;
+	*) oldprefix="$prefix";;
+	esac
+	;;
+esac
+prefix="$ans"
+prefixexp="$ansexp"
+
+: set the prefixit variable, to compute a suitable default value
+prefixit='case "$3" in
+""|none)
+	case "$oldprefix" in
+	"") eval "$1=\"\$$2\"";;
+	*)
+		case "$3" in
+		"") eval "$1=";;
+		none)
+			eval "tp=\"\$$2\"";
+			case "$tp" in
+			""|" ") eval "$1=\"\$$2\"";;
+			*) eval "$1=";;
+			esac;;
+		esac;;
+	esac;;
+*)
+	eval "tp=\"$oldprefix-\$$2-\""; eval "tp=\"$tp\"";
+	case "$tp" in
+	--|/*--|\~*--) eval "$1=\"$prefix/$3\"";;
+	/*-$oldprefix/*|\~*-$oldprefix/*)
+		eval "$1=\`echo \$$2 | sed \"s,^$oldprefix,$prefix,\"\`";;
+	*) eval "$1=\"\$$2\"";;
+	esac;;
+esac'
+
+: determine where private library files go
+: Usual default is /usr/local/lib/perl5.  Also allow things like 
+: /opt/perl/lib, since /opt/perl/lib/perl5 would be redundant.
+case "$prefix" in
+*perl*) set dflt privlib lib ;;
+*)	 set dflt privlib lib/$package ;;
+esac
+eval $prefixit
+$cat <<EOM
+
+There are some auxiliary files for $package that need to be put into a
+private library directory that is accessible by everyone.
+
+EOM
+fn=d~+
+rp='Pathname where the private library files will reside?'
+. ./getfile
+if $test "X$privlibexp" != "X$ansexp"; then
+	installprivlib=''
+fi
+privlib="$ans"
+privlibexp="$ansexp"
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+private files reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installprivlib" in
+	'') dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installprivlib";;
+	esac
+	fn=de~
+	rp='Where will private files be installed?'
+	. ./getfile
+	installprivlib="$ans"
+else
+	installprivlib="$privlibexp"
+fi
+
+: set the base revision
+baserev=5.0
+
+: get the patchlevel
+echo " "
+echo "Getting the current patchlevel..." >&4
+if $test -r ../patchlevel.h;then
+	patchlevel=`awk '/PATCHLEVEL/ {print $3}' < ../patchlevel.h`
+	subversion=`awk '/SUBVERSION/ {print $3}' < ../patchlevel.h`
+else
+	patchlevel=0
+	subversion=0
+fi
+echo "(You have $package $baserev PL$patchlevel sub$subversion.)"
+
+: set the prefixup variable, to restore leading tilda escape
+prefixup='case "$prefixexp" in
+"$prefix") ;;
+*) eval "$1=\`echo \$$1 | sed \"s,^$prefixexp,$prefix,\"\`";;
+esac'
+
+: determine where public architecture dependent libraries go
+set archlib archlib
+eval $prefixit
+case "$archlib" in
+'')
+	case "$privlib" in
+	'')
+		dflt=`./loc . "." $prefixexp/lib /usr/local/lib /usr/lib /lib`
+		set dflt
+		eval $prefixup
+		;;
+	*)	version=`echo $baserev $patchlevel $subversion | \
+		    $awk '{print $1 + $2/1000.0 + $3/100000.0}'`
+		dflt="$privlib/$archname/$version"
+		;;
+	esac
+	;;
+*) dflt="$archlib";;
+esac
+cat <<EOM
+
+$spackage contains architecture-dependent library files.  If you are
+sharing libraries in a heterogeneous environment, you might store
+these files in a separate location.  Otherwise, you can just include
+them with the rest of the public library files.
+
+EOM
+fn=d+~
+rp='Where do you want to put the public architecture-dependent libraries?'
+. ./getfile
+archlib="$ans"
+archlibexp="$ansexp"
+
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+private files reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installarchlib" in
+	'') dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installarchlib";;
+	esac
+	fn=de~
+	rp='Where will architecture-dependent library files be installed?'
+	. ./getfile
+	installarchlib="$ans"
+else
+	installarchlib="$archlibexp"
+fi
+if $test X"$archlib" = X"$privlib"; then
+	d_archlib="$undef"
+else
+	d_archlib="$define"
+fi
+
+: set up the script used to warn in case of inconsistency
+cat <<'EOSC' >whoa
+dflt=y
+echo " "
+echo "*** WHOA THERE!!! ***" >&4
+echo "    The $hint value for \$$var on this machine was \"$was\"!" >&4
+rp="    Keep the $hint value?"
+. ./myread
+case "$ans" in
+y) td=$was; tu=$was;;
+esac
+EOSC
+
+: function used to set $1 to $val
+setvar='var=$1; eval "was=\$$1"; td=$define; tu=$undef;
+case "$val$was" in
+$define$undef) . ./whoa; eval "$var=\$td";;
+$undef$define) . ./whoa; eval "$var=\$tu";;
+*) eval "$var=$val";;
+esac'
+
+: make some quick guesses about what we are up against
+echo " "
+$echo $n "Hmm...  $c"
+echo exit 1 >bsd
+echo exit 1 >usg
+echo exit 1 >v7
+echo exit 1 >osf1
+echo exit 1 >eunice
+echo exit 1 >xenix
+echo exit 1 >venix
+d_bsd="$undef"
+$cat /usr/include/signal.h /usr/include/sys/signal.h >foo 2>/dev/null
+if test -f /osf_boot || $contains 'OSF/1' /usr/include/ctype.h >/dev/null 2>&1
+then
+	echo "Looks kind of like an OSF/1 system, but we'll see..."
+	echo exit 0 >osf1
+elif test `echo abc | tr a-z A-Z` = Abc ; then
+	xxx=`./loc addbib blurfl $pth`
+	if $test -f $xxx; then
+	echo "Looks kind of like a USG system with BSD features, but we'll see..."
+		echo exit 0 >bsd
+		echo exit 0 >usg
+	else
+		if $contains SIGTSTP foo >/dev/null 2>&1 ; then
+			echo "Looks kind of like an extended USG system, but we'll see..."
+		else
+			echo "Looks kind of like a USG system, but we'll see..."
+		fi
+		echo exit 0 >usg
+	fi
+elif $contains SIGTSTP foo >/dev/null 2>&1 ; then
+	echo "Looks kind of like a BSD system, but we'll see..."
+	d_bsd="$define"
+	echo exit 0 >bsd
+else
+	echo "Looks kind of like a Version 7 system, but we'll see..."
+	echo exit 0 >v7
+fi
+case "$eunicefix" in
+*unixtovms*)
+	$cat <<'EOI'
+There is, however, a strange, musty smell in the air that reminds me of
+something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit.
+EOI
+	echo exit 0 >eunice
+	d_eunice="$define"
+: it so happens the Eunice I know will not run shell scripts in Unix format
+	;;
+*)
+	echo " "
+	echo "Congratulations.  You aren't running Eunice."
+	d_eunice="$undef"
+	;;
+esac
+if test -f /xenix; then
+	echo "Actually, this looks more like a XENIX system..."
+	echo exit 0 >xenix
+	d_xenix="$define"
+else
+	echo " "
+	echo "It's not Xenix..."
+	d_xenix="$undef"
+fi
+chmod +x xenix
+$eunicefix xenix
+if test -f /venix; then
+	echo "Actually, this looks more like a VENIX system..."
+	echo exit 0 >venix
+else
+	echo " "
+	if ./xenix; then
+		: null
+	else
+		echo "Nor is it Venix..."
+	fi
+fi
+chmod +x bsd usg v7 osf1 eunice xenix venix
+$eunicefix bsd usg v7 osf1 eunice xenix venix
+$rm -f foo
+
+: see if setuid scripts can be secure
+$cat <<EOM
+
+Some kernels have a bug that prevents setuid #! scripts from being
+secure.  Some sites have disabled setuid #! scripts because of this.
+
+First let's decide if your kernel supports secure setuid #! scripts.
+(If setuid #! scripts would be secure but have been disabled anyway,
+don't say that they are secure if asked.)
+
+EOM
+
+val="$undef"
+if $test -d /dev/fd; then
+	echo "#!$ls" >reflect
+	chmod +x,u+s reflect
+	./reflect >flect 2>&1
+	if $contains "/dev/fd" flect >/dev/null; then
+		echo "Congratulations, your kernel has secure setuid scripts!" >&4
+		val="$define"
+	else
+		$cat <<EOM
+If you are not sure if they are secure, I can check but I'll need a
+username and password different from the one you are using right now.
+If you don't have such a username or don't want me to test, simply
+enter 'none'.
+
+EOM
+		rp='Other username to test security of setuid scripts with?'
+		dflt='none'
+		. ./myread
+		case "$ans" in
+		n|none)
+			case "$d_suidsafe" in
+			'')	echo "I'll assume setuid scripts are *not* secure." >&4
+				dflt=n;;
+			"$undef")
+				echo "Well, the $hint value is *not* secure." >&4
+				dflt=n;;
+			*)	echo "Well, the $hint value *is* secure." >&4
+				dflt=y;;
+			esac
+			;;
+		*)
+			$rm -f reflect flect
+			echo "#!$ls" >reflect
+			chmod +x,u+s reflect
+			echo >flect
+			chmod a+w flect
+			echo '"su" will (probably) prompt you for '"$ans's password."
+			su $ans -c './reflect >flect'
+			if $contains "/dev/fd" flect >/dev/null; then
+				echo "Okay, it looks like setuid scripts are secure." >&4
+				dflt=y
+			else
+				echo "I don't think setuid scripts are secure." >&4
+				dflt=n
+			fi
+			;;
+		esac
+		rp='Does your kernel have *secure* setuid scripts?'
+		. ./myread
+		case "$ans" in
+		[yY]*)	val="$define";;
+		*)	val="$undef";;
+		esac
+	fi
+else
+	echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4
+	val="$undef"
+fi
+set d_suidsafe
+eval $setvar
+
+$rm -f reflect flect
+
+: now see if they want to do setuid emulation
+echo " "
+val="$undef"
+case "$d_suidsafe" in
+"$define")
+	val="$undef"
+	echo "No need to emulate SUID scripts since they are secure here." >& 4
+	;;
+*)
+	$cat <<EOM
+Some systems have disabled setuid scripts, especially systems where
+setuid scripts cannot be secure.  On systems where setuid scripts have
+been disabled, the setuid/setgid bits on scripts are currently
+useless.  It is possible for $package to detect those bits and emulate
+setuid/setgid in a secure fashion.  This emulation will only work if
+setuid scripts have been disabled in your kernel.
+
+EOM
+	case "$d_dosuid" in
+	"$define") dflt=y ;;
+	*) dflt=n ;;
+	esac
+	rp="Do you want to do setuid/setgid emulation?"
+	. ./myread
+	case "$ans" in
+	[yY]*)	val="$define";;
+	*)	val="$undef";;
+	esac
+	;;
+esac
+set d_dosuid
+eval $setvar
+
+: determine where site specific libraries go.
+set sitelib sitelib
+eval $prefixit
+case "$sitelib" in
+'')	dflt="$privlib/site_perl" ;;
+*)	dflt="$sitelib" ;;
+esac
+$cat <<EOM
+
+The installation process will also create a directory for
+site-specific extensions and modules.  Some users find it convenient
+to place all local files in this directory rather than in the main
+distribution directory.
+
+EOM
+fn=d~+
+rp='Pathname for the site-specific library files?'
+. ./getfile
+if $test "X$sitelibexp" != "X$ansexp"; then
+	installsitelib=''
+fi
+sitelib="$ans"
+sitelibexp="$ansexp"
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+private files reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installsitelib" in
+	'') dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installsitelib";;
+	esac
+	fn=de~
+	rp='Where will private files be installed?'
+	. ./getfile
+	installsitelib="$ans"
+else
+	installsitelib="$sitelibexp"
+fi
+
+: determine where site specific architecture-dependent libraries go.
+xxx=`echo $sitelib/$archname | sed 's!^$prefix!!'`
+: xxx is usuually lib/site_perl/archname.
+set sitearch sitearch none
+eval $prefixit
+case "$sitearch" in
+'')	dflt="$sitelib/$archname" ;;
+*)	dflt="$sitearch" ;;
+esac
+$cat <<EOM
+
+The installation process will also create a directory for
+architecture-dependent site-specific extensions and modules.
+
+EOM
+fn=nd~+
+rp='Pathname for the site-specific architecture-dependent library files?'
+. ./getfile
+if $test "X$sitearchexp" != "X$ansexp"; then
+	installsitearch=''
+fi
+sitearch="$ans"
+sitearchexp="$ansexp"
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+private files reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installsitearch" in
+	'') dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installsitearch";;
+	esac
+	fn=de~
+	rp='Where will private files be installed?'
+	. ./getfile
+	installsitearch="$ans"
+else
+	installsitearch="$sitearchexp"
+fi
+
+: determine where old public architecture dependent libraries might be
+case "$oldarchlib" in
+'')	case "$privlib" in
+	'') ;;
+	*)	dflt="$privlib/$archname"
+		;;
+	esac
+	;;
+*)	dflt="$oldarchlib" 
+	;;
+esac
+if $test ! -d "$dflt/auto"; then
+	dflt=none
+fi
+cat <<EOM
+
+In 5.001, Perl stored architecture-dependent library files in a library
+with a name such as $privlib/$archname, 
+and this directory contained files from the standard extensions and 
+files from any additional extensions you might have added.  Starting 
+with version 5.002, all the architecture-dependent standard extensions 
+will go into $archlib, 
+while locally-added extensions will go into
+$sitearch.
+
+If you wish Perl to continue to search the old architecture-dependent
+library for your local extensions, give the path to that directory.
+If you do not wish to use your old architecture-dependent library
+files, answer 'none'.
+
+EOM
+fn=dn~
+rp='Directory for your old 5.001 architecture-dependent libraries?'
+. ./getfile
+oldarchlib="$ans"
+oldarchlibexp="$ansexp"
+case "$oldarchlib" in
+''|' ') val="$undef" ;;
+*) val="$define" ;;
+esac
+set d_oldarchlib
+eval $setvar
+
+: determine where public executables go
+echo " "
+set dflt bin bin
+eval $prefixit
+fn=d~
+rp='Pathname where the public executables will reside?'
+. ./getfile
+if $test "X$ansexp" != "X$binexp"; then
+	installbin=''
+fi
+bin="$ans"
+binexp="$ansexp"
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+executables reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installbin" in
+	'') dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installbin";;
+	esac
+	fn=de~
+	rp='Where will public executables be installed?'
+	. ./getfile
+	installbin="$ans"
+else
+	installbin="$binexp"
+fi
+
+: determine where manual pages are on this system
+echo " "
+case "$sysman" in
+'') 
+	syspath='/usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1'
+	syspath="$syspath /usr/man/u_man/man1 /usr/share/man/man1"
+	syspath="$syspath /usr/catman/u_man/man1 /usr/man/l_man/man1"
+	syspath="$syspath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1"
+	syspath="$syspath /usr/man/man.L /local/man/man1 /usr/local/man/man1"
+	sysman=`./loc . /usr/man/man1 $syspath`
+	;;
+esac
+if $test -d "$sysman"; then
+	echo "System manual is in $sysman." >&4
+else
+	echo "Could not find manual pages in source form." >&4
+fi
+
+: determine where manual pages go
+set man1dir man1dir none
+eval $prefixit
+$cat <<EOM
+
+$spackage has manual pages available in source form.
+EOM
+case "$nroff" in
+nroff)
+	echo "However, you don't have nroff, so they're probably useless to you."
+	case "$man1dir" in
+	'') man1dir="none";;
+	esac;;
+esac
+echo "If you don't want the manual sources installed, answer 'none'."
+case "$man1dir" in
+' ') dflt=none
+	;;
+'')
+	lookpath="$prefixexp/man/man1 $prefixexp/man/l_man/man1"
+	lookpath="$lookpath $prefixexp/man/p_man/man1"
+	lookpath="$lookpath $prefixexp/man/u_man/man1"
+	lookpath="$lookpath $prefixexp/man/man.1"
+	: If prefix contains 'perl' then we want to keep the man pages
+	: under the prefix directory.  Otherwise, look in a variety of
+	: other possible places.  This is debatable, but probably a
+	: good compromise.  Well, apparently not.
+	: Experience has shown people expect man1dir to be under prefix,
+	: so we now always put it there.  Users who want other behavior
+	: can answer interactively or use a command line option.
+	: Does user have System V-style man paths.
+	case "$sysman" in
+	*/?_man*)	dflt=`./loc . $prefixexp/l_man/man1 $lookpath` ;;
+	*)	dflt=`./loc . $prefixexp/man/man1 $lookpath` ;;
+	esac
+	set dflt
+	eval $prefixup
+	;;
+*)  dflt="$man1dir"
+	;;
+esac
+echo " "
+fn=dn+~
+rp="Where do the main $spackage manual pages (source) go?"
+. ./getfile
+if $test "X$man1direxp" != "X$ansexp"; then
+	installman1dir=''
+fi
+man1dir="$ans"
+man1direxp="$ansexp"
+case "$man1dir" in
+'') man1dir=' '
+	installman1dir='';;
+esac
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+manual pages reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installman1dir" in
+	'') dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installman1dir";;
+	esac
+	fn=de~
+	rp='Where will man pages be installed?'
+	. ./getfile
+	installman1dir="$ans"
+else
+	installman1dir="$man1direxp"
+fi
+
+: What suffix to use on installed man pages
+
+case "$man1dir" in
+' ')
+	man1ext='0'
+	;;
+*)
+	rp="What suffix should be used for the main $spackage man pages?"
+	case "$man1ext" in
+	'')	case "$man1dir" in
+		*1)  dflt=1 ;;
+		*1p) dflt=1p ;;
+		*1pm) dflt=1pm ;;
+		*l) dflt=l;;
+		*n) dflt=n;;
+		*o) dflt=o;;
+		*p) dflt=p;;
+		*C) dflt=C;;
+		*L) dflt=L;;
+		*L1) dflt=L1;;
+		*) dflt=1;;
+		esac
+		;;
+	*)	dflt="$man1ext";;
+	esac
+	. ./myread
+	man1ext="$ans"
+	;;
+esac
+
+: see if we can have long filenames
+echo " "
+rmlist="$rmlist /tmp/cf$$"
+$test -d /tmp/cf$$ || mkdir /tmp/cf$$
+first=123456789abcdef
+second=/tmp/cf$$/$first
+$rm -f $first $second
+if (echo hi >$first) 2>/dev/null; then
+	if $test -f 123456789abcde; then
+		echo 'You cannot have filenames longer than 14 characters.  Sigh.' >&4
+		val="$undef"
+	else
+		if (echo hi >$second) 2>/dev/null; then
+			if $test -f /tmp/cf$$/123456789abcde; then
+				$cat <<'EOM'
+That's peculiar... You can have filenames longer than 14 characters, but only
+on some of the filesystems.  Maybe you are using NFS.  Anyway, to avoid problems
+I shall consider your system cannot support long filenames at all.
+EOM
+				val="$undef"
+			else
+				echo 'You can have filenames longer than 14 characters.' >&4
+				val="$define"
+			fi
+		else
+			$cat <<'EOM'
+How confusing! Some of your filesystems are sane enough to allow filenames
+longer than 14 characters but some others like /tmp can't even think about them.
+So, for now on, I shall assume your kernel does not allow them at all.
+EOM
+			val="$undef"
+		fi
+	fi
+else
+	$cat <<'EOM'
+You can't have filenames longer than 14 chars.  You can't even think about them!
+EOM
+	val="$undef"
+fi 
+set d_flexfnam
+eval $setvar
+$rm -rf /tmp/cf$$ 123456789abcde*
+
+: determine where library module manual pages go
+set man3dir man3dir none
+eval $prefixit
+$cat <<EOM
+
+$spackage has manual pages for many of the library modules.
+EOM
+
+case "$nroff" in
+nroff)
+	$cat <<'EOM'
+However, you don't have nroff, so they're probably useless to you.
+You can use the supplied perldoc script instead.
+EOM
+	case "$man3dir" in
+	'') man3dir="none";;
+	esac;;
+esac
+
+case "$d_flexfnam" in
+undef)
+	$cat <<'EOM'
+However, your system can't handle the long file names like File::Basename.3. 
+You can use the supplied perldoc script instead.
+EOM
+	case "$man3dir" in
+	'') man3dir="none";;
+	esac;;
+esac
+
+echo "If you don't want the manual sources installed, answer 'none'."
+: We dont use /usr/local/man/man3 because some man programs will
+: only show the /usr/local/man/man3 contents, and not the system ones,
+: thus man less will show the perl module less.pm, but not the system
+: less command.  We might also conflict with TCL man pages.
+: However, something like /opt/perl/man/man3 is fine.
+case "$man3dir" in
+'')	case "$prefix" in 
+	*perl*) dflt=`echo $man1dir | 
+			$sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;;
+	*)	dflt="$privlib/man/man3" ;;
+	esac
+	;;
+' ') dflt=none;;
+*)	dflt="$man3dir" ;;
+esac
+echo " "
+
+fn=dn+~
+rp="Where do the $spackage library man pages (source) go?"
+. ./getfile
+if test "X$man3direxp" != "X$ansexp"; then
+	installman3dir=''
+fi
+
+man3dir="$ans"
+man3direxp="$ansexp"
+case "$man3dir" in
+'') man3dir=' '
+	installman3dir='';;
+esac
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+manual pages reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installman3dir" in
+	'') dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installman3dir";;
+	esac
+	fn=de~
+	rp='Where will man pages be installed?'
+	. ./getfile
+	installman3dir="$ans"
+else
+	installman3dir="$man3direxp"
+fi
+
+: What suffix to use on installed man pages
+
+case "$man3dir" in
+' ')
+	man3ext='0'
+	;;
+*)
+	rp="What suffix should be used for the $spackage library man pages?"
+	case "$man3ext" in
+	'')	case "$man3dir" in
+		*3)  dflt=3 ;;
+		*3p) dflt=3p ;;
+		*3pm) dflt=3pm ;;
+		*l) dflt=l;;
+		*n) dflt=n;;
+		*o) dflt=o;;
+		*p) dflt=p;;
+		*C) dflt=C;;
+		*L) dflt=L;;
+		*L3) dflt=L3;;
+		*) dflt=3;;
+		esac
+		;;
+	*)	dflt="$man3ext";;
+	esac
+	. ./myread
+	man3ext="$ans"
+	;;
+esac
+
+: see what memory models we can support
+case "$models" in
+'')
+	$cat >pdp11.c <<'EOP'
+main() {
+#ifdef pdp11
+	exit(0);
+#else
+	exit(1);
+#endif
+}
+EOP
+	cc -o pdp11 pdp11.c >/dev/null 2>&1
+	if ./pdp11 2>/dev/null; then
+		dflt='unsplit split'
+	else
+		tans=`./loc . X /lib/small /lib/large /usr/lib/small /usr/lib/large /lib/medium /usr/lib/medium /lib/huge`
+		case "$tans" in
+		X) dflt='none';;
+		*) if $test -d /lib/small || $test -d /usr/lib/small; then
+				dflt='small'
+			else
+				dflt=''
+			fi
+			if $test -d /lib/medium || $test -d /usr/lib/medium; then
+				dflt="$dflt medium"
+			fi
+			if $test -d /lib/large || $test -d /usr/lib/large; then
+				dflt="$dflt large"
+			fi
+			if $test -d /lib/huge || $test -d /usr/lib/huge; then
+				dflt="$dflt huge"
+			fi
+		esac
+	fi;;
+*) dflt="$models";;
+esac
+$cat <<EOM
+ 
+Some systems have different model sizes.  On most systems they are called
+small, medium, large, and huge.  On the PDP11 they are called unsplit and
+split.  If your system doesn't support different memory models, say "none".
+If you wish to force everything to one memory model, say "none" here and
+put the appropriate flags later when it asks you for other cc and ld flags.
+Venix systems may wish to put "none" and let the compiler figure things out.
+(In the following question multiple model names should be space separated.)
+
+EOM
+rp="Which memory models are supported?"
+. ./myread
+models="$ans"
+
+case "$models" in
+none)
+	small=''
+	medium=''
+	large=''
+	huge=''
+	unsplit=''
+	split=''
+	;;
+*split)
+	case "$split" in
+	'') if $contains '\-i' $sysman/ld.1 >/dev/null 2>&1 || \
+			 $contains '\-i' $sysman/cc.1 >/dev/null 2>&1; then
+			dflt='-i'
+		else
+			dflt='none'
+		fi;;
+	*) dflt="$split";;
+	esac
+	rp="What flag indicates separate I and D space?"
+	. ./myread
+	tans="$ans"
+	case "$tans" in
+	none) tans='';;
+	esac
+	split="$tans"
+	unsplit='';;
+*large*|*small*|*medium*|*huge*)
+	case "$models" in
+	*large*)
+		case "$large" in
+		'') dflt='-Ml';;
+		*) dflt="$large";;
+		esac
+	rp="What flag indicates large model?"
+	. ./myread
+	tans="$ans"
+	case "$tans" in
+	none) tans='';
+	esac
+	large="$tans";;
+	*) large='';;
+	esac
+	case "$models" in
+	*huge*) case "$huge" in
+		'') dflt='-Mh';;
+		*) dflt="$huge";;
+		esac
+		rp="What flag indicates huge model?"
+		. ./myread
+		tans="$ans"
+		case "$tans" in
+		none) tans='';
+		esac
+		huge="$tans";;
+	*) huge="$large";;
+	esac
+	case "$models" in
+	*medium*) case "$medium" in
+		'') dflt='-Mm';;
+		*) dflt="$medium";;
+		esac
+		rp="What flag indicates medium model?"
+		. ./myread
+		tans="$ans"
+		case "$tans" in
+		none) tans='';
+		esac
+		medium="$tans";;
+	*) medium="$large";;
+	esac
+	case "$models" in
+	*small*) case "$small" in
+		'') dflt='none';;
+		*) dflt="$small";;
+		esac
+		rp="What flag indicates small model?"
+		. ./myread
+		tans="$ans"
+		case "$tans" in
+		none) tans='';
+		esac
+		small="$tans";;
+	*) small='';;
+	esac
+	;;
+*)
+	echo "Unrecognized memory models--you may have to edit Makefile.SH" >&4
+	;;
+esac
+
+: see if we need a special compiler
+echo " "
+if ./usg; then
+	case "$cc" in
+	'') case "$Mcc" in
+		/*) dflt='Mcc';;
+		*) case "$large" in
+			-M*) dflt='cc';;
+			*)	if $contains '\-M' $sysman/cc.1 >/dev/null 2>&1 ; then
+					if $contains '\-M' $sysman/cpp.1 >/dev/null 2>&1; then
+						dflt='cc'
+					else
+						dflt='cc -M'
+					fi
+				else
+					dflt='cc'
+				fi;;
+			esac;;
+		esac;;
+	*)  dflt="$cc";;
+	esac
+	$cat <<'EOM'
+On some systems the default C compiler will not resolve multiple global
+references that happen to have the same name.  On some such systems the "Mcc"
+command may be used to force these to be resolved.  On other systems a "cc -M"
+command is required.  (Note that the -M flag on other systems indicates a
+memory model to use!) If you have the Gnu C compiler, you might wish to use
+that instead.
+
+EOM
+	rp="What command will force resolution on this system?"
+	. ./myread
+	cc="$ans"
+else
+	case "$cc" in
+	'') dflt=cc;;
+	*) dflt="$cc";;
+	esac
+	rp="Use which C compiler?"
+	. ./myread
+	cc="$ans"
+fi
+echo " "
+echo "Checking for GNU cc in disguise and/or its version number..." >&4
+$cat >gccvers.c <<EOM
+#include <stdio.h>
+int main() {
+#ifdef __GNUC__
+#ifdef __VERSION__
+	printf("%s\n", __VERSION__);
+#else
+	printf("%s\n", "1");
+#endif
+#endif
+	exit(0);
+}
+EOM
+if $cc -o gccvers gccvers.c >/dev/null 2>&1; then
+	gccversion=`./gccvers`
+	case "$gccversion" in
+	'') echo "You are not using GNU cc." ;;
+	*)  echo "You are using GNU cc $gccversion." ;;
+	esac
+else
+	echo " "
+	echo "*** WHOA THERE!!! ***" >&4
+	echo "    Your C compiler \"$cc\" doesn't seem to be working!" >&4
+	case "$knowitall" in
+	'')
+	echo "    You'd better start hunting for one and let me know about it." >&4
+		exit 1
+		;;
+	esac
+fi
+$rm -f gccvers*
+case "$gccversion" in
+1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
+esac
+
+: What should the include directory be ?
+echo " "
+$echo $n "Hmm...  $c"
+dflt='/usr/include'
+incpath=''
+mips_type=''
+if $test -f /bin/mips && /bin/mips; then
+	echo "Looks like a MIPS system..."
+	$cat >usr.c <<'EOCP'
+#ifdef SYSTYPE_BSD43
+/bsd43
+#endif
+EOCP
+	if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then
+		dflt='/bsd43/usr/include'
+		incpath='/bsd43'
+		mips_type='BSD 4.3'
+	else
+		mips_type='System V'
+	fi
+	$rm -f usr.c usr.out
+	echo "and you're compiling with the $mips_type compiler and libraries."
+	xxx_prompt=y
+	echo "exit 0" >mips
+else
+	echo "Doesn't look like a MIPS system."
+	xxx_prompt=n
+	echo "exit 1" >mips
+fi
+chmod +x mips
+$eunicefix mips
+echo " "
+case "$usrinc" in
+'') ;;
+*) dflt="$usrinc";;
+esac
+case "$xxx_prompt" in
+y)	fn=d/
+	rp='Where are the include files you want to use?'
+	. ./getfile
+	usrinc="$ans"
+	;;
+*)	usrinc="$dflt"
+	;;
+esac
+
+: see if we have to deal with yellow pages, now NIS.
+if $test -d /usr/etc/yp || $test -d /etc/yp; then
+	if $test -f /usr/etc/nibindd; then
+		echo " "
+		echo "I'm fairly confident you're on a NeXT."
+		echo " "
+		rp='Do you get the hosts file via NetInfo?'
+		dflt=y
+		case "$hostcat" in
+		nidump*) ;;
+		'') ;;
+		*) dflt=n;;
+		esac
+		. ./myread
+		case "$ans" in
+		y*) hostcat='nidump hosts .';;
+		*)	case "$hostcat" in
+			nidump*) hostcat='';;
+			esac
+			;;
+		esac
+	fi
+	case "$hostcat" in
+	nidump*) ;;
+	*)
+		case "$hostcat" in
+		*ypcat*) dflt=y;;
+		'') if $contains '^\+' /etc/passwd >/dev/null 2>&1; then
+				dflt=y
+			else
+				dflt=n
+			fi;;
+		*) dflt=n;;
+		esac
+		echo " "
+		rp='Are you getting the hosts file via yellow pages?'
+		. ./myread
+		case "$ans" in
+		y*) hostcat='ypcat hosts';;
+		*) hostcat='cat /etc/hosts';;
+		esac
+		;;
+	esac
+fi
+
+: now get the host name
+echo " "
+echo "Figuring out host name..." >&4
+case "$myhostname" in
+'') cont=true
+	echo 'Maybe "hostname" will work...'
+	if tans=`sh -c hostname 2>&1` ; then
+		myhostname=$tans
+		phostname=hostname
+		cont=''
+	fi
+	;;
+*) cont='';;
+esac
+if $test "$cont"; then
+	if ./xenix; then
+		echo 'Oh, dear.  Maybe "/etc/systemid" is the key...'
+		if tans=`cat /etc/systemid 2>&1` ; then
+			myhostname=$tans
+			phostname='cat /etc/systemid'
+			echo "Whadyaknow.  Xenix always was a bit strange..."
+			cont=''
+		fi
+	elif $test -r /etc/systemid; then
+		echo "(What is a non-Xenix system doing with /etc/systemid?)"
+	fi
+fi
+if $test "$cont"; then
+	echo 'No, maybe "uuname -l" will work...'
+	if tans=`sh -c 'uuname -l' 2>&1` ; then
+		myhostname=$tans
+		phostname='uuname -l'
+	else
+		echo 'Strange.  Maybe "uname -n" will work...'
+		if tans=`sh -c 'uname -n' 2>&1` ; then
+			myhostname=$tans
+			phostname='uname -n'
+		else
+			echo 'Oh well, maybe I can mine it out of whoami.h...'
+			if tans=`sh -c $contains' sysname $usrinc/whoami.h' 2>&1` ; then
+				myhostname=`echo "$tans" | $sed 's/^.*"\(.*\)"/\1/'`
+				phostname="sed -n -e '"'/sysname/s/^.*\"\\(.*\\)\"/\1/{'"' -e p -e q -e '}' <$usrinc/whoami.h"
+			else
+				case "$myhostname" in
+				'') echo "Does this machine have an identity crisis or something?"
+					phostname='';;
+				*)
+					echo "Well, you said $myhostname before..."
+					phostname='echo $myhostname';;
+				esac
+			fi
+		fi
+	fi
+fi
+: you do not want to know about this
+set $myhostname
+myhostname=$1
+
+: verify guess
+if $test "$myhostname" ; then
+	dflt=y
+	rp='Your host name appears to be "'$myhostname'".'" Right?"
+	. ./myread
+	case "$ans" in
+	y*) ;;
+	*) myhostname='';;
+	esac
+fi
+
+: bad guess or no guess
+while $test "X$myhostname" = X ; do
+	dflt=''
+	rp="Please type the (one word) name of your host:"
+	. ./myread
+	myhostname="$ans"
+done
+
+: translate upper to lower if necessary
+case "$myhostname" in
+*[A-Z]*)
+	echo "(Normalizing case in your host name)"
+	myhostname=`echo $myhostname | ./tr '[A-Z]' '[a-z]'`
+	;;
+esac
+
+case "$myhostname" in
+*.*)
+	dflt=`expr "X$myhostname" : "X[^.]*\(\..*\)"`
+	myhostname=`expr "X$myhostname" : "X\([^.]*\)\."`
+	echo "(Trimming domain name from host name--host name is now $myhostname)"
+	;;
+*) case "$mydomain" in
+	'')
+		{
+			: If we use NIS, try ypmatch.
+			: Is there some reason why this was not done before?
+			test "X$hostcat" = "Xypcat hosts" &&
+			ypmatch "$myhostname" hosts 2>/dev/null |\
+				$sed -e 's/[	 ]*#.*//; s/$/ /' > hosts && \
+			$test -s hosts
+		} || {
+			: Extract only the relevant hosts, reducing file size,
+			: remove comments, insert trailing space for later use.
+		     	$hostcat | $sed -n -e "s/[	 ]*#.*//; s/\$/ /
+					/[	 ]$myhostname[	. ]/p" > hosts
+		}
+		tmp_re="[	. ]"
+		$test x`$awk "/[0-9].*[	 ]$myhostname$tmp_re/ { sum++ }
+			     END { print sum }" hosts` = x1 || tmp_re="[	 ]"
+		dflt=.`$awk "/[0-9].*[	 ]$myhostname$tmp_re/ {for(i=2; i<=NF;i++) print \\\$i}" \
+			hosts | $sort | $uniq | \
+			$sed -n -e "s/$myhostname\.\([-a-zA-Z0-9_.]\)/\1/p"`
+		case `$echo X$dflt` in
+		X*\ *)	echo "(Several hosts in /etc/hosts matched hostname)"
+			dflt=.
+			;;
+		.) echo "(You do not have fully-qualified names in /etc/hosts)"
+			;;
+		esac
+		case "$dflt" in
+		.)
+			tans=`./loc resolv.conf X /etc /usr/etc`
+			if $test -f "$tans"; then
+				echo "(Attempting domain name extraction from $tans)"
+				: Why was there an Egrep here, when Sed works?
+				dflt=.`$sed -n -e 's/^domain[ 	]*\(.*\)/\1/p' $tans \
+					| ./tr '[A-Z]' '[a-z]' 2>/dev/null`
+			fi
+			;;
+		esac
+		case "$dflt" in
+		.) echo "(No help from resolv.conf either -- attempting clever guess)"
+			dflt=.`sh -c domainname 2>/dev/null`
+			case "$dflt" in
+			'') dflt='.';;
+			.nis.*|.yp.*|.main.*) dflt=`echo $dflt | $sed -e 's/^\.[^.]*//'`;;
+			esac
+			;;
+		esac
+		case "$dflt" in
+		.) echo "(Lost all hope -- silly guess then)"
+			dflt='.uucp'
+			;;
+		esac
+		$rm -f hosts
+		;;
+	*) dflt="$mydomain";;
+	esac;;
+esac
+echo " "
+rp="What is your domain name?"
+. ./myread
+tans="$ans"
+case "$ans" in
+'') ;;
+.*) ;;
+*) tans=".$tans";;
+esac
+mydomain="$tans"
+
+: translate upper to lower if necessary
+case "$mydomain" in
+*[A-Z]*)
+	echo "(Normalizing case in your domain name)"
+	mydomain=`echo $mydomain | ./tr '[A-Z]' '[a-z]'`
+	;;
+esac
+
+: a little sanity check here
+case "$phostname" in
+'') ;;
+*)
+	case `$phostname | ./tr '[A-Z]' '[a-z]'` in
+	$myhostname$mydomain|$myhostname) ;;
+	*)
+		case "$phostname" in
+		sed*)
+			echo "(That doesn't agree with your whoami.h file, by the way.)"
+			;;
+		*)
+			echo "(That doesn't agree with your $phostname command, by the way.)"
+			;;
+		esac
+	;;
+	esac
+	;;
+esac
+
+$cat <<EOM
+
+I need to get your e-mail address in Internet format if possible, i.e.
+something like user@host.domain. Please answer accurately since I have
+no easy means to double check it. The default value provided below
+is most probably close to the reality but may not be valid from outside
+your organization...
+
+EOM
+cont=x
+while test "$cont"; do
+	case "$cf_email" in
+	'') dflt="$cf_by@$myhostname$mydomain";;
+	*) dflt="$cf_email";;
+	esac
+	rp='What is your e-mail address?'
+	. ./myread
+	cf_email="$ans"
+	case "$cf_email" in
+	*@*.*) cont='' ;;
+	*)
+		rp='Address does not look like an Internet one.  Use it anyway?'
+		case "$fastread" in
+		yes) dflt=y ;;
+		*) dflt=n ;;
+		esac
+		. ./myread
+		case "$ans" in
+		y*) cont='' ;;
+		*) echo " " ;;
+		esac
+		;;
+	esac
+done
+
+$cat <<EOM
+
+If you or somebody else will be maintaining perl at your site, please
+fill in the correct e-mail address here so that they may be contacted
+if necessary. Currently, the "perlbug" program included with perl
+will send mail to this address in addition to perlbug@perl.com. You may
+enter "none" for no administrator.
+
+EOM
+case "$perladmin" in
+'') dflt="$cf_email";;
+*) dflt="$perladmin";;
+esac
+rp='Perl administrator e-mail address'
+. ./myread
+perladmin="$ans"
+
+: determine where public executable scripts go
+set scriptdir scriptdir
+eval $prefixit
+case "$scriptdir" in
+'')
+	dflt="$bin"
+	: guess some guesses
+	$test -d /usr/share/scripts && dflt=/usr/share/scripts
+	$test -d /usr/share/bin && dflt=/usr/share/bin
+	$test -d /usr/local/script && dflt=/usr/local/script
+	$test -d $prefixexp/script && dflt=$prefixexp/script
+	set dflt
+	eval $prefixup
+	;;
+*)  dflt="$scriptdir"
+	;;
+esac
+$cat <<EOM
+ 
+Some installations have a separate directory just for executable scripts so
+that they can mount it across multiple architectures but keep the scripts in
+one spot.  You might, for example, have a subdirectory of /usr/share for this.
+Or you might just lump your scripts in with all your other executables.
+ 
+EOM
+fn=d~
+rp='Where do you keep publicly executable scripts?'
+. ./getfile
+if $test "X$ansexp" != "X$scriptdirexp"; then
+	installscript=''
+fi
+scriptdir="$ans"
+scriptdirexp="$ansexp"
+if $afs; then
+	$cat <<EOM
+
+Since you are running AFS, I need to distinguish the directory in which
+scripts reside from the directory in which they are installed (and from
+which they are presumably copied to the former directory by occult means).
+
+EOM
+	case "$installscript" in
+	'') dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;;
+	*) dflt="$installscript";;
+	esac
+	fn=de~
+	rp='Where will public scripts be installed?'
+	. ./getfile
+	installscript="$ans"
+else
+	installscript="$scriptdirexp"
+fi
+
+: determine perl absolute location
+case "$perlpath" in
+'')	perlpath=$binexp/perl ;;
+esac
+
+: figure out how to guarantee perl startup
+case "$startperl" in
+'')
+	case "$sharpbang" in
+	*!)
+		$cat <<EOH
+
+I can use the #! construct to start perl on your system. This will
+make startup of perl scripts faster, but may cause problems if you
+want to share those scripts and perl is not in a standard place
+($perlpath) on all your platforms. The alternative is to force
+a shell by starting the script with a single ':' character.
+
+EOH
+		dflt=$perlpath
+		rp='What shall I put after the #! to start up perl ("none" to not use #!)?'
+		. ./myread
+		case "$ans" in
+		none) startperl=": # use perl";;
+		*) startperl="#!$ans";;
+		esac
+		;;
+	*) startperl=": # use perl"
+		;;
+	esac
+	;;
+esac
+echo "I'll use $startperl to start perl scripts."
+
+: see how we invoke the C preprocessor
+echo " "
+echo "Now, how can we feed standard input to your C preprocessor..." >&4
+cat <<'EOT' >testcpp.c
+#define ABC abc
+#define XYZ xyz
+ABC.XYZ
+EOT
+cd ..
+echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
+chmod 755 cppstdin
+wrapper=`pwd`/cppstdin
+ok='false'
+cd UU
+
+if $test "X$cppstdin" != "X" && \
+	$cppstdin $cppminus <testcpp.c >testcpp.out 2>&1 && \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+then
+	echo "You used to use $cppstdin $cppminus so we'll use that again."
+	case "$cpprun" in
+	'') echo "But let's see if we can live without a wrapper..." ;;
+	*)
+		if $cpprun $cpplast <testcpp.c >testcpp.out 2>&1 && \
+			$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+		then
+			echo "(And we'll use $cpprun $cpplast to preprocess directly.)"
+			ok='true'
+		else
+			echo "(However, $cpprun $cpplast does not work, let's see...)"
+		fi
+		;;
+	esac
+else
+	case "$cppstdin" in
+	'') ;;
+	*)
+		echo "Good old $cppstdin $cppminus does not seem to be of any help..."
+		;;
+	esac
+fi
+
+if $ok; then
+	: nothing
+elif echo 'Maybe "'"$cc"' -E" will work...'; \
+	$cc -E <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "Yup, it does."
+	x_cpp="$cc -E"
+	x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \
+	$cc -E - <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "Yup, it does."
+	x_cpp="$cc -E"
+	x_minus='-';
+elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \
+	$cc -P <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "Yipee, that works!"
+	x_cpp="$cc -P"
+	x_minus='';
+elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \
+	$cc -P - <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "At long last!"
+	x_cpp="$cc -P"
+	x_minus='-';
+elif echo 'No such luck, maybe "'$cpp'" will work...'; \
+	$cpp <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "It works!"
+	x_cpp="$cpp"
+	x_minus='';
+elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \
+	$cpp - <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	echo "Hooray, it works!  I was beginning to wonder."
+	x_cpp="$cpp"
+	x_minus='-';
+elif echo 'Uh-uh.  Time to get fancy.  Trying a wrapper...'; \
+	$wrapper <testcpp.c >testcpp.out 2>&1; \
+	$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+	x_cpp="$wrapper"
+	x_minus=''
+	echo "Eureka!"
+else
+	dflt=''
+	rp="No dice.  I can't find a C preprocessor.  Name one:"
+	. ./myread
+	x_cpp="$ans"
+	x_minus=''
+	$x_cpp <testcpp.c >testcpp.out 2>&1
+	if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then
+		echo "OK, that will do." >&4
+	else
+echo "Sorry, I can't get that to work.  Go find one and rerun Configure." >&4
+		exit 1
+	fi
+fi
+
+case "$ok" in
+false)
+	cppstdin="$x_cpp"
+	cppminus="$x_minus"
+	cpprun="$x_cpp"
+	cpplast="$x_minus"
+	set X $x_cpp
+	shift
+	case "$1" in
+	"$cpp")
+		echo "Perhaps can we force $cc -E using a wrapper..."
+		if $wrapper <testcpp.c >testcpp.out 2>&1; \
+			$contains 'abc.*xyz' testcpp.out >/dev/null 2>&1
+		then
+			echo "Yup, we can."
+			cppstdin="$wrapper"
+			cppminus='';
+		else
+			echo "Nope, we'll have to live without it..."
+		fi
+		;;
+	esac
+	case "$cpprun" in
+	"$wrapper")
+		cpprun=''
+		cpplast=''
+		;;
+	esac
+	;;
+esac
+
+case "$cppstdin" in
+"$wrapper") ;;
+*) $rm -f $wrapper;;
+esac
+$rm -f testcpp.c testcpp.out
+
+: Set private lib path
+case "$plibpth" in
+'') if ./mips; then
+		plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
+	fi;;
+esac
+case "$libpth" in
+' ') dlist='';;
+'') dlist="$loclibpth $plibpth $glibpth";;
+*) dlist="$libpth";;
+esac
+
+: Now check and see which directories actually exist, avoiding duplicates
+libpth=''
+for xxx in $dlist
+do
+    if $test -d $xxx; then
+		case " $libpth " in
+		*" $xxx "*) ;;
+		*) libpth="$libpth $xxx";;
+		esac
+    fi
+done
+$cat <<'EOM'
+
+Some systems have incompatible or broken versions of libraries.  Among
+the directories listed in the question below, please remove any you
+know not to be holding relevant libraries, and add any that are needed.
+Say "none" for none.
+
+EOM
+case "$libpth" in
+'') dflt='none';;
+*)
+	set X $libpth
+	shift
+	dflt=${1+"$@"}
+	;;
+esac
+rp="Directories to use for library searches?"
+. ./myread
+case "$ans" in
+none) libpth=' ';;
+*) libpth="$ans";;
+esac
+
+: determine optimize, if desired, or use for debug flag also
+case "$optimize" in
+' ') dflt='none';;
+'') dflt='-O';;
+*) dflt="$optimize";;
+esac
+$cat <<EOH
+
+Some C compilers have problems with their optimizers, by default, $package
+compiles with the -O flag to use the optimizer.  Alternately, you might want
+to use the symbolic debugger, which uses the -g flag (on traditional Unix
+systems).  Either flag can be specified here.  To use neither flag, specify
+the word "none".
+
+EOH
+rp="What optimizer/debugger flag should be used?"
+. ./myread
+optimize="$ans"
+case "$optimize" in
+'none') optimize=" ";;
+esac
+
+dflt=''
+: We will not override a previous value, but we might want to
+: augment a hint file
+case "$hint" in
+none|recommended)
+	case "$gccversion" in
+	1*) dflt='-fpcc-struct-return' ;;
+	esac
+	case "$optimize" in
+	*-g*) dflt="$dflt -DDEBUGGING";;
+	esac
+	case "$gccversion" in
+	2*) if test -d /etc/conf/kconfig.d &&
+			$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
+		then
+			dflt="$dflt -posix"
+		fi
+		;;
+	esac
+	;;
+esac
+
+case "$mips_type" in
+*BSD*|'') inclwanted="$locincpth $usrinc";;
+*) inclwanted="$locincpth $inclwanted $usrinc/bsd";;
+esac
+for thisincl in $inclwanted; do
+	if $test -d $thisincl; then
+		if $test x$thisincl != x$usrinc; then
+			case "$dflt" in
+			*$thisincl*);;
+			*) dflt="$dflt -I$thisincl";;
+			esac
+		fi
+	fi
+done
+
+inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then
+	xxx=true;
+elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then
+	xxx=true;
+else
+	xxx=false;
+fi;
+if $xxx; then
+	case "$dflt" in
+	*$2*);;
+	*) dflt="$dflt -D$2";;
+	esac;
+fi'
+
+if ./osf1; then
+	set signal.h __LANGUAGE_C__; eval $inctest
+else
+	set signal.h LANGUAGE_C; eval $inctest
+fi
+set signal.h NO_PROTOTYPE; eval $inctest
+set signal.h _NO_PROTO; eval $inctest
+
+case "$hint" in
+none|recommended) dflt="$ccflags $dflt" ;;
+*) dflt="$ccflags";;
+esac
+
+case "$dflt" in
+''|' ') dflt=none;;
+esac
+$cat <<EOH
+
+Your C compiler may want other flags.  For this question you should include
+-I/whatever and -DWHATEVER flags and any other flags used by the C compiler,
+but you should NOT include libraries or ld flags like -lwhatever.  If you
+want $package to honor its debug switch, you should include -DDEBUGGING here.
+Your C compiler might also need additional flags, such as -D_POSIX_SOURCE,
+-DHIDEMYMALLOC or -DCRIPPLED_CC.
+
+To use no flags, specify the word "none".
+
+EOH
+set X $dflt
+shift
+dflt=${1+"$@"}
+rp="Any additional cc flags?"
+. ./myread
+case "$ans" in
+none) ccflags='';;
+*) ccflags="$ans";;
+esac
+
+: the following weeds options from ccflags that are of no interest to cpp
+cppflags="$ccflags"
+case "$gccversion" in
+1*) cppflags="$cppflags -D__GNUC__"
+esac
+case "$mips_type" in
+'');;
+*BSD*) cppflags="$cppflags -DSYSTYPE_BSD43";;
+esac
+case "$cppflags" in
+'');;
+*)
+	echo " "
+	echo "Let me guess what the preprocessor flags are..." >&4
+	set X $cppflags
+	shift
+	cppflags=''
+	$cat >cpp.c <<'EOM'
+#define BLURFL foo
+
+BLURFL xx LFRULB
+EOM
+	previous=''
+	for flag in $*
+	do
+		case "$flag" in
+		-*) ftry="$flag";;
+		*) ftry="$previous $flag";;
+		esac
+		if $cppstdin -DLFRULB=bar $ftry $cppminus <cpp.c \
+			>cpp1.out 2>/dev/null && \
+			$cpprun -DLFRULB=bar $ftry $cpplast <cpp.c \
+			>cpp2.out 2>/dev/null && \
+			$contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \
+			$contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1
+		then
+			cppflags="$cppflags $ftry"
+			previous=''
+		else
+			previous="$flag"
+		fi
+	done
+	set X $cppflags
+	shift
+	cppflags=${1+"$@"}
+	case "$cppflags" in
+	*-*)  echo "They appear to be: $cppflags";;
+	esac
+	$rm -f cpp.c cpp?.out
+	;;
+esac
+
+: flags used in final linking phase
+
+case "$ldflags" in
+'') if ./venix; then
+		dflt='-i -z'
+	else
+		dflt=''
+	fi
+	case "$ccflags" in
+	*-posix*) dflt="$dflt -posix" ;;
+	esac
+	;;
+*) dflt="$ldflags";;
+esac
+
+: Try to guess additional flags to pick up local libraries.
+for thislibdir in $libpth; do
+	case " $loclibpth " in
+	*" $thislibdir "*)
+		case "$dflt " in 
+		*"-L$thislibdir "*) ;;
+		*)  dflt="$dflt -L$thislibdir" ;;
+		esac
+		;;
+	esac
+done
+
+case "$dflt" in
+'') dflt='none' ;;
+esac
+
+$cat <<EOH
+
+Your C linker may need flags.  For this question you should
+include -L/whatever and any other flags used by the C linker, but you
+should NOT include libraries like -lwhatever.
+
+Make sure you include the appropriate -L/path flags if your C linker
+does not normally search all of the directories you specified above,
+namely
+	$libpth
+To use no flags, specify the word "none".
+
+EOH
+
+rp="Any additional ld flags (NOT including libraries)?"
+. ./myread
+case "$ans" in
+none) ldflags='';;
+*) ldflags="$ans";;
+esac
+rmlist="$rmlist pdp11"
+
+: coherency check
+echo " "
+echo "Checking your choice of C compiler and flags for coherency..." >&4
+set X $cc $optimize $ccflags $ldflags try.c -o try
+shift
+$cat >try.msg <<EOM
+I've tried to compile and run a simple program with:
+
+	$*
+	./try
+
+and I got the following output:
+
+EOM
+$cat > try.c <<'EOF'
+#include <stdio.h>
+main() { exit(0); }
+EOF
+dflt=y
+if sh -c "$cc $optimize $ccflags try.c -o try $ldflags" >>try.msg 2>&1; then
+	if sh -c './try' >>try.msg 2>&1; then
+		dflt=n
+	else
+		echo "The program compiled OK, but exited with status $?." >>try.msg
+		rp="You have a problem.  Shall I abort Configure"
+		dflt=y
+	fi
+else
+	echo "I can't compile the test program." >>try.msg
+	rp="You have a BIG problem.  Shall I abort Configure"
+	dflt=y
+fi
+case "$dflt" in
+y)
+	$cat try.msg
+	case "$knowitall" in
+	'')
+		echo "(The supplied flags might be incorrect with this C compiler.)"
+		;;
+	*) dflt=n;;
+	esac
+	echo " "
+	. ./myread
+	case "$ans" in
+	n*|N*) ;;
+	*)	echo "Ok.  Stopping Configure." >&4
+		exit 1
+		;;
+	esac
+	;;
+n) echo "OK, that should do.";;
+esac
+$rm -f try try.* core
+
+: compute shared library extension
+case "$so" in
+'')
+	if xxx=`./loc libc.sl X $libpth`; $test -f "$xxx"; then
+		dflt='sl'
+	else
+		dflt='so'
+	fi
+	;;
+*) dflt="$so";;
+esac
+$cat <<EOM
+
+On some systems, shared libraries may be available.  Answer 'none' if
+you want to suppress searching of shared libraries for the remaining
+of this configuration.
+
+EOM
+rp='What is the file extension used for shared libraries?'
+. ./myread
+so="$ans"
+
+: Looking for optional libraries
+echo " "
+echo "Checking for optional libraries..." >&4
+case "$libs" in
+' '|'') dflt='';;
+*) dflt="$libs";;
+esac
+case "$libswanted" in
+'') libswanted='c_s';;
+esac
+for thislib in $libswanted; do
+	
+	if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then
+		echo "Found -l$thislib (shared)."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l$thislib";;
+		esac
+	elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then
+		echo "Found -l$thislib (shared)."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l$thislib";;
+		esac
+	elif xxx=`./loc lib$thislib.a X $libpth`; $test -f "$xxx"; then
+		echo "Found -l$thislib."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l$thislib";;
+		esac
+	elif xxx=`./loc $thislib.a X $libpth`; $test -f "$xxx"; then
+		echo "Found -l$thislib."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l$thislib";;
+		esac
+	elif xxx=`./loc lib${thislib}_s.a X $libpth`; $test -f "$xxx"; then
+		echo "Found -l${thislib}_s."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l${thislib}_s";;
+		esac
+	elif xxx=`./loc Slib$thislib.a X $xlibpth`; $test -f "$xxx"; then
+		echo "Found -l$thislib."
+		case " $dflt " in
+		*"-l$thislib "*);;
+		*) dflt="$dflt -l$thislib";;
+		esac
+	else
+		echo "No -l$thislib."
+	fi
+done
+set X $dflt
+shift
+dflt="$*"
+case "$libs" in
+'') dflt="$dflt";;
+*) dflt="$libs";;
+esac
+case "$dflt" in
+' '|'') dflt='none';;
+esac
+
+$cat <<EOM
+ 
+Some versions of Unix support shared libraries, which make executables smaller
+but make load time slightly longer.
+
+On some systems, mostly newer Unix System V's, the shared library is included
+by putting the option "-lc_s" as the last thing on the cc command line when
+linking.  Other systems use shared libraries by default.  There may be other
+libraries needed to compile $package on your machine as well.  If your system
+needs the "-lc_s" option, include it here.  Include any other special libraries
+here as well.  Say "none" for none.
+EOM
+
+echo " "
+rp="Any additional libraries?"
+. ./myread
+case "$ans" in
+none) libs=' ';;
+*) libs="$ans";;
+esac
+
+: see if nm is to be used to determine whether a symbol is defined or not
+case "$usenm" in
+'')
+	dflt=`egrep 'inlibc|csym' ../Configure | wc -l 2>/dev/null`
+	if $test $dflt -gt 20; then
+		dflt=y
+	else
+		dflt=n
+	fi
+	;;
+*)
+	case "$usenm" in
+	true) dflt=y;;
+	*) dflt=n;;
+	esac
+	;;
+esac
+$cat <<EOM
+
+I can use 'nm' to extract the symbols from your C libraries. This is a time
+consuming task which may generate huge output on the disk (up to 3 megabytes)
+but that should make the symbols extraction faster. The alternative is to skip
+the 'nm' extraction part and to compile a small test program instead to
+determine whether each symbol is present. If you have a fast C compiler and/or
+if your 'nm' output cannot be parsed, this may be the best solution.
+
+EOM
+rp='Shall I use nm to extract C symbols from the libraries?'
+. ./myread
+case "$ans" in
+n|N) usenm=false;;
+*) usenm=true;;
+esac
+
+runnm=$usenm
+case "$reuseval" in
+true) runnm=false;;
+esac
+
+: nm options which may be necessary
+case "$nm_opt" in
+'') if $test -f /mach_boot; then
+		nm_opt=''
+	elif $test -d /usr/ccs/lib; then
+		nm_opt='-p'
+	elif $test -f /dgux; then
+		nm_opt='-p'
+	else
+		nm_opt=''
+	fi;;
+esac
+
+: nm options which may be necessary for shared libraries but illegal
+: for archive libraries.  Thank you, Linux.
+case "$nm_so_opt" in
+'')	case "$myuname" in
+	*linux*)
+		if nm --help | $grep 'dynamic' > /dev/null 2>&1; then
+			nm_so_opt='--dynamic'
+		fi
+		;;
+	esac
+	;;
+esac
+
+case "$runnm" in
+true)
+: get list of predefined functions in a handy place
+echo " "
+case "$libc" in
+'') libc=unknown
+	case "$libs" in
+	*-lc_s*) libc=`./loc libc_s.a $libc $libpth`
+	esac
+	;;
+esac
+libnames='';
+case "$libs" in
+'') ;;
+*)  for thislib in $libs; do
+	case "$thislib" in
+	-lc|-lc_s)
+		: Handle C library specially below.
+		;;
+	-l*)
+		thislib=`echo $thislib | $sed -e 's/^-l//'`
+		if try=`./loc lib$thislib.$so.'*' X $libpth`; $test -f "$try"; then
+			:
+		elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then
+			:
+		elif try=`./loc lib$thislib.a X $libpth`; $test -f "$try"; then
+			:
+		elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then
+			:
+		elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
+			:
+		elif try=`./loc Slib$thislib.a X $xlibpth`; $test -f "$try"; then
+			:
+		else
+			try=''
+		fi
+		libnames="$libnames $try"
+		;;
+	*) libnames="$libnames $thislib" ;;
+	esac
+	done
+	;;
+esac
+xxx=normal
+case "$libc" in
+unknown)
+	set /lib/libc.$so
+	for xxx in $libpth; do
+		$test -r $1 || set $xxx/libc.$so
+		: The messy sed command sorts on library version numbers.
+		$test -r $1 || \
+			set `echo blurfl; echo $xxx/libc.$so.[0-9]* | \
+				tr ' ' '\012' | egrep -v '\.[A-Za-z]*$' | $sed -e '
+				h
+				s/[0-9][0-9]*/0000&/g
+				s/0*\([0-9][0-9][0-9][0-9][0-9]\)/\1/g
+				G
+				s/\n/ /' | \
+		 	sort | $sed -e 's/^.* //'`
+		eval set \$$#
+	done
+	$test -r $1 || set /usr/ccs/lib/libc.$so
+  	$test -r $1 || set /lib/libsys_s.a
+  	;;
+*)
+	set blurfl
+	;;
+esac
+if $test -r "$1"; then
+	echo "Your (shared) C library seems to be in $1."
+	libc="$1"
+elif $test -r /lib/libc && $test -r /lib/clib; then
+	echo "Your C library seems to be in both /lib/clib and /lib/libc."
+	xxx=apollo
+	libc='/lib/clib /lib/libc'
+	if $test -r /lib/syslib; then
+		echo "(Your math library is in /lib/syslib.)"
+		libc="$libc /lib/syslib"
+	fi
+elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then
+	echo "Your C library seems to be in $libc, as you said before."
+elif $test -r $incpath/usr/lib/libc.a; then
+	libc=$incpath/usr/lib/libc.a;
+	echo "Your C library seems to be in $libc.  That's fine."
+elif $test -r /lib/libc.a; then
+	libc=/lib/libc.a;
+	echo "Your C library seems to be in $libc.  You're normal."
+else
+	if tans=`./loc libc.a blurfl/dyick $libpth`; $test -r "$tans"; then
+		:
+	elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then
+		libnames="$libnames "`./loc clib blurfl/dyick $libpth`
+	elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then
+		:
+	elif tans=`./loc Slibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then
+		:
+	elif tans=`./loc Mlibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then
+		:
+	else
+		tans=`./loc Llibc.a blurfl/dyick $xlibpth`
+	fi
+	if $test -r "$tans"; then
+		echo "Your C library seems to be in $tans, of all places."
+		libc=$tans
+	else
+		libc='blurfl'
+	fi
+fi
+if $test $xxx = apollo -o -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then
+	dflt="$libc"
+	cat <<EOM
+
+If the guess above is wrong (which it might be if you're using a strange
+compiler, or your machine supports multiple models), you can override it here.
+
+EOM
+else
+	dflt=''
+	echo $libpth | tr ' ' '\012' | sort | uniq > libpath
+	cat >&4 <<EOM
+I can't seem to find your C library.  I've looked in the following places:
+
+EOM
+	$sed 's/^/	/' libpath
+	cat <<EOM
+
+None of these seems to contain your C library. I need to get its name...
+
+EOM
+fi
+fn=f
+rp='Where is your C library?'
+. ./getfile
+libc="$ans"
+
+echo " "
+echo $libc $libnames | tr ' ' '\012' | sort | uniq > libnames
+set X `cat libnames`
+shift
+xxx=files
+case $# in 1) xxx=file; esac
+echo "Extracting names from the following $xxx for later perusal:" >&4
+echo " "
+$sed 's/^/	/' libnames >&4
+echo " "
+$echo $n "This may take a while...$c" >&4
+
+: Linux may need the special Dynamic option to nm for shared libraries.
+: In general, this is stored in the nm_so_opt variable.
+: Unfortunately, that option may be fatal on non-shared libraries.
+for nm_libs_ext in $*; do
+    case $nm_libs_ext in
+	*$so*)	nm $nm_so_opt $nm_opt $nm_libs_ext 2>/dev/null ;;
+	*)		nm $nm_opt $nm_libs_ext 2>/dev/null ;;
+	esac
+done > libc.tmp
+
+$echo $n ".$c"
+$grep fprintf libc.tmp > libc.ptf
+xscan='eval "<libc.ptf $com >libc.list"; $echo $n ".$c" >&4'
+xrun='eval "<libc.tmp $com >libc.list"; echo "done" >&4'
+xxx='[ADTSIW]'
+if com="$sed -n -e 's/__IO//' -e 's/^.* $xxx  *_[_.]*//p' -e 's/^.* $xxx //p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e '/|UNDEF/d' -e '/FUNC..GL/s/^.*|__*//p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^.* D __*//p' -e 's/^.* D //p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^_//' -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$grep '|' | $sed -n -e '/|COMMON/d' -e '/|DATA/d' \
+				-e '/ file/d' -e 's/^\([^ 	]*\).*/\1/p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p' -e 's/^.*|FUNC |WEAK .*|//p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^__//' -e '/|Undef/d' -e '/|Proc/s/ .*//p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e '/Def. Text/s/.* \([^ ]*\)\$/\1/p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\
+	eval $xscan;\
+	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+		eval $xrun
+else
+	nm -p $* 2>/dev/null >libc.tmp
+	$grep fprintf libc.tmp > libc.ptf
+	if com="$sed -n -e 's/^.* [ADTSIW]  *_[_.]*//p' -e 's/^.* [ADTSIW] //p'";\
+		eval $xscan; $contains '^fprintf$' libc.list >/dev/null 2>&1
+	then
+		nm_opt='-p'
+		eval $xrun
+	else
+		echo " "
+		echo "nm didn't seem to work right. Trying ar instead..." >&4
+		com=''
+		if ar t $libc > libc.tmp; then
+			for thisname in $libnames; do
+				ar t $thisname >>libc.tmp
+			done
+			$sed -e 's/\.o$//' < libc.tmp > libc.list
+			echo "Ok." >&4
+		else
+			echo "ar didn't seem to work right." >&4
+			echo "Maybe this is a Cray...trying bld instead..." >&4
+			if bld t $libc | $sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list
+			then
+				for thisname in $libnames; do
+					bld t $libnames | \
+					$sed -e 's/.*\///' -e 's/\.o:.*$//' >>libc.list
+					ar t $thisname >>libc.tmp
+				done
+				echo "Ok." >&4
+			else
+				echo "That didn't work either.  Giving up." >&4
+				exit 1
+			fi
+		fi
+	fi
+fi
+nm_extract="$com"
+if $test -f /lib/syscalls.exp; then
+	echo " "
+	echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4
+	$sed -n 's/^\([^ 	]*\)[ 	]*syscall$/\1/p' /lib/syscalls.exp >>libc.list
+fi
+;;
+esac
+$rm -f libnames libpath
+
+: is a C symbol defined?
+csym='tlook=$1;
+case "$3" in
+-v) tf=libc.tmp; tc=""; tdc="";;
+-a) tf=libc.tmp; tc="[0]"; tdc="[]";;
+*) tlook="^$1\$"; tf=libc.list; tc="()"; tdc="()";;
+esac;
+tx=yes;
+case "$reuseval-$4" in
+true-) ;;
+true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
+esac;
+case "$tx" in
+yes)
+	case "$runnm" in
+	true)
+		if $contains $tlook $tf >/dev/null 2>&1;
+		then tval=true;
+		else tval=false;
+		fi;;
+	*)
+		echo "main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c;
+		if $cc $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1;
+		then tval=true;
+		else tval=false;
+		fi;
+		$rm -f t t.c;;
+	esac;;
+*)
+	case "$tval" in
+	$define) tval=true;;
+	*) tval=false;;
+	esac;;
+esac;
+eval "$2=$tval"'
+
+: define an is-in-libc? function
+inlibc='echo " "; td=$define; tu=$undef;
+sym=$1; var=$2; eval "was=\$$2";
+tx=yes;
+case "$reuseval$was" in
+true) ;;
+true*) tx=no;;
+esac;
+case "$tx" in
+yes)
+	set $sym tres -f;
+	eval $csym;
+	case "$tres" in
+	true)
+		echo "$sym() found." >&4;
+		case "$was" in $undef) . ./whoa; esac; eval "$var=\$td";;
+	*)
+		echo "$sym() NOT found." >&4;
+		case "$was" in $define) . ./whoa; esac; eval "$var=\$tu";;
+	esac;;
+*)
+	case "$was" in
+	$define) echo "$sym() found." >&4;;
+	*) echo "$sym() NOT found." >&4;;
+	esac;;
+esac'
+
+: Check how to convert floats to strings.
+echo " "
+echo "Checking for an efficient way to convert floats to strings."
+$cat >try.c <<'EOP'
+#ifdef TRY_gconvert
+#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
+#endif
+#ifdef TRY_gcvt
+#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
+#endif
+#ifdef TRY_sprintf
+#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+#endif
+main() { 
+	char buf[64]; 
+	Gconvert(1.0, 8, 0, buf); 
+	if (buf[0] != '1' || buf[1] != '\0')
+		exit(1);
+	Gconvert(0.0, 8, 0, buf); 
+	if (buf[0] != '0' || buf[1] != '\0')
+		exit(1);
+	Gconvert(-1.0, 8, 0, buf); 
+	if (buf[0] != '-' || buf[1] != '1' || buf[2] != '\0')
+		exit(1);
+	exit(0);
+}
+EOP
+case "$d_Gconvert" in
+gconvert*) xxx_list='gconvert gcvt sprintf' ;;
+gcvt*) xxx_list='gcvt gconvert sprintf' ;;
+sprintf*) xxx_list='sprintf gconvert gcvt' ;;
+*) xxx_list='gconvert gcvt sprintf' ;;
+esac
+
+for xxx_convert in $xxx_list; do
+	echo "Trying $xxx_convert"
+	$rm -f try try.o
+	if $cc $ccflags -DTRY_$xxx_convert $ldflags -o try \
+		try.c $libs > /dev/null 2>&1 ; then
+		echo "$xxx_convert" found. >&4
+		if ./try; then
+			echo "Good, $xxx_convert drops a trailing decimal point."
+			echo "I'll use $xxx_convert to convert floats into a string." >&4
+			break;
+		else
+			echo "But $xxx_convert keeps a trailing decimal point".
+		fi
+	else
+		echo "$xxx_convert NOT found." >&4
+	fi
+done
+		
+case "$xxx_convert" in
+gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;;
+gcvt) d_Gconvert='gcvt((x),(n),(b))' ;;
+*) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;;
+esac
+
+: Initialize h_fcntl
+h_fcntl=false
+
+: Initialize h_sysfile
+h_sysfile=false
+
+: determine filename position in cpp output
+echo " "
+echo "Computing filename position in cpp output for #include directives..." >&4
+echo '#include <stdio.h>' > foo.c
+$cat >fieldn <<EOF
+$startsh
+$cppstdin $cppflags $cppminus <foo.c 2>/dev/null | \
+$grep '^[ 	]*#.*stdio\.h' | \
+while read cline; do
+	pos=1
+	set \$cline
+	while $test \$# -gt 0; do
+		if $test -r \`echo \$1 | $tr -d '"'\`; then
+			echo "\$pos"
+			exit 0
+		fi
+		shift
+		pos=\`expr \$pos + 1\`
+	done
+done
+EOF
+chmod +x fieldn
+fieldn=`./fieldn`
+$rm -f foo.c fieldn
+case $fieldn in
+'') pos='???';;
+1) pos=first;;
+2) pos=second;;
+3) pos=third;;
+*) pos="${fieldn}th";;
+esac
+echo "Your cpp writes the filename in the $pos field of the line."
+
+: locate header file
+$cat >findhdr <<EOF
+$startsh
+wanted=\$1
+name=''
+if test -f $usrinc/\$wanted; then
+	echo "$usrinc/\$wanted"
+	exit 0
+fi
+awkprg='{ print \$$fieldn }'
+echo "#include <\$wanted>" > foo\$\$.c
+$cppstdin $cppminus $cppflags < foo\$\$.c 2>/dev/null | \
+$grep "^[ 	]*#.*\$wanted" | \
+while read cline; do
+	name=\`echo \$cline | $awk "\$awkprg" | $tr -d '"'\`
+	case "\$name" in
+	*/\$wanted) echo "\$name"; exit 0;;
+	*) name='';;
+	esac;
+done;
+$rm -f foo\$\$.c;
+case "\$name" in
+'') exit 1;;
+esac
+EOF
+chmod +x findhdr
+
+: access call always available on UNIX
+set access d_access
+eval $inlibc
+
+: locate the flags for 'access()'
+case "$d_access" in
+"$define")
+	echo " "
+	$cat >access.c <<'EOCP'
+#include <sys/types.h>
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+main() {
+	exit(R_OK);
+}
+EOCP
+	: check sys/file.h first, no particular reason here
+	if $test `./findhdr sys/file.h` && \
+		$cc $cppflags -DI_SYS_FILE access.c -o access >/dev/null 2>&1 ; then
+		h_sysfile=true;
+		echo "<sys/file.h> defines the *_OK access constants." >&4
+	elif $test `./findhdr fcntl.h` && \
+		$cc $cppflags -DI_FCNTL access.c -o access >/dev/null 2>&1 ; then
+		h_fcntl=true;
+		echo "<fcntl.h> defines the *_OK access constants." >&4
+	elif $test `./findhdr unistd.h` && \
+		$cc $cppflags -DI_UNISTD access.c -o access >/dev/null 2>&1 ; then
+		echo "<unistd.h> defines the *_OK access constants." >&4
+	else
+		echo "I can't find the four *_OK access constants--I'll use mine." >&4
+	fi
+	;;
+esac
+$rm -f access*
+
+: see if alarm exists
+set alarm d_alarm
+eval $inlibc
+
+: Look for GNU-cc style attribute checking
+echo " "
+echo "Checking whether your compiler can handle __attribute__ ..." >&4
+$cat >attrib.c <<'EOCP'
+#include <stdio.h>
+void croak (char* pat,...) __attribute__((format(printf,1,2),noreturn));
+EOCP
+if $cc $ccflags -c attrib.c >attrib.out 2>&1 ; then
+	if $contains 'warning' attrib.out >/dev/null 2>&1; then
+		echo "Your C compiler doesn't fully support __attribute__."
+		val="$undef"
+	else
+		echo "Your C compiler supports __attribute__."
+		val="$define"
+	fi
+else
+	echo "Your C compiler doesn't seem to understand __attribute__ at all."
+	val="$undef"
+fi
+set d_attribut
+eval $setvar
+$rm -f attrib*
+
+: see if bcmp exists
+set bcmp d_bcmp
+eval $inlibc
+
+: see if bcopy exists
+set bcopy d_bcopy
+eval $inlibc
+
+: see if setpgrp exists
+set setpgrp d_setpgrp
+eval $inlibc
+
+: see which flavor of setpgrp is in use
+case "$d_setpgrp" in
+"$define")
+	echo " "
+	$cat >set.c <<EOP
+main()
+{
+	if (getuid() == 0) {
+		printf("(I see you are running Configure as super-user...)\n");
+		setuid(1);
+	}
+	if (-1 == setpgrp(1, 1))
+		exit(1);
+	exit(0);
+}
+EOP
+	if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then
+		./set 2>/dev/null
+		case $? in
+		0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4
+			val="$undef";;
+		*) echo "You have to use setpgrp(pid, pgrp) instead of setpgrp()." >&4
+			val="$define";;
+		esac
+	else
+		if ./usg; then
+			xxx="USG one, i.e. you use setpgrp()."
+			val="$undef"
+		else
+			xxx="BSD one, i.e. you use setpgrp(pid, pgrp)."
+			val="$define"
+		fi
+		echo "Assuming your setpgrp is a $xxx" >&4
+	fi
+	;;
+*) val="$undef";;
+esac
+set d_bsdpgrp
+eval $setvar
+$rm -f set set.c
+
+: see if bzero exists
+set bzero d_bzero
+eval $inlibc
+
+: check for length of integer
+echo " "
+case "$intsize" in
+'')
+	echo "Checking to see how big your integers are..." >&4
+	$cat >try.c <<'EOCP'
+#include <stdio.h>
+main()
+{
+	printf("%d\n", sizeof(int));
+	exit(0);
+}
+EOCP
+	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+		intsize=`./try`
+		echo "Your integers are $intsize bytes long."
+	else
+		dflt='4'
+		echo "(I can't seem to compile the test program.  Guessing...)"
+		rp="What is the size of an integer (in bytes)?"
+		. ./myread
+		intsize="$ans"
+	fi
+	;;
+esac
+$rm -f try.c try
+
+: see if signal is declared as pointer to function returning int or void
+echo " "
+xxx=`./findhdr signal.h`
+$test "$xxx" && $cppstdin $cppminus $cppflags < $xxx >$$.tmp 2>/dev/null
+if $contains 'int.*\*[ 	]*signal' $$.tmp >/dev/null 2>&1 ; then
+	echo "You have int (*signal())() instead of void." >&4
+	val="$undef"
+elif $contains 'void.*\*[ 	]*signal' $$.tmp >/dev/null 2>&1 ; then
+	echo "You have void (*signal())() instead of int." >&4
+	val="$define"
+elif $contains 'extern[ 	]*[(\*]*signal' $$.tmp >/dev/null 2>&1 ; then
+	echo "You have int (*signal())() instead of void." >&4
+	val="$undef"
+else
+	case "$d_voidsig" in
+	'')
+	echo "I can't determine whether signal handler returns void or int..." >&4
+		dflt=void
+		rp="What type does your signal handler return?"
+		. ./myread
+		case "$ans" in
+		v*) val="$define";;
+		*) val="$undef";;
+		esac;;
+	"$define")
+		echo "As you already told me, signal handler returns void." >&4;;
+	*)
+		echo "As you already told me, signal handler returns int." >&4;;
+	esac
+fi
+set d_voidsig
+eval $setvar
+case "$d_voidsig" in
+"$define") signal_t="void";;
+*) signal_t="int";;
+esac
+$rm -f $$.tmp
+
+: check for ability to cast large floats to 32-bit ints.
+echo " "
+echo 'Checking whether your C compiler can cast large floats to int32.' >&4
+if $test "$intsize" -eq 4; then
+	xxx=int
+else
+	xxx=long
+fi
+$cat >try.c <<EOCP
+#include <sys/types.h>
+#include <signal.h>
+$signal_t blech() { exit(3); }
+main()
+{
+	$xxx i32;
+	double f;
+	int result = 0;
+	signal(SIGFPE, blech);
+
+	f = (double) 0x7fffffff;
+	f = 10 * f;
+	i32  = ($xxx) f;
+
+	if (i32 != ($xxx) f)
+		result |= 1;
+	exit(result);
+}
+EOCP
+if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+	./try
+	yyy=$?
+else
+	echo "(I can't seem to compile the test program--assuming it can't)"
+	yyy=1
+fi
+case "$yyy" in
+0)	val="$define"
+	echo "Yup, it can."
+	;;
+*)	val="$undef"
+	echo "Nope, it can't."
+	;;
+esac
+set d_casti32
+eval $setvar
+$rm -f try try.*
+
+: check for ability to cast negative floats to unsigned
+echo " "
+echo 'Checking whether your C compiler can cast negative float to unsigned.' >&4
+$cat >try.c <<EOCP
+#include <sys/types.h>
+#include <signal.h>
+$signal_t blech() { exit(7); }
+$signal_t blech_in_list() { exit(4); }
+unsigned long dummy_long(p) unsigned long p; { return p; }
+unsigned int dummy_int(p) unsigned int p; { return p; }
+unsigned short dummy_short(p) unsigned short p; { return p; }
+main()
+{
+	double f = -123.;
+	unsigned long along;
+	unsigned int aint;
+	unsigned short ashort;
+	int result = 0;
+
+	signal(SIGFPE, blech);
+	along = (unsigned long)f;
+	aint = (unsigned int)f;
+	ashort = (unsigned short)f;
+	if (along != (unsigned long)-123)
+		result |= 1;
+	if (aint != (unsigned int)-123)
+		result |= 1;
+	if (ashort != (unsigned short)-123)
+		result |= 1;
+	f = (double)0x40000000;
+	f = f + f;
+	along = 0;
+	along = (unsigned long)f;
+	if (along != 0x80000000)
+		result |= 2;
+	f -= 1.;
+	along = 0;
+	along = (unsigned long)f;
+	if (along != 0x7fffffff)
+		result |= 1;
+	f += 2.;
+	along = 0;
+	along = (unsigned long)f;
+	if (along != 0x80000001)
+		result |= 2;
+	if (result)
+		exit(result);
+	signal(SIGFPE, blech_in_list);
+	f = 123.;
+	along = dummy_long((unsigned long)f);
+	aint = dummy_int((unsigned int)f);
+	ashort = dummy_short((unsigned short)f);
+	if (along != (unsigned long)123)
+		result |= 4;
+	if (aint != (unsigned int)123)
+		result |= 4;
+	if (ashort != (unsigned short)123)
+		result |= 4;
+	exit(result);
+
+}
+EOCP
+if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+	./try
+	castflags=$?
+else
+	echo "(I can't seem to compile the test program--assuming it can't)"
+	castflags=7
+fi
+case "$castflags" in
+0)	val="$define"
+	echo "Yup, it can."
+	;;
+*)	val="$undef"
+	echo "Nope, it can't."
+	;;
+esac
+set d_castneg
+eval $setvar
+$rm -f try.*
+
+: see if vprintf exists
+echo " "
+if set vprintf val -f d_vprintf; eval $csym; $val; then
+	echo 'vprintf() found.' >&4
+	val="$define"
+	$cat >vprintf.c <<'EOF'
+#include <varargs.h>
+
+main() { xxx("foo"); }
+
+xxx(va_alist)
+va_dcl
+{
+	va_list args;
+	char buf[10];
+
+	va_start(args);
+	exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
+}
+EOF
+	if $cc $ccflags vprintf.c -o vprintf >/dev/null 2>&1 && ./vprintf; then
+		echo "Your vsprintf() returns (int)." >&4
+		val2="$undef"
+	else
+		echo "Your vsprintf() returns (char*)." >&4
+		val2="$define"
+	fi
+else
+	echo 'vprintf() NOT found.' >&4
+		val="$undef"
+		val2="$undef"
+fi
+set d_vprintf
+eval $setvar
+val=$val2
+set d_charvspr
+eval $setvar
+
+: see if chown exists
+set chown d_chown
+eval $inlibc
+
+: see if chroot exists
+set chroot d_chroot
+eval $inlibc
+
+: see if chsize exists
+set chsize d_chsize
+eval $inlibc
+
+: check for const keyword
+echo " "
+echo 'Checking to see if your C compiler knows about "const"...' >&4
+$cat >const.c <<'EOCP'
+typedef struct spug { int drokk; } spug;
+main()
+{
+	const char *foo;
+	const spug y;
+}
+EOCP
+if $cc -c $ccflags const.c >/dev/null 2>&1 ; then
+	val="$define"
+	echo "Yup, it does."
+else
+	val="$undef"
+	echo "Nope, it doesn't."
+fi
+set d_const
+eval $setvar
+
+: see if crypt exists
+echo " "
+if set crypt val -f d_crypt; eval $csym; $val; then
+	echo 'crypt() found.' >&4
+	val="$define"
+	cryptlib=''
+else
+	cryptlib=`./loc Slibcrypt.a "" $xlibpth`
+	if $test -z "$cryptlib"; then
+		cryptlib=`./loc Mlibcrypt.a "" $xlibpth`
+	else
+		cryptlib=-lcrypt
+	fi
+	if $test -z "$cryptlib"; then
+		cryptlib=`./loc Llibcrypt.a "" $xlibpth`
+	else
+		cryptlib=-lcrypt
+	fi
+	if $test -z "$cryptlib"; then
+		cryptlib=`./loc libcrypt.a "" $libpth`
+	else
+		cryptlib=-lcrypt
+	fi
+	if $test -z "$cryptlib"; then
+		echo 'crypt() NOT found.' >&4
+		val="$undef"
+	else
+		val="$define"
+	fi
+fi
+set d_crypt
+eval $setvar
+
+: get csh whereabouts
+case "$csh" in
+'csh') val="$undef" ;;
+*) val="$define" ;;
+esac
+set d_csh
+eval $setvar
+full_csh=$csh
+
+: see if cuserid exists
+set cuserid d_cuserid
+eval $inlibc
+
+: define an alternate in-header-list? function
+inhdr='echo " "; td=$define; tu=$undef; yyy=$@;
+cont=true; xxf="echo \"<\$1> found.\" >&4";
+case $# in 2) xxnf="echo \"<\$1> NOT found.\" >&4";;
+*) xxnf="echo \"<\$1> NOT found, ...\" >&4";;
+esac;
+case $# in 4) instead=instead;; *) instead="at last";; esac;
+while $test "$cont"; do
+	xxx=`./findhdr $1`
+	var=$2; eval "was=\$$2";
+	if $test "$xxx" && $test -r "$xxx";
+	then eval $xxf;
+	eval "case \"\$$var\" in $undef) . ./whoa; esac"; eval "$var=\$td";
+		cont="";
+	else eval $xxnf;
+	eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu"; fi;
+	set $yyy; shift; shift; yyy=$@;
+	case $# in 0) cont="";;
+	2) xxf="echo \"but I found <\$1> $instead.\" >&4";
+		xxnf="echo \"and I did not find <\$1> either.\" >&4";;
+	*) xxf="echo \"but I found <\$1\> instead.\" >&4";
+		xxnf="echo \"there is no <\$1>, ...\" >&4";;
+	esac;
+done;
+while $test "$yyy";
+do set $yyy; var=$2; eval "was=\$$2";
+	eval "case \"\$$var\" in $define) . ./whoa; esac"; eval "$var=\$tu";
+	set $yyy; shift; shift; yyy=$@;
+done'
+
+: see if this is a limits.h system
+set limits.h i_limits
+eval $inhdr
+
+: see if this is a float.h system
+set float.h i_float
+eval $inhdr
+
+: See if number of significant digits in a double precision number is known
+echo " "
+$cat >dbl_dig.c <<EOM
+#$i_limits I_LIMITS
+#$i_float I_FLOAT
+#ifdef I_LIMITS
+#include <limits.h>
+#endif
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifdef DBL_DIG
+printf("Contains DBL_DIG");
+#endif
+EOM
+$cppstdin $cppflags $cppminus < dbl_dig.c >dbl_dig.E 2>/dev/null
+if $contains 'DBL_DIG' dbl_dig.E >/dev/null 2>&1; then
+	echo "DBL_DIG found." >&4
+	val="$define"
+else
+	echo "DBL_DIG NOT found." >&4
+	val="$undef"
+fi
+$rm -f dbl_dig.?
+set d_dbl_dig
+eval $setvar
+
+: see if difftime exists
+set difftime d_difftime
+eval $inlibc
+
+: see if this is a dirent system
+echo " "
+if xinc=`./findhdr dirent.h`; $test "$xinc"; then
+	val="$define"
+	echo "<dirent.h> found." >&4
+else
+	val="$undef"
+	if xinc=`./findhdr sys/dir.h`; $test "$xinc"; then
+		echo "<sys/dir.h> found." >&4
+		echo " "
+	else
+		xinc=`./findhdr sys/ndir.h`
+	fi
+	echo "<dirent.h> NOT found." >&4
+fi
+set i_dirent
+eval $setvar
+
+: Look for type of directory structure.
+echo " "
+$cppstdin $cppflags $cppminus < "$xinc" > try.c
+
+case "$direntrytype" in
+''|' ')
+	case "$i_dirent" in
+	$define) guess1='struct dirent' ;;
+	*) guess1='struct direct'  ;;
+	esac
+	;;
+*)	guess1="$direntrytype"
+	;;
+esac
+
+case "$guess1" in
+'struct dirent') guess2='struct direct' ;;
+*) guess2='struct dirent' ;;
+esac
+		
+if $contains "$guess1" try.c >/dev/null 2>&1; then
+	direntrytype="$guess1"
+	echo "Your directory entries are $direntrytype." >&4
+elif $contains "$guess2" try.c >/dev/null 2>&1; then
+	direntrytype="$guess2"
+	echo "Your directory entries seem to be $direntrytype." >&4
+else
+	echo "I don't recognize your system's directory entries." >&4
+	rp="What type is used for directory entries on this system?"
+	dflt="$guess1"
+	. ./myread
+	direntrytype="$ans"
+fi
+$rm -f try.c
+
+
+: see if the directory entry stores field length
+echo " "
+$cppstdin $cppflags $cppminus < "$xinc" > try.c
+if $contains 'd_namlen' try.c >/dev/null 2>&1; then
+	echo "Good, your directory entry keeps length information in d_namlen." >&4
+	val="$define"
+else
+	echo "Your directory entry does not know about the d_namlen field." >&4
+	val="$undef"
+fi
+set d_dirnamlen
+eval $setvar
+$rm -f try.c
+
+: see if dlerror exists
+xxx_runnm="$runnm"
+runnm=false
+set dlerror d_dlerror
+eval $inlibc
+runnm="$xxx_runnm"
+
+: see if dld is available
+set dld.h i_dld
+eval $inhdr
+
+: see if dlopen exists
+xxx_runnm="$runnm"
+runnm=false
+set dlopen d_dlopen
+eval $inlibc
+runnm="$xxx_runnm"
+
+: determine which dynamic loading, if any, to compile in
+echo " "
+dldir="ext/DynaLoader"
+case "$usedl" in
+$define|y|true)
+	dflt='y'
+	usedl="$define"
+	;;
+$undef|n|false)
+	dflt='n'
+	usedl="$undef"
+	;;
+*) 
+	dflt='n'
+	case "$d_dlopen" in
+	    $define) dflt='y' ;;
+	esac
+	case "$i_dld" in
+	    $define) dflt='y' ;;
+	esac
+	: Does a dl_xxx.xs file exist for this operating system
+	$test -f ../$dldir/dl_${osname}.xs && dflt='y'
+	;;
+esac
+rp="Do you wish to use dynamic loading?"
+. ./myread
+usedl="$ans"
+case "$ans" in
+y*) usedl="$define"
+	case "$dlsrc" in
+	'')
+		if $test -f ../$dldir/dl_${osname}.xs ; then
+			dflt="$dldir/dl_${osname}.xs"
+		elif $test "$d_dlopen" = "$define" ; then
+			dflt="$dldir/dl_dlopen.xs"
+		elif $test "$i_dld" = "$define" ; then
+			dflt="$dldir/dl_dld.xs"
+		else
+			dflt=''
+		fi
+		;;
+	*)	dflt="$dldir/$dlsrc"
+		;;
+	esac
+    echo "The following dynamic loading files are available:"
+	: Can not go over to $dldir because getfile has path hard-coded in.
+    cd ..; ls -C $dldir/dl*.xs; cd UU
+    rp="Source file to use for dynamic loading"
+    fn="fne"
+    . ./getfile
+	usedl="$define"
+	: emulate basename
+	dlsrc=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@'`
+
+    $cat << EOM
+
+Some systems may require passing special flags to $cc -c to
+compile modules that will be used to create a shared library.
+To use no flags, say "none".
+
+EOM
+    case "$cccdlflags" in
+    '')	case "$gccversion" in
+		'') case "$osname" in
+			hpux)	dflt='+z' ;;
+			next)	dflt='none' ;;
+			solaris|svr4*|esix*) dflt='-Kpic' ;;
+			sunos)	dflt='-pic' ;;
+			*)	dflt='none' ;;
+		    esac ;;
+		*)	dflt='-fpic' ;;
+	    esac ;;
+    *)	dflt="$cccdlflags" ;;
+    esac
+    rp="Any special flags to pass to $cc -c to compile shared library modules?"
+    . ./myread
+    case "$ans" in
+    none) cccdlflags=' ' ;;
+    *) cccdlflags="$ans" ;;
+    esac
+
+    cat << EOM
+
+Some systems use ld to create libraries that can be dynamically loaded,
+while other systems (such as those using ELF) use $cc.
+
+EOM
+	case "$ld" in
+	'')	$cat >try.c <<'EOM'
+/* Test for whether ELF binaries are produced */
+#include <fcntl.h>
+#include <stdlib.h>
+main() {
+	char b[4];
+	int i = open("a.out",O_RDONLY);
+	if(i == -1) 
+		exit(1); /* fail */
+	if(read(i,b,4)==4 && b[0]==127 && b[1]=='E' && b[2]=='L' && b[3]=='F')
+		exit(0); /* succeed (yes, it's ELF) */
+	else
+		exit(1); /* fail */
+}
+EOM
+		if $cc $ccflags try.c >/dev/null 2>&1 && ./a.out; then
+			cat <<EOM
+You appear to have ELF support.  I'll use $cc to build dynamic libraries.
+EOM
+			dflt="$cc"
+		else
+			echo "I'll use ld to build dynamic libraries."
+			dflt='ld'
+		fi
+		rm -f try.c a.out
+		;;
+	*)	dflt="$ld"
+		;;
+	esac
+
+    rp="What command should be used to create dynamic libraries?"
+    . ./myread
+	ld="$ans"
+
+    cat << EOM
+
+Some systems may require passing special flags to $ld to create a
+library that can be dynamically loaded.  If your ld flags include
+-L/other/path options to locate libraries outside your loader's normal
+search path, you may need to specify those -L options here as well.  To
+use no flags, say "none".
+
+EOM
+    case "$lddlflags" in
+    '') case "$osname" in
+			hpux)  dflt='-b' ;;
+			linux)	dflt='-shared' ;;
+			next)  dflt='none' ;;
+			solaris) dflt='-G' ;;
+			sunos) dflt='-assert nodefinitions' ;;
+			svr4*|esix*) dflt="-G $ldflags" ;;
+	        *)     dflt='none' ;;
+			esac
+			;;
+    *) dflt="$lddlflags" ;;
+    esac
+
+: Try to guess additional flags to pick up local libraries.
+for thisflag in $ldflags; do
+	case "$thisflag" in
+	-L*)
+		case " $dflt " in
+		*" $thisflag "*) ;;
+		*) dflt="$dflt $thisflag" ;;
+		esac
+		;;
+	esac
+done
+
+case "$dflt" in
+'') dflt='none' ;;
+esac
+
+    rp="Any special flags to pass to $ld to create a dynamically loaded library?"
+    . ./myread
+    case "$ans" in
+    none) lddlflags=' ' ;;
+    *) lddlflags="$ans" ;;
+    esac
+
+	cat <<EOM
+
+Some systems may require passing special flags to $cc to indicate that
+the resulting executable will use dynamic linking.  To use no flags,
+say "none".
+
+EOM
+    case "$ccdlflags" in
+    '') case "$osname" in
+		hpux)	dflt='-Wl,-E' ;;
+		linux)	dflt='-rdynamic' ;;
+		next)	dflt='none' ;;
+		sunos)	dflt='none' ;;
+		*)	dflt='none' ;;
+	    esac ;;
+    *)  dflt="$ccdlflags" ;;
+    esac
+    rp="Any special flags to pass to $cc to use dynamic loading?"
+    . ./myread
+    case "$ans" in
+    none) ccdlflags=' ' ;;
+    *) ccdlflags="$ans" ;;
+    esac
+    ;;
+*)  usedl="$undef"
+	ld='ld'
+    dlsrc='dl_none.xs'
+    lddlflags=''
+    ccdlflags=''
+    ;;
+esac
+
+val="$undef"
+case "$osname" in
+esix*|svr4*)
+    case "$usedl" in
+    $define)
+	$cat <<EOM
+
+System V Release 4 systems can support dynamic loading
+only if libperl is created as a shared library.
+
+EOM
+	val="$define"
+	;;
+    esac ;;
+esac
+set d_shrplib; eval $setvar
+case "$d_shrplib" in
+$define)
+    cat <<EOM >&4
+
+Be sure to add the perl source directory to the LD_LIBRARY_PATH
+environment variable before running make:
+    LD_LIBRARY_PATH=`cd ..;pwd`; export LD_LIBRARY_PATH
+or
+    setenv LD_LIBRARY_PATH `cd ..;pwd`
+
+EOM
+;;
+esac
+case "$d_shrplib" in
+$define)
+	case "$shrpdir" in
+	"")	dflt="$archlib/CORE";;
+	*)	dflt="$shrpdir";;
+	esac
+	rp="What directory should we install the shared libperl into?"
+	fn="d~"
+	. ./getfile
+	shrpdir="$ans"
+	;;
+*)	shrpdir='none'
+	;;
+esac
+
+: see if dlfcn is available
+set dlfcn.h i_dlfcn
+eval $inhdr
+
+case "$usedl" in
+$define|y|true)
+	$cat << EOM
+
+On a few systems, the dynamically loaded modules that perl generates and uses
+will need a different extension then shared libs. The default will probably
+be appropriate.
+
+EOM
+	case "$dlext" in
+	'')	dflt="$so" ;;
+	*)	dflt="$dlext" ;;
+	esac
+	rp='What is the extension of dynamically loaded modules'
+	. ./myread
+	dlext="$ans"
+	;;
+*)
+	dlext="none"
+	;;
+esac
+
+: Check if dlsym need a leading underscore
+echo " "
+val="$undef"
+
+case "$dlsrc" in
+dl_dlopen.xs)
+	echo "Checking whether your dlsym() needs a leading underscore ..." >&4
+	$cat >dyna.c <<'EOM'
+fred () { }
+EOM
+
+$cat >fred.c<<EOM
+
+#include <stdio.h>
+#$i_dlfcn I_DLFCN
+#ifdef I_DLFCN
+#include <dlfcn.h>      /* the dynamic linker include file for Sunos/Solaris */
+#else
+#include <sys/types.h>
+#include <nlist.h>
+#include <link.h>
+#endif
+
+extern int fred() ;
+
+main()
+{
+    void * handle ;
+    void * symbol ;
+#ifndef RTLD_LAZY
+    int mode = 1 ;
+#else
+    int mode = RTLD_LAZY ;
+#endif
+    handle = dlopen("./dyna.$dlext", mode) ;
+    if (handle == NULL) {
+        printf ("1\n") ;
+	    exit(0);
+    }
+    symbol = dlsym(handle, "fred") ;
+    if (symbol == NULL) {
+		/* try putting a leading underscore */
+        symbol = dlsym(handle, "_fred") ;
+        if (symbol == NULL) {
+            printf ("2\n") ;
+	    	exit(0);
+		}
+        printf ("3\n") ;
+    }
+    else
+        printf ("4\n") ;
+	exit(0);
+}
+EOM
+	if $cc $ccflags $cccdlflags -c dyna.c > /dev/null 2>&1 && 
+		$ld $lddlflags -o dyna.$dlext dyna.o > /dev/null 2>&1 && 
+		$cc $ccflags $ldflags $cccdlflags $ccdlflags fred.c -o fred $libs > /dev/null 2>&1; then
+		xxx=`./fred`
+		case $xxx in
+		1)	echo "Test program failed using dlopen." >&4
+			echo "Perhaps you should not use dynamic loading." >&4;;
+		2)	echo "Test program failed using dlsym." >&4
+			echo "Perhaps you should not use dynamic loading." >&4;;
+		3)	echo "dlsym needs a leading underscore" >&4
+			val="$define" ;;
+		4)	echo "dlsym doesn't need a leading underscore." >&4;;
+		esac
+	else
+		echo "I can't compile and run the test program." >&4
+	fi
+	;;
+esac
+		
+$rm -f fred fred.? dyna.$dlext dyna.?
+
+set d_dlsymun
+eval $setvar
+
+: see if dup2 exists
+set dup2 d_dup2
+eval $inlibc
+
+: Locate the flags for 'open()'
+echo " "
+$cat >open3.c <<'EOCP'
+#include <sys/types.h>
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+main() {
+	if(O_RDONLY);
+#ifdef O_TRUNC
+	exit(0);
+#else
+	exit(1);
+#endif
+}
+EOCP
+: check sys/file.h first to get FREAD on Sun
+if $test `./findhdr sys/file.h` && \
+		$cc $cppflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then
+	h_sysfile=true;
+	echo "<sys/file.h> defines the O_* constants..." >&4
+	if ./open3; then
+		echo "and you have the 3 argument form of open()." >&4
+		val="$define"
+	else
+		echo "but not the 3 argument form of open().  Oh, well." >&4
+		val="$undef"
+	fi
+elif $test `./findhdr fcntl.h` && \
+		$cc "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then
+	h_fcntl=true;
+	echo "<fcntl.h> defines the O_* constants..." >&4
+	if ./open3; then
+		echo "and you have the 3 argument form of open()." >&4
+		val="$define"
+	else
+		echo "but not the 3 argument form of open().  Oh, well." >&4
+		val="$undef"
+	fi
+else
+	val="$undef"
+	echo "I can't find the O_* constant definitions!  You got problems." >&4
+fi
+set d_open3
+eval $setvar
+$rm -f open3*
+
+: check for non-blocking I/O stuff
+case "$h_sysfile" in
+true) echo "#include <sys/file.h>" > head.c;;
+*)
+	case "$h_fcntl" in
+	true) echo "#include <fcntl.h>" > head.c;;
+	*) echo "#include <sys/fcntl.h>" > head.c;;
+	esac
+	;;
+esac
+echo " "
+echo "Figuring out the flag used by open() for non-blocking I/O..." >&4
+case "$o_nonblock" in
+'')
+	$cat head.c > try.c
+	$cat >>try.c <<'EOCP'
+main() {
+#ifdef O_NONBLOCK
+	printf("O_NONBLOCK\n");
+	exit(0);
+#endif
+#ifdef O_NDELAY
+	printf("O_NDELAY\n");
+	exit(0);
+#endif
+#ifdef FNDELAY
+	printf("FNDELAY\n");
+	exit(0);
+#endif
+	exit(0);
+}
+EOCP
+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
+		o_nonblock=`./try`
+		case "$o_nonblock" in
+		'') echo "I can't figure it out, assuming O_NONBLOCK will do.";;
+		*) echo "Seems like we can use $o_nonblock.";;
+		esac
+	else
+		echo "(I can't compile the test program; pray O_NONBLOCK is right!)"
+	fi
+	;;
+*) echo "Using $hint value $o_nonblock.";;
+esac
+$rm -f try try.* .out core
+
+echo " "
+echo "Let's see what value errno gets from read() on a $o_nonblock file..." >&4
+case "$eagain" in
+'')
+	$cat head.c > try.c
+	$cat >>try.c <<EOCP
+#include <errno.h>
+#include <sys/types.h>
+#include <signal.h>
+#define MY_O_NONBLOCK $o_nonblock
+extern int errno;
+$signal_t blech(x) int x; { exit(3); }
+EOCP
+	$cat >> try.c <<'EOCP'
+main()
+{
+	int pd[2];
+	int pu[2];
+	char buf[1];
+	char string[100];
+
+	pipe(pd);	/* Down: child -> parent */
+	pipe(pu);	/* Up: parent -> child */
+	if (0 != fork()) {
+		int ret;
+		close(pd[1]);	/* Parent reads from pd[0] */
+		close(pu[0]);	/* Parent writes (blocking) to pu[1] */
+		if (-1 == fcntl(pd[0], F_SETFL, MY_O_NONBLOCK))
+			exit(1);
+		signal(SIGALRM, blech);
+		alarm(5);
+		if ((ret = read(pd[0], buf, 1)) > 0)	/* Nothing to read! */
+			exit(2);
+		sprintf(string, "%d\n", ret);
+		write(2, string, strlen(string));
+		alarm(0);
+#ifdef EAGAIN
+		if (errno == EAGAIN) {
+			printf("EAGAIN\n");
+			goto ok;
+		}
+#endif
+#ifdef EWOULDBLOCK
+		if (errno == EWOULDBLOCK)
+			printf("EWOULDBLOCK\n");
+#endif
+	ok:
+		write(pu[1], buf, 1);	/* Unblocks child, tell it to close our pipe */
+		sleep(2);				/* Give it time to close our pipe */
+		alarm(5);
+		ret = read(pd[0], buf, 1);	/* Should read EOF */
+		alarm(0);
+		sprintf(string, "%d\n", ret);
+		write(3, string, strlen(string));
+		exit(0);
+	}
+
+	close(pd[0]);			/* We write to pd[1] */
+	close(pu[1]);			/* We read from pu[0] */
+	read(pu[0], buf, 1);	/* Wait for parent to signal us we may continue */
+	close(pd[1]);			/* Pipe pd is now fully closed! */
+	exit(0);				/* Bye bye, thank you for playing! */
+}
+EOCP
+	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
+		echo "$startsh" >mtry
+		echo "./try >try.out 2>try.ret 3>try.err || exit 4" >>mtry
+		chmod +x mtry
+		./mtry >/dev/null 2>&1
+		case $? in
+		0) eagain=`$cat try.out`;;
+		1) echo "Could not perform non-blocking setting!";;
+		2) echo "I did a successful read() for something that was not there!";;
+		3) echo "Hmm... non-blocking I/O does not seem to be working!";;
+		*) echo "Something terribly wrong happened during testing.";;
+		esac
+		rd_nodata=`$cat try.ret`
+		echo "A read() system call with no data present returns $rd_nodata."
+		case "$rd_nodata" in
+		0|-1) ;;
+		*)
+			echo "(That's peculiar, fixing that to be -1.)"
+			rd_nodata=-1
+			;;
+		esac
+		case "$eagain" in
+		'')
+			echo "Forcing errno EAGAIN on read() with no data available."
+			eagain=EAGAIN
+			;;
+		*)
+			echo "Your read() sets errno to $eagain when no data is available."
+			;;
+		esac
+		status=`$cat try.err`
+		case "$status" in
+		0) echo "And it correctly returns 0 to signal EOF.";;
+		-1) echo "But it also returns -1 to signal EOF, so be careful!";;
+		*) echo "However, your read() returns '$status' on EOF??";;
+		esac
+		val="$define"
+		if test "$status" -eq "$rd_nodata"; then
+			echo "WARNING: you can't distinguish between EOF and no data!"
+			val="$undef"
+		fi
+	else
+		echo "I can't compile the test program--assuming errno EAGAIN will do."
+		eagain=EAGAIN
+	fi
+	set d_eofnblk
+	eval $setvar
+	;;
+*)
+	echo "Using $hint value $eagain."
+	echo "Your read() returns $rd_nodata when no data is present."
+	case "$d_eofnblk" in
+	"$define") echo "And you can see EOF because read() returns 0.";;
+	"$undef") echo "But you can't see EOF status from read() returned value.";;
+	*)
+		echo "(Assuming you can't see EOF status from read anyway.)"
+		d_eofnblk=$undef
+		;;
+	esac
+	;;
+esac
+$rm -f try try.* .out core head.c mtry
+
+: see if fchmod exists
+set fchmod d_fchmod
+eval $inlibc
+
+: see if fchown exists
+set fchown d_fchown
+eval $inlibc
+
+: see if this is an fcntl system
+set fcntl d_fcntl
+eval $inlibc
+
+: see if fgetpos exists
+set fgetpos d_fgetpos
+eval $inlibc
+
+: see if flock exists
+set flock d_flock
+eval $inlibc
+
+: see if fork exists
+set fork d_fork
+eval $inlibc
+
+: see if pathconf exists
+set pathconf d_pathconf
+eval $inlibc
+
+: see if fpathconf exists
+set fpathconf d_fpathconf
+eval $inlibc
+
+: see if fsetpos exists
+set fsetpos d_fsetpos
+eval $inlibc
+
+: see if gethostent exists
+set gethostent d_gethent
+eval $inlibc
+
+: see if getlogin exists
+set getlogin d_getlogin
+eval $inlibc
+
+: see if getpgrp exists
+set getpgrp d_getpgrp
+eval $inlibc
+
+: see if getpgrp2 exists
+set getpgrp2 d_getpgrp2
+eval $inlibc
+
+: see if getppid exists
+set getppid d_getppid
+eval $inlibc
+
+: see if getpriority exists
+set getpriority d_getprior
+eval $inlibc
+
+: see if this is a netinet/in.h or sys/in.h system
+set netinet/in.h i_niin sys/in.h i_sysin
+eval $inhdr
+
+: see if htonl --and friends-- exists
+val=''
+set htonl val
+eval $inlibc
+
+: Maybe they are macros.
+case "$val" in
+$undef)
+	$cat >htonl.c <<EOM
+#include <stdio.h>
+#include <sys/types.h>
+#$i_niin I_NETINET_IN
+#$i_sysin I_SYS_IN
+#ifdef I_NETINET_IN
+#include <netinet/in.h>
+#endif
+#ifdef I_SYS_IN
+#include <sys/in.h>
+#endif
+#ifdef htonl
+printf("Defined as a macro.");
+#endif
+EOM
+	$cppstdin $cppflags $cppminus < htonl.c >htonl.E 2>/dev/null
+	if $contains 'Defined as a macro' htonl.E >/dev/null 2>&1; then
+		val="$define"
+		echo "But it seems to be defined as a macro." >&4
+	fi
+	$rm -f htonl.?
+	;;
+esac
+set d_htonl
+eval $setvar
+
+: see which of string.h or strings.h is needed
+echo " "
+strings=`./findhdr string.h`
+if $test "$strings" && $test -r "$strings"; then
+	echo "Using <string.h> instead of <strings.h>." >&4
+	val="$define"
+else
+	val="$undef"
+	strings=`./findhdr strings.h`
+	if $test "$strings" && $test -r "$strings"; then
+		echo "Using <strings.h> instead of <string.h>." >&4
+	else
+		echo "No string header found -- You'll surely have problems." >&4
+	fi
+fi
+set i_string
+eval $setvar
+case "$i_string" in
+"$undef") strings=`./findhdr strings.h`;;
+*)	  strings=`./findhdr string.h`;;
+esac
+
+: index or strchr
+echo " "
+if set index val -f; eval $csym; $val; then
+	if set strchr val -f d_strchr; eval $csym; $val; then
+		if $contains strchr "$strings" >/dev/null 2>&1 ; then
+			val="$define"
+			vali="$undef"
+			echo "strchr() found." >&4
+		else
+			val="$undef"
+			vali="$define"
+			echo "index() found." >&4
+		fi
+	else
+		val="$undef"
+		vali="$define"
+		echo "index() found." >&4
+	fi
+else
+	if set strchr val -f d_strchr; eval $csym; $val; then
+		val="$define"
+		vali="$undef"
+		echo "strchr() found." >&4
+	else
+		echo "No index() or strchr() found!" >&4
+		val="$undef"
+		vali="$undef"
+	fi
+fi
+set d_strchr; eval $setvar
+val="$vali"
+set d_index; eval $setvar
+
+: Look for isascii
+echo " "
+$cat >isascii.c <<'EOCP'
+#include <stdio.h>
+#include <ctype.h>
+main() {
+	int c = 'A';
+	if (isascii(c))
+		exit(0);
+	else
+		exit(1);
+}
+EOCP
+if $cc $ccflags $ldflags -o isascii isascii.c $libs >/dev/null 2>&1 ; then
+	echo "isascii() found." >&4
+	val="$define"
+else
+	echo "isascii() NOT found." >&4
+	val="$undef"
+fi
+set d_isascii
+eval $setvar
+$rm -f isascii*
+
+: see if killpg exists
+set killpg d_killpg
+eval $inlibc
+
+: see if link exists
+set link d_link
+eval $inlibc
+
+: see if localeconv exists
+set localeconv d_locconv
+eval $inlibc
+
+: see if lockf exists
+set lockf d_lockf
+eval $inlibc
+
+: see if lstat exists
+set lstat d_lstat
+eval $inlibc
+
+: see if mblen exists
+set mblen d_mblen
+eval $inlibc
+
+: see if mbstowcs exists
+set mbstowcs d_mbstowcs
+eval $inlibc
+
+: see if mbtowc exists
+set mbtowc d_mbtowc
+eval $inlibc
+
+: see if memcmp exists
+set memcmp d_memcmp
+eval $inlibc
+
+: see if memcpy exists
+set memcpy d_memcpy
+eval $inlibc
+
+: see if memmove exists
+set memmove d_memmove
+eval $inlibc
+
+: see if memset exists
+set memset d_memset
+eval $inlibc
+
+: see if mkdir exists
+set mkdir d_mkdir
+eval $inlibc
+
+: see if mkfifo exists
+set mkfifo d_mkfifo
+eval $inlibc
+
+: see if mktime exists
+set mktime d_mktime
+eval $inlibc
+
+: see if msgctl exists
+set msgctl d_msgctl
+eval $inlibc
+
+: see if msgget exists
+set msgget d_msgget
+eval $inlibc
+
+: see if msgsnd exists
+set msgsnd d_msgsnd
+eval $inlibc
+
+: see if msgrcv exists
+set msgrcv d_msgrcv
+eval $inlibc
+
+: see how much of the 'msg*(2)' library is present.
+h_msg=true
+echo " "
+case "$d_msgctl$d_msgget$d_msgsnd$d_msgrcv" in
+*"$undef"*) h_msg=false;;
+esac
+: we could also check for sys/ipc.h ...
+if $h_msg && $test `./findhdr sys/msg.h`; then
+	echo "You have the full msg*(2) library." >&4
+	val="$define"
+else
+	echo "You don't have the full msg*(2) library." >&4
+	val="$undef"
+fi
+set d_msg
+eval $setvar
+
+: see if this is a malloc.h system
+set malloc.h i_malloc
+eval $inhdr
+
+: see if stdlib is available
+set stdlib.h i_stdlib
+eval $inhdr
+
+: determine which malloc to compile in
+echo " "
+case "$usemymalloc" in
+''|y*|true)	dflt='y' ;;
+n*|false)	dflt='n' ;;
+*)	dflt="$usemymalloc" ;;
+esac
+rp="Do you wish to attempt to use the malloc that comes with $package?"
+. ./myread
+usemymalloc="$ans"
+case "$ans" in
+y*|true)
+	usemymalloc='y'
+	mallocsrc='malloc.c'
+	mallocobj='malloc.o'
+	d_mymalloc="$define"
+	case "$libs" in
+	*-lmalloc*)
+		: Remove malloc from list of libraries to use
+		echo "Removing unneeded -lmalloc from library list" >&4
+		set `echo X $libs | $sed -e 's/-lmalloc / /' -e 's/-lmalloc$//'`
+		shift
+		libs="$*"
+		echo "libs = $libs" >&4
+		;;
+	esac
+	;;
+*)
+	usemymalloc='n'
+	mallocsrc=''
+	mallocobj=''
+	d_mymalloc="$undef"
+	;;
+esac
+
+: compute the return types of malloc and free
+echo " "
+$cat >malloc.c <<END
+#$i_malloc I_MALLOC
+#$i_stdlib I_STDLIB
+#include <stdio.h>
+#include <sys/types.h>
+#ifdef I_MALLOC
+#include <malloc.h>
+#endif
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#ifdef TRY_MALLOC
+void *malloc();
+#endif
+#ifdef TRY_FREE
+void free();
+#endif
+END
+case "$malloctype" in
+'')
+	if $cc $ccflags -c -DTRY_MALLOC malloc.c >/dev/null 2>&1; then
+		malloctype='void *'
+	else
+		malloctype='char *'
+	fi
+	;;
+esac
+echo "Your system wants malloc to return '$malloctype', it would seem." >&4
+
+case "$freetype" in
+'')
+	if $cc $ccflags -c -DTRY_FREE malloc.c >/dev/null 2>&1; then
+		freetype='void'
+	else
+		freetype='int'
+	fi
+	;;
+esac
+echo "Your system uses $freetype free(), it would seem." >&4
+$rm -f malloc.[co]
+: see if nice exists
+set nice d_nice
+eval $inlibc
+
+: see if pause exists
+set pause d_pause
+eval $inlibc
+
+: see if pipe exists
+set pipe d_pipe
+eval $inlibc
+
+: see if poll exists
+set poll d_poll
+eval $inlibc
+
+: see if this is a pwd.h system
+set pwd.h i_pwd
+eval $inhdr
+
+case "$i_pwd" in
+$define)
+	xxx=`./findhdr pwd.h`
+	$cppstdin $cppflags $cppminus < $xxx >$$.h
+
+	if $contains 'pw_quota' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwquota
+	eval $setvar
+
+	if $contains 'pw_age' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwage
+	eval $setvar
+
+	if $contains 'pw_change' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwchange
+	eval $setvar
+
+	if $contains 'pw_class' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwclass
+	eval $setvar
+
+	if $contains 'pw_expire' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwexpire
+	eval $setvar
+
+	if $contains 'pw_comment' $$.h >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	set d_pwcomment
+	eval $setvar
+
+	$rm -f $$.h
+	;;
+*)
+	val="$undef"; 
+	set d_pwquota; eval $setvar
+	set d_pwage; eval $setvar
+	set d_pwchange; eval $setvar
+	set d_pwclass; eval $setvar
+	set d_pwexpire; eval $setvar
+	set d_pwcomment; eval $setvar
+	;;
+esac
+
+: see if readdir and friends exist
+set readdir d_readdir
+eval $inlibc
+set seekdir d_seekdir
+eval $inlibc
+set telldir d_telldir
+eval $inlibc
+set rewinddir d_rewinddir
+eval $inlibc
+
+: see if readlink exists
+set readlink d_readlink
+eval $inlibc
+
+: see if rename exists
+set rename d_rename
+eval $inlibc
+
+: see if rmdir exists
+set rmdir d_rmdir
+eval $inlibc
+
+: can bcopy handle overlapping blocks?
+val="$undef"
+case "$d_bcopy" in
+"$define")
+	echo " "
+	echo "Checking to see if your bcopy() can do overlapping copies..." >&4
+	$cat >foo.c <<'EOCP'
+main()
+{
+char buf[128], abc[128];
+char *b;
+int len;
+int off;
+int align;
+
+bcopy("abcdefghijklmnopqrstuvwxyz0123456789", abc, 36);
+
+for (align = 7; align >= 0; align--) {
+	for (len = 36; len; len--) {
+		b = buf+align;
+		bcopy(abc, b, len);
+		for (off = 1; off <= len; off++) {
+			bcopy(b, b+off, len);
+			bcopy(b+off, b, len);
+			if (bcmp(b, abc, len))
+				exit(1);
+		}
+	}
+}
+exit(0);
+}
+EOCP
+	if $cc $ccflags $ldflags foo.c -o safebcpy $libs >/dev/null 2>&1; then
+		if ./safebcpy 2>/dev/null; then
+			echo "Yes, it can."
+			val="$define"
+		else
+			echo "It can't, sorry."
+		fi
+	else
+		echo "(I can't compile the test program, so we'll assume not...)"
+	fi
+	;;
+esac
+$rm -f foo.* safebcpy core
+set d_safebcpy
+eval $setvar
+
+: can memcpy handle overlapping blocks?
+val="$undef"
+case "$d_memcpy" in
+"$define")
+	echo " "
+	echo "Checking to see if your memcpy() can do overlapping copies..." >&4
+	$cat >foo.c <<'EOCP'
+main()
+{
+char buf[128], abc[128];
+char *b;
+int len;
+int off;
+int align;
+
+memcpy(abc, "abcdefghijklmnopqrstuvwxyz0123456789", 36);
+
+for (align = 7; align >= 0; align--) {
+	for (len = 36; len; len--) {
+		b = buf+align;
+		memcpy(b, abc, len);
+		for (off = 1; off <= len; off++) {
+			memcpy(b+off, b, len);
+			memcpy(b, b+off, len);
+			if (memcmp(b, abc, len))
+				exit(1);
+		}
+	}
+}
+exit(0);
+}
+EOCP
+	if $cc $ccflags $ldflags foo.c -o safemcpy $libs >/dev/null 2>&1; then
+		if ./safemcpy 2>/dev/null; then
+			echo "Yes, it can."
+			val="$define"
+		else
+			echo "It can't, sorry."
+		fi
+	else
+		echo "(I can't compile the test program, so we'll assume not...)"
+	fi
+	;;
+esac
+$rm -f foo.* safemcpy core
+set d_safemcpy
+eval $setvar
+
+: see if select exists
+set select d_select
+eval $inlibc
+
+: see if semctl exists
+set semctl d_semctl
+eval $inlibc
+
+: see if semget exists
+set semget d_semget
+eval $inlibc
+
+: see if semop exists
+set semop d_semop
+eval $inlibc
+
+: see how much of the 'sem*(2)' library is present.
+h_sem=true
+echo " "
+case "$d_semctl$d_semget$d_semop" in
+*"$undef"*) h_sem=false;;
+esac
+: we could also check for sys/ipc.h ...
+if $h_sem && $test `./findhdr sys/sem.h`; then
+	echo "You have the full sem*(2) library." >&4
+	val="$define"
+else
+	echo "You don't have the full sem*(2) library." >&4
+	val="$undef"
+fi
+set d_sem
+eval $setvar
+
+: see if setegid exists
+set setegid d_setegid
+eval $inlibc
+
+: see if seteuid exists
+set seteuid d_seteuid
+eval $inlibc
+
+: see if setlinebuf exists
+set setlinebuf d_setlinebuf
+eval $inlibc
+
+: see if setlocale exists
+set setlocale d_setlocale
+eval $inlibc
+
+: see if setpgid exists
+set setpgid d_setpgid
+eval $inlibc
+
+: see if setpgrp2 exists
+set setpgrp2 d_setpgrp2
+eval $inlibc
+
+: see if setpriority exists
+set setpriority d_setprior
+eval $inlibc
+
+: see if setregid exists
+set setregid d_setregid
+eval $inlibc
+set setresgid d_setresgid
+eval $inlibc
+
+: see if setreuid exists
+set setreuid d_setreuid
+eval $inlibc
+set setresuid d_setresuid
+eval $inlibc
+
+: see if setrgid exists
+set setrgid d_setrgid
+eval $inlibc
+
+: see if setruid exists
+set setruid d_setruid
+eval $inlibc
+
+: see if setsid exists
+set setsid d_setsid
+eval $inlibc
+
+: see if shmctl exists
+set shmctl d_shmctl
+eval $inlibc
+
+: see if shmget exists
+set shmget d_shmget
+eval $inlibc
+
+: see if shmat exists
+set shmat d_shmat
+eval $inlibc
+: see what shmat returns
+case "$d_shmat" in
+"$define")
+	$cat >shmat.c <<'END'
+#include <sys/shm.h>
+void *shmat();
+END
+	if $cc $ccflags -c shmat.c >/dev/null 2>&1; then
+		shmattype='void *'
+	else
+		shmattype='char *'
+	fi
+	echo "and it returns ($shmattype)." >&4
+	: see if a prototype for shmat is available
+	xxx=`./findhdr sys/shm.h`
+	$cppstdin $cppflags $cppminus < $xxx > shmat.c 2>/dev/null
+	if $contains 'shmat.*(' shmat.c >/dev/null 2>&1; then
+		val="$define"
+	else
+		val="$undef"
+	fi
+	$rm -f shmat.[co]
+	;;
+*)
+	val="$undef"
+	;;
+esac
+set d_shmatprototype
+eval $setvar
+
+: see if shmdt exists
+set shmdt d_shmdt
+eval $inlibc
+
+: see how much of the 'shm*(2)' library is present.
+h_shm=true
+echo " "
+case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in
+*"$undef"*) h_shm=false;;
+esac
+: we could also check for sys/ipc.h ...
+if $h_shm && $test `./findhdr sys/shm.h`; then
+	echo "You have the full shm*(2) library." >&4
+	val="$define"
+else
+	echo "You don't have the full shm*(2) library." >&4
+	val="$undef"
+fi
+set d_shm
+eval $setvar
+
+: see if sigvector exists -- since sigvec will match the substring
+echo " "
+if set sigvector val -f d_sigvectr; eval $csym; $val; then
+	echo 'sigvector() found--you must be running HP-UX.' >&4
+	val="$define"; set d_sigvectr; eval $setvar
+	val="$define"; set d_sigvec; eval $setvar
+else
+: try the original name
+	d_sigvectr="$undef"
+	if set sigvec val -f d_sigvec; eval $csym; $val; then
+		echo 'sigvec() found.' >&4
+		val="$define"; set d_sigvec; eval $setvar
+	else
+		echo 'sigvec() not found--race conditions with signals may occur.' >&4
+		val="$undef"; set d_sigvec; eval $setvar
+	fi
+fi
+
+: see if we have sigaction
+set sigaction d_sigaction
+eval $inlibc
+
+
+: see if sigsetjmp exists
+echo " "
+case "$d_sigsetjmp" in
+'')
+	$cat >set.c <<EOP
+#include <setjmp.h>
+sigjmp_buf env;
+int set = 1;
+main()
+{
+	if (sigsetjmp(env,1))
+		exit(set);
+	set = 0;
+	siglongjmp(env, 1);
+	exit(1);
+}
+EOP
+	if $cc $ccflags $ldflags set.c -o set $libs >/dev/null 2>&1; then
+		if ./set >/dev/null 2>&1; then
+			echo "POSIX sigsetjmp found." >&4
+			val="$define"
+		else
+			$cat <<EOM
+Uh-Oh! You have POSIX sigsetjmp and siglongjmp, but they do not work properly!!
+EOM
+			val="$undef"
+		fi
+	else
+		echo "Sigsetjmp not found." >&4
+		val="$undef"
+	fi
+	;;
+*) val="$d_sigsetjmp"
+	case "$d_sigsetjmp" in
+	$define) echo "POSIX sigsetjmp found." >&4;;
+	$undef) echo "Sigsetjmp not found." >&4;;
+	esac
+	;;
+esac
+set d_sigsetjmp
+eval $setvar
+$rm -f set.c set
+
+socketlib=''
+sockethdr=''
+: see whether socket exists
+echo " "
+$echo $n "Hmm... $c" >&4
+if set socket val -f d_socket; eval $csym; $val; then
+	echo "Looks like you have Berkeley networking support." >&4
+	d_socket="$define"
+	if set setsockopt val -f; eval $csym; $val; then
+		d_oldsock="$undef"
+	else
+		echo "...but it uses the old 4.1c interface, rather than 4.2" >&4
+		d_oldsock="$define"
+	fi
+else
+	if $contains socklib libc.list >/dev/null 2>&1; then
+		echo "Looks like you have Berkeley networking support." >&4
+		d_socket="$define"
+		: we will have to assume that it supports the 4.2 BSD interface
+		d_oldsock="$undef"
+	else
+		echo "You don't have Berkeley networking in libc.a..." >&4
+		if test -f /usr/lib/libnet.a; then
+			( (nm $nm_opt /usr/lib/libnet.a | eval $nm_extract) ||  \
+			ar t /usr/lib/libnet.a) 2>/dev/null >> libc.list
+			if $contains socket libc.list >/dev/null 2>&1; then
+			echo "...but the Wollongong group seems to have hacked it in." >&4
+				socketlib="-lnet"
+				sockethdr="-I/usr/netinclude"
+				d_socket="$define"
+				if $contains setsockopt libc.list >/dev/null 2>&1; then
+					d_oldsock="$undef"
+				else
+					echo "...using the old 4.1c interface, rather than 4.2" >&4
+					d_oldsock="$define"
+				fi
+			else
+				echo "or even in libnet.a, which is peculiar." >&4
+				d_socket="$undef"
+				d_oldsock="$undef"
+			fi
+		else
+			echo "or anywhere else I see." >&4
+			d_socket="$undef"
+			d_oldsock="$undef"
+		fi
+	fi
+fi
+
+: see if socketpair exists
+set socketpair d_sockpair
+eval $inlibc
+
+: see if stat knows about block sizes
+echo " "
+xxx=`./findhdr sys/stat.h`
+if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then
+	if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then
+		echo "Your stat() knows about block sizes." >&4
+		val="$define"
+	else
+		echo "Your stat() doesn't know about block sizes." >&4
+		val="$undef"
+	fi
+else
+	echo "Your stat() doesn't know about block sizes." >&4
+	val="$undef"
+fi
+set d_statblks
+eval $setvar
+
+: see if _ptr and _cnt from stdio act std
+echo " "
+if $contains '_IO_fpos_t' `./findhdr stdio.h` >/dev/null 2>&1 ; then
+	echo "(Looks like you have stdio.h from Linux.)"
+	case "$stdio_ptr" in
+	'') stdio_ptr='((fp)->_IO_read_ptr)'
+		ptr_lval=$define
+		;;
+	*)	ptr_lval=$d_stdio_ptr_lval;;
+	esac
+	case "$stdio_cnt" in
+	'') stdio_cnt='((fp)->_IO_read_end - (fp)->_IO_read_ptr)'
+		cnt_lval=$undef
+		;;
+	*)	cnt_lval=$d_stdio_cnt_lval;;
+	esac
+	case "$stdio_base" in
+	'') stdio_base='((fp)->_IO_read_base)';;
+	esac
+	case "$stdio_bufsiz" in
+	'') stdio_bufsiz='((fp)->_IO_read_end - (fp)->_IO_read_base)';;
+	esac
+else
+	case "$stdio_ptr" in
+	'') stdio_ptr='((fp)->_ptr)'
+		ptr_lval=$define
+		;;
+	*)	ptr_lval=$d_stdio_ptr_lval;;
+	esac
+	case "$stdio_cnt" in
+	'') stdio_cnt='((fp)->_cnt)'
+		cnt_lval=$define
+		;;
+	*)	cnt_lval=$d_stdio_cnt_lval;;
+	esac
+	case "$stdio_base" in
+	'') stdio_base='((fp)->_base)';;
+	esac
+	case "$stdio_bufsiz" in
+	'') stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)';;
+	esac
+fi
+: test whether _ptr and _cnt really work
+echo "Checking how std your stdio is..." >&4
+$cat >try.c <<EOP
+#include <stdio.h>
+#define FILE_ptr(fp)	$stdio_ptr
+#define FILE_cnt(fp)	$stdio_cnt
+main() { 
+	FILE *fp = fopen("try.c", "r");
+	char c = getc(fp);
+	if (
+		18 <= FILE_cnt(fp) &&
+		strncmp(FILE_ptr(fp), "include <stdio.h>\n", 18) == 0
+	)
+		exit(0);
+	exit(1);
+}
+EOP
+val="$undef"
+if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1; then
+	if ./try; then
+		echo "Your stdio acts pretty std."
+		val="$define"
+	else
+		echo "Your stdio isn't very std."
+	fi
+else
+	echo "Your stdio doesn't appear very std."
+fi
+$rm -f try.c try
+set d_stdstdio
+eval $setvar
+
+: Can _ptr be used as an lvalue?
+case "$d_stdstdio$ptr_lval" in
+$define$define) val=$define ;;
+*) val=$undef ;;
+esac
+set d_stdio_ptr_lval
+eval $setvar
+
+: Can _cnt be used as an lvalue?
+case "$d_stdstdio$cnt_lval" in
+$define$define) val=$define ;;
+*) val=$undef ;;
+esac
+set d_stdio_cnt_lval
+eval $setvar
+
+: see if _base is also standard
+val="$undef"
+case "$d_stdstdio" in
+$define)
+	$cat >try.c <<EOP
+#include <stdio.h>
+#define FILE_base(fp)	$stdio_base
+#define FILE_bufsiz(fp)	$stdio_bufsiz
+main() { 
+	FILE *fp = fopen("try.c", "r");
+	char c = getc(fp);
+	if (
+		19 <= FILE_bufsiz(fp) &&
+		strncmp(FILE_base(fp), "#include <stdio.h>\n", 19) == 0
+	)
+		exit(0);
+	exit(1);
+}
+EOP
+	if $cc $ccflags $ldflags -o try try.c $libs > /dev/null 2>&1; then
+		if ./try; then
+			echo "Even its _base field acts std."
+			val="$define"
+		else
+			echo "But its _base field isn't std."
+		fi
+	else
+		echo "However, it seems to be lacking the _base field."
+	fi
+	$rm -f try.c try
+	;;
+esac
+set d_stdiobase
+eval $setvar
+
+: see if strcoll exists
+set strcoll d_strcoll
+eval $inlibc
+
+: check for structure copying
+echo " "
+echo "Checking to see if your C compiler can copy structs..." >&4
+$cat >try.c <<'EOCP'
+main()
+{
+	struct blurfl {
+		int dyick;
+	} foo, bar;
+
+	foo = bar;
+}
+EOCP
+if $cc -c try.c >/dev/null 2>&1 ; then
+	val="$define"
+	echo "Yup, it can."
+else
+	val="$undef"
+	echo "Nope, it can't."
+fi
+set d_strctcpy
+eval $setvar
+$rm -f try.*
+
+: see if strerror and/or sys_errlist[] exist
+echo " "
+if set strerror val -f d_strerror; eval $csym; $val; then
+	echo 'strerror() found.' >&4
+	d_strerror="$define"
+	d_strerrm='strerror(e)'
+	if set sys_errlist val -a d_syserrlst; eval $csym; $val; then	
+		echo "(You also have sys_errlist[], so we could roll our own strerror.)" 
+		d_syserrlst="$define"
+	else
+	echo "(Since you don't have sys_errlist[], sterror() is welcome.)"
+		d_syserrlst="$undef"
+	fi
+elif xxx=`./findhdr string.h`; test "$xxx" || xxx=`./findhdr strings.h`; \
+	$contains '#[ 	]*define.*strerror' "$xxx" >/dev/null 2>&1; then
+	echo 'strerror() found in string header.' >&4
+	d_strerror="$define"
+	d_strerrm='strerror(e)'
+	if set sys_errlist val -a d_syserrlst; eval $csym; $val; then	
+		echo "(Most probably, strerror() uses sys_errlist[] for descriptions.)"
+		d_syserrlst="$define"
+	else
+		echo "(You don't appear to have any sys_errlist[], how can this be?)"
+		d_syserrlst="$undef"
+	fi
+elif set sys_errlist val -a d_syserrlst; eval $csym; $val; then
+echo "strerror() not found, but you have sys_errlist[] so we'll use that." >&4
+	d_strerror="$undef"
+	d_syserrlst="$define"
+	d_strerrm='((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e])'
+else
+	echo 'strerror() and sys_errlist[] NOT found.' >&4
+	d_strerror="$undef"
+	d_syserrlst="$undef"
+	d_strerrm='"unknown"'
+fi
+
+: see if strxfrm exists
+set strxfrm d_strxfrm
+eval $inlibc
+
+: see if symlink exists
+set symlink d_symlink
+eval $inlibc
+
+: see if syscall exists
+set syscall d_syscall
+eval $inlibc
+
+: see if sysconf exists
+set sysconf d_sysconf
+eval $inlibc
+
+: see if system exists
+set system d_system
+eval $inlibc
+
+: see if tcgetpgrp exists
+set tcgetpgrp d_tcgetpgrp
+eval $inlibc
+
+: see if tcsetpgrp exists
+set tcsetpgrp d_tcsetpgrp
+eval $inlibc
+
+: define an is-a-typedef? function
+typedef='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@;
+case "$inclist" in
+"") inclist="sys/types.h";;
+esac;
+eval "varval=\$$var";
+case "$varval" in
+"")
+	$rm -f temp.c;
+	for inc in $inclist; do
+		echo "#include <$inc>" >>temp.c;
+	done;
+	$cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null;
+	if $contains $type temp.E >/dev/null 2>&1; then
+		eval "$var=\$type";
+	else
+		eval "$var=\$def";
+	fi;
+	$rm -f temp.?;;
+*) eval "$var=\$varval";;
+esac'
+
+: see if this is a sys/times.h system
+set sys/times.h i_systimes
+eval $inhdr
+
+: see if times exists
+echo " "
+if set times val -f d_times; eval $csym; $val; then
+	echo 'times() found.' >&4
+	d_times="$define"
+	inc=''
+	case "$i_systimes" in
+	"$define") inc='sys/times.h';;
+	esac
+	set clock_t clocktype long stdio.h sys/types.h $inc
+	eval $typedef
+	dflt="$clocktype"
+	echo " "
+	rp="What type is returned by times() on this system?"
+	. ./myread
+	clocktype="$ans"
+else
+	echo 'times() NOT found, hope that will do.' >&4
+	d_times="$undef"
+	clocktype='int'
+fi
+
+: see if truncate exists
+set truncate d_truncate
+eval $inlibc
+
+: see if tzname[] exists
+echo " "
+if set tzname val -a d_tzname; eval $csym; $val; then
+	val="$define"
+	echo 'tzname[] found.' >&4
+else
+	val="$undef"
+	echo 'tzname[] NOT found.' >&4
+fi
+set d_tzname
+eval $setvar
+
+: see if umask exists
+set umask d_umask
+eval $inlibc
+
+: see how we will look up host name
+echo " "
+if false; then
+	: dummy stub to allow use of elif
+elif set uname val -f d_uname; eval $csym; $val; then
+	if ./xenix; then
+		$cat <<'EOM'
+uname() was found, but you're running xenix, and older versions of xenix
+have a broken uname(). If you don't really know whether your xenix is old
+enough to have a broken system call, use the default answer.
+
+EOM
+		dflt=y
+		case "$d_uname" in
+		"$define") dflt=n;;
+		esac
+		rp='Is your uname() broken?'
+		. ./myread
+		case "$ans" in
+		n*) d_uname="$define"; call=uname;;
+		esac
+	else
+		echo 'uname() found.' >&4
+		d_uname="$define"
+		call=uname
+	fi
+fi
+case "$d_gethname" in
+'') d_gethname="$undef";;
+esac
+case "$d_uname" in
+'') d_uname="$undef";;
+esac
+case "$d_phostname" in
+'') d_phostname="$undef";;
+esac
+
+: backward compatibility for d_hvfork
+if test X$d_hvfork != X; then
+	d_vfork="$d_hvfork"
+	d_hvfork=''
+fi
+: see if there is a vfork
+val=''
+set vfork val
+eval $inlibc
+
+: Ok, but do we want to use it. vfork is reportedly unreliable in 
+: perl on Solaris 2.x, and probably elsewhere.
+case "$val" in
+$define)
+	echo " "
+	case "$usevfork" in
+	false) dflt='n';;
+	*) dflt='y';;
+	esac
+	rp="Some systems have problems with vfork().  Do you want to use it?"
+	. ./myread
+	case "$ans" in
+	y|Y) ;;
+	*)
+		echo "Ok, we won't use vfork()."
+		val="$undef"
+		;;
+	esac
+	;;
+esac
+set d_vfork
+eval $setvar
+case "$d_vfork" in
+$define) usevfork='true';;
+*) usevfork='false';;
+esac
+
+: see if this is an sysdir system
+set sys/dir.h i_sysdir
+eval $inhdr
+
+: see if this is an sysndir system
+set sys/ndir.h i_sysndir
+eval $inhdr
+
+: see if closedir exists
+set closedir d_closedir
+eval $inlibc
+
+case "$d_closedir" in
+"$define")
+	echo " "
+	echo "Checking whether closedir() returns a status..." >&4
+	cat > closedir.c <<EOM
+#$i_dirent I_DIRENT		/**/
+#$i_sysdir I_SYS_DIR		/**/
+#$i_sysndir I_SYS_NDIR		/**/
+
+#if defined(I_DIRENT)
+#include <dirent.h>
+#if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
+#include <sys/dir.h>
+#endif
+#else
+#ifdef I_SYS_NDIR
+#include <sys/ndir.h>
+#else
+#ifdef I_SYS_DIR
+#ifdef hp9000s500
+#include <ndir.h>	/* may be wrong in the future */
+#else
+#include <sys/dir.h>
+#endif
+#endif
+#endif
+#endif 
+int main() { return closedir(opendir(".")); }
+EOM
+	if $cc $ccflags $ldflags -o closedir closedir.c $libs > /dev/null 2>&1; then
+		if ./closedir > /dev/null 2>&1 ; then
+			echo "Yes, it does."
+			val="$undef"
+		else
+			echo "No, it doesn't."
+			val="$define"
+		fi
+	else
+		echo "(I can't seem to compile the test program--assuming it doesn't)"
+		val="$define"
+	fi
+	;;
+*)
+	val="$undef";
+	;;
+esac
+set d_void_closedir
+eval $setvar
+$rm -f closedir*
+: check for volatile keyword
+echo " "
+echo 'Checking to see if your C compiler knows about "volatile"...' >&4
+$cat >try.c <<'EOCP'
+main()
+{
+	typedef struct _goo_struct goo_struct;
+	goo_struct * volatile goo = ((goo_struct *)0);
+	struct _goo_struct {
+		long long_int;
+		int reg_int;
+		char char_var;
+	};
+	typedef unsigned short foo_t;
+	char *volatile foo;
+	volatile int bar;
+	volatile foo_t blech;
+	foo = foo;
+}
+EOCP
+if $cc -c $ccflags try.c >/dev/null 2>&1 ; then
+	val="$define"
+	echo "Yup, it does."
+else
+	val="$undef"
+	echo "Nope, it doesn't."
+fi
+set d_volatile
+eval $setvar
+$rm -f try.*
+
+: see if there is a wait4
+set wait4 d_wait4
+eval $inlibc
+
+: see if waitpid exists
+set waitpid d_waitpid
+eval $inlibc
+
+: see if wcstombs exists
+set wcstombs d_wcstombs
+eval $inlibc
+
+: see if wctomb exists
+set wctomb d_wctomb
+eval $inlibc
+
+: preserve RCS keywords in files with variable substitution, grrr
+Date='$Date'
+Id='$Id'
+Log='$Log'
+RCSfile='$RCSfile'
+Revision='$Revision'
+
+: check for alignment requirements
+echo " "
+case "$alignbytes" in
+'') echo "Checking alignment constraints..." >&4
+	$cat >try.c <<'EOCP'
+struct foobar {
+	char foo;
+	double bar;
+} try;
+main()
+{
+	printf("%d\n", (char *)&try.bar - (char *)&try.foo);
+}
+EOCP
+	if $cc $ccflags try.c -o try >/dev/null 2>&1; then
+		dflt=`./try`
+	else
+		dflt='8'
+		echo"(I can't seem to compile the test program...)"
+	fi
+	;;
+*) dflt="$alignbytes"
+	;;
+esac
+rp="Doubles must be aligned on a how-many-byte boundary?"
+. ./myread
+alignbytes="$ans"
+$rm -f try.c try
+
+: Define several unixisms. Hints files or command line options
+: can be used to override them.
+case "$ar" in
+'') ar='ar';;
+esac
+case "$lib_ext" in
+'') lib_ext='.a';;
+esac
+case "$obj_ext" in
+'') obj_ext='.o';;
+esac
+case "$path_sep" in
+'') path_sep=':';;
+esac
+: Which makefile gets called first.  This is used by make depend.
+case "$firstmakefile" in
+'') firstmakefile='makefile';;
+esac
+
+: check for ordering of bytes in a long
+case "$byteorder" in
+'')
+	$cat <<'EOM'
+  
+In the following, larger digits indicate more significance.  A big-endian
+machine like a Pyramid or a Motorola 680?0 chip will come out to 4321. A
+little-endian machine like a Vax or an Intel 80?86 chip would be 1234. Other
+machines may have weird orders like 3412.  A Cray will report 87654321. If
+the test program works the default is probably right.
+I'm now running the test program...
+EOM
+	$cat >try.c <<'EOCP'
+#include <stdio.h>
+main()
+{
+	int i;
+	union {
+		unsigned long l;
+		char c[sizeof(long)];
+	} u;
+
+	if (sizeof(long) > 4)
+		u.l = (0x08070605L << 32) | 0x04030201L;
+	else
+		u.l = 0x04030201L;
+	for (i = 0; i < sizeof(long); i++)
+		printf("%c", u.c[i]+'0');
+	printf("\n");
+	exit(0);
+}
+EOCP
+	xxx_prompt=y
+	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+		dflt=`./try`
+		case "$dflt" in
+		[1-4][1-4][1-4][1-4]|12345678|87654321)
+			echo "(The test program ran ok.)"
+			echo "byteorder=$dflt"
+			xxx_prompt=n
+			;;
+		????|????????) echo "(The test program ran ok.)" ;;
+		*) echo "(The test program didn't run right for some reason.)" ;;
+		esac
+	else
+		dflt='4321'
+		cat <<'EOM'
+(I can't seem to compile the test program.  Guessing big-endian...)
+EOM
+	fi
+	case "$xxx_prompt" in
+	y)
+		rp="What is the order of bytes in a long?"
+		. ./myread
+		byteorder="$ans"
+		;;
+	*)	byteorder=$dflt
+		;;
+	esac
+	;;
+esac
+$rm -f try.c try
+
+: how do we catenate cpp tokens here?
+echo " "
+echo "Checking to see how your cpp does stuff like catenate tokens..." >&4
+$cat >cpp_stuff.c <<'EOCP'
+#define RCAT(a,b)a/**/b
+#define ACAT(a,b)a ## b
+RCAT(Rei,ser)
+ACAT(Cir,cus)
+EOCP
+$cppstdin $cppflags $cppminus <cpp_stuff.c >cpp_stuff.out 2>&1
+if $contains 'Circus' cpp_stuff.out >/dev/null 2>&1; then
+	echo "Oh!  Smells like ANSI's been here."
+	echo "We can catify or stringify, separately or together!"
+	cpp_stuff=42
+elif $contains 'Reiser' cpp_stuff.out >/dev/null 2>&1; then
+	echo "Ah, yes!  The good old days!"
+	echo "However, in the good old days we don't know how to stringify and"
+	echo "catify at the same time."
+	cpp_stuff=1
+else
+	$cat >&4 <<EOM
+Hmm, I don't seem to be able to catenate tokens with your cpp.  You're going
+to have to edit the values of CAT[2-5] in config.h...
+EOM
+	cpp_stuff="/* Help! How do we handle cpp_stuff? */*/"
+fi
+$rm -f cpp_stuff.*
+
+: see if this is a db.h system
+set db.h i_db
+eval $inhdr
+
+case "$i_db" in
+define)
+	: Check the return type needed for hash 
+	echo " "
+	echo "Checking return type needed for hash for Berkeley DB ..." >&4
+	$cat >try.c <<EOCP
+#$d_const HASCONST
+#ifndef HASCONST
+#define const
+#endif
+#include <sys/types.h>
+#include <db.h>
+u_int32_t hash_cb (ptr, size)
+const void *ptr;
+size_t size;
+{
+}
+HASHINFO info;
+main()
+{
+	info.hash = hash_cb;
+}
+EOCP
+	if $cc $ccflags -c try.c >try.out 2>&1 ; then
+		if $contains warning try.out >>/dev/null 2>&1 ; then
+			db_hashtype='int'
+		else
+			db_hashtype='u_int32_t'
+		fi
+	else
+		echo "I can't seem to compile the test program." >&4
+		db_hashtype=int
+	fi
+	$rm -f try.*
+	echo "Your version of Berkeley DB uses $db_hashtype for hash."
+	;;
+*)	db_hashtype=int
+	;;
+esac
+
+case "$i_db" in
+define)
+	: Check the return type needed for prefix 
+	echo " "
+	echo "Checking return type needed for prefix for Berkeley DB ..." >&4
+	cat >try.c <<EOCP
+#$d_const HASCONST
+#ifndef HASCONST
+#define const
+#endif
+#include <sys/types.h>
+#include <db.h>
+size_t prefix_cb (key1, key2)
+const DBT *key1;
+const DBT *key2;
+{
+}
+BTREEINFO info;
+main()
+{
+	info.prefix = prefix_cb;
+}
+EOCP
+	if $cc $ccflags -c try.c  >try.out 2>&1 ; then
+		if $contains warning try.out >>/dev/null 2>&1 ; then
+			db_prefixtype='int'
+		else
+			db_prefixtype='size_t'
+		fi
+	else
+		echo "I can't seem to compile the test program." >&4
+		db_prefixtype='int'
+	fi
+	$rm -f try.*
+	echo "Your version of Berkeley DB uses $db_prefixtype for prefix."
+	;;
+*)	db_prefixtype='int'
+	;;
+esac
+
+: check for void type
+echo " "
+echo "Checking to see how well your C compiler groks the void type..." >&4
+echo " "
+$cat >&4 <<EOM
+  Support flag bits are:
+    1: basic void declarations.
+    2: arrays of pointers to functions returning void.
+    4: operations between pointers to and addresses of void functions.
+    8: generic void pointers.
+EOM
+echo " "
+case "$voidflags" in
+'')
+	$cat >try.c <<'EOCP'
+#if TRY & 1
+void main() {
+#else
+main() {
+#endif
+	extern void moo();	/* function returning void */
+	void (*goo)();		/* ptr to func returning void */
+#if TRY & 8
+	void *hue;		/* generic ptr */
+#endif
+#if TRY & 2
+	void (*foo[10])();
+#endif
+
+#if TRY & 4
+	if(goo == moo) {
+		exit(0);
+	}
+#endif
+	exit(0);
+}
+EOCP
+	if $cc -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
+		voidflags=$defvoidused
+	echo "It appears to support void to the level $package wants ($defvoidused)."
+		if $contains warning .out >/dev/null 2>&1; then
+			echo "However, you might get some warnings that look like this:"
+			$cat .out
+		fi
+	else
+echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4
+		if $cc -c -DTRY=1 try.c >/dev/null 2>&1 ; then
+			echo "It supports 1..."
+			if $cc -c -DTRY=3 try.c >/dev/null 2>&1 ; then
+				echo "It also supports 2..."
+				if $cc -c -DTRY=7 try.c >/dev/null 2>&1 ; then
+					voidflags=7
+					echo "And it supports 4 but not 8 definitely."
+				else
+					echo "It doesn't support 4..."
+					if $cc -c -DTRY=11 try.c >/dev/null 2>&1 ; then
+						voidflags=11
+						echo "But it supports 8."
+					else
+						voidflags=3
+						echo "Neither does it support 8."
+					fi
+				fi
+			else
+				echo "It does not support 2..."
+				if $cc -c -DTRY=13 try.c >/dev/null 2>&1 ; then
+					voidflags=13
+					echo "But it supports 4 and 8."
+				else
+					if $cc -c -DTRY=5 try.c >/dev/null 2>&1 ; then
+						voidflags=5
+						echo "And it supports 4 but has not heard about 8."
+					else
+						echo "However it supports 8 but not 4."
+					fi
+				fi
+			fi
+		else
+			echo "There is no support at all for void."
+			voidflags=0
+		fi
+	fi
+esac
+: Only prompt user if support does not match the level we want
+case "$voidflags" in
+"$defvoidused") ;;
+*)
+	dflt="$voidflags";
+	rp="Your void support flags add up to what?"
+	. ./myread
+	voidflags="$ans"
+	;;
+esac
+$rm -f try.* .out
+
+: see what type file positions are declared as in the library
+set fpos_t fpostype long stdio.h sys/types.h
+eval $typedef
+echo " "
+dflt="$fpostype"
+rp="What is the type for file position used by fsetpos()?"
+. ./myread
+fpostype="$ans"
+
+: Store the full pathname to the sed program for use in the C program
+full_sed=$sed
+
+: see what type gids are declared as in the kernel
+set gid_t gidtype xxx stdio.h sys/types.h
+eval $typedef
+case "$gidtype" in
+xxx)
+	xxx=`./findhdr sys/user.h`
+	set `grep 'groups\[NGROUPS\];' "$xxx" 2>/dev/null` unsigned short
+	case $1 in
+	unsigned) dflt="$1 $2" ;;
+	*) dflt="$1" ;;
+	esac
+	;;
+*) dflt="$gidtype";;
+esac
+echo " "
+rp="What is the type for group ids returned by getgid()?"
+. ./myread
+gidtype="$ans"
+
+: see if getgroups exists
+set getgroups d_getgrps
+eval $inlibc
+
+: Find type of 2nd arg to getgroups
+echo " "
+case "$d_getgrps" in
+'define')
+	case "$groupstype" in
+	'') dflt="$gidtype" ;;
+	*)  dflt="$groupstype" ;;
+	esac
+	$cat <<EOM
+What is the type of the second argument to getgroups()?  Usually this
+is the same as group ids, $gidtype, but not always.
+
+EOM
+	rp='What type is the second argument to getgroups()?'
+	. ./myread
+	groupstype="$ans"
+	;;
+*)  groupstype="$gidtype";;
+esac
+
+: see what type lseek is declared as in the kernel
+set off_t lseektype long stdio.h sys/types.h
+eval $typedef
+echo " "
+dflt="$lseektype"
+rp="What type is lseek's offset on this system declared as?"
+. ./myread
+lseektype="$ans"
+
+: see what type is used for mode_t
+set mode_t modetype int stdio.h sys/types.h
+eval $typedef
+dflt="$modetype"
+echo " "
+rp="What type is used for file modes?"
+. ./myread
+modetype="$ans"
+
+: locate the preferred pager for this system
+case "$pager" in
+'')
+	dflt=''
+	case "$pg" in
+	/*) dflt=$pg;;
+	esac
+	case "$more" in
+	/*) dflt=$more;;
+	esac
+	case "$less" in
+	/*) dflt=$less;;
+	esac
+	case "$dflt" in
+	'') dflt=/usr/ucb/more;;
+	esac
+	;;
+*) dflt="$pager";;
+esac
+echo " "
+fn=f/
+rp='What pager is used on your system?'
+. ./getfile
+pager="$ans"
+
+: Cruising for prototypes
+echo " "
+echo "Checking out function prototypes..." >&4
+$cat >prototype.c <<'EOCP'
+main(int argc, char *argv[]) {
+	exit(0);}
+EOCP
+if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then
+	echo "Your C compiler appears to support function prototypes."
+	val="$define"
+else
+	echo "Your C compiler doesn't seem to understand function prototypes."
+	val="$undef"
+fi
+set prototype
+eval $setvar
+$rm -f prototype*
+
+: check for size of random number generator
+echo " "
+case "$randbits" in
+'')
+	echo "Checking to see how many bits your rand function produces..." >&4
+	$cat >try.c <<'EOCP'
+#include <stdio.h>
+main()
+{
+	register int i;
+	register unsigned long tmp;
+	register unsigned long max = 0L;
+
+	for (i = 1000; i; i--) {
+		tmp = (unsigned long)rand();
+		if (tmp > max) max = tmp;
+	}
+	for (i = 0; max; i++)
+		max /= 2;
+	printf("%d\n",i);
+}
+EOCP
+	if $cc try.c -o try >/dev/null 2>&1 ; then
+		dflt=`try`
+	else
+		dflt='?'
+		echo "(I can't seem to compile the test program...)"
+	fi
+	;;
+*)
+	dflt="$randbits"
+	;;
+esac
+rp='How many bits does your rand() function produce?'
+. ./myread
+randbits="$ans"
+$rm -f try.c try
+
+: see if ar generates random libraries by itself
+echo " "
+echo "Checking how to generate random libraries on your machine..." >&4
+echo 'int bar1() { return bar2(); }' > bar1.c
+echo 'int bar2() { return 2; }' > bar2.c
+$cat > foo.c <<'EOP'
+main() { printf("%d\n", bar1()); exit(0); }
+EOP
+$cc $ccflags -c bar1.c >/dev/null 2>&1
+$cc $ccflags -c bar2.c >/dev/null 2>&1
+$cc $ccflags -c foo.c >/dev/null 2>&1
+ar rc bar.a bar2.o bar1.o >/dev/null 2>&1
+if $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+	./foobar >/dev/null 2>&1; then
+	echo "ar appears to generate random libraries itself."
+	orderlib=false
+	ranlib=":"
+elif ar ts bar.a >/dev/null 2>&1 &&
+	$cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+	./foobar >/dev/null 2>&1; then
+		echo "a table of contents needs to be added with 'ar ts'."
+		orderlib=false
+		ranlib="ar ts"
+else
+	case "$ranlib" in
+	:) ranlib='';;
+	'')
+		ranlib=`./loc ranlib X /usr/bin /bin /usr/local/bin`
+		$test -f $ranlib || ranlib=''
+		;;
+	esac
+	if $test -n "$ranlib"; then
+		echo "your system has '$ranlib'; we'll use that."
+		orderlib=false
+	else
+		echo "your system doesn't seem to support random libraries"
+		echo "so we'll use lorder and tsort to order the libraries."
+		orderlib=true
+		ranlib=":"
+	fi
+fi
+$rm -f foo* bar* 
+
+: see if sys/select.h has to be included
+set sys/select.h i_sysselct
+eval $inhdr
+
+: see if we should include time.h, sys/time.h, or both
+echo " "
+echo "Testing to see if we should include <time.h>, <sys/time.h> or both." >&4
+$echo $n "I'm now running the test program...$c"
+$cat >try.c <<'EOCP'
+#include <sys/types.h>
+#ifdef I_TIME
+#include <time.h>
+#endif
+#ifdef I_SYSTIME
+#ifdef SYSTIMEKERNEL
+#define KERNEL
+#endif
+#include <sys/time.h>
+#endif
+#ifdef I_SYSSELECT
+#include <sys/select.h>
+#endif
+main()
+{
+	struct tm foo;
+#ifdef S_TIMEVAL
+	struct timeval bar;
+#endif
+#ifdef S_TIMEZONE
+	struct timezone tzp;
+#endif
+	if (foo.tm_sec == foo.tm_sec)
+		exit(0);
+#ifdef S_TIMEVAL
+	if (bar.tv_sec == bar.tv_sec)
+		exit(0);
+#endif
+	exit(1);
+}
+EOCP
+flags=''
+for s_timezone in '-DS_TIMEZONE' ''; do
+sysselect=''
+for s_timeval in '-DS_TIMEVAL' ''; do
+for i_systimek in '' '-DSYSTIMEKERNEL'; do
+for i_time in '' '-DI_TIME'; do
+for i_systime in '-DI_SYSTIME' ''; do
+	case "$flags" in
+	'') $echo $n ".$c"
+		if $cc $ccflags \
+		$i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
+		try.c -o try >/dev/null 2>&1 ; then
+			set X $i_time $i_systime $i_systimek $sysselect $s_timeval
+			shift
+			flags="$*"
+			echo " "
+			$echo $n "Succeeded with $flags$c"
+		fi
+		;;
+	esac
+done
+done
+done
+done
+done
+timeincl=''
+echo " "
+case "$flags" in
+*SYSTIMEKERNEL*) i_systimek="$define"
+	timeincl=`./findhdr sys/time.h`
+	echo "We'll include <sys/time.h> with KERNEL defined." >&4;;
+*) i_systimek="$undef";;
+esac
+case "$flags" in
+*I_TIME*) i_time="$define"
+	timeincl=`./findhdr time.h`" $timeincl"
+	echo "We'll include <time.h>." >&4;;
+*) i_time="$undef";;
+esac
+case "$flags" in
+*I_SYSTIME*) i_systime="$define"
+	timeincl=`./findhdr sys/time.h`" $timeincl"
+	echo "We'll include <sys/time.h>." >&4;;
+*) i_systime="$undef";;
+esac
+$rm -f try.c try
+
+: check for fd_set items
+$cat <<EOM
+
+Checking to see how well your C compiler handles fd_set and friends ...
+EOM
+$cat >fd_set.c <<EOCP
+#$i_systime I_SYS_TIME
+#$i_sysselct I_SYS_SELECT
+#$d_socket HAS_SOCKET
+#include <sys/types.h>
+#ifdef HAS_SOCKET
+#include <sys/socket.h> /* Might include <sys/bsdtypes.h> */
+#endif
+#ifdef I_SYS_TIME
+#include <sys/time.h>
+#else
+#ifdef I_SYS_SELECT
+#include <sys/select.h>
+#endif
+#endif
+main() {
+	fd_set fds;
+
+#ifdef TRYBITS
+	if(fds.fds_bits);
+#endif
+
+#if defined(FD_SET) && defined(FD_CLR) && defined(FD_ISSET) && defined(FD_ZERO)
+	exit(0);
+#else
+	exit(1);
+#endif
+}
+EOCP
+if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+	d_fds_bits="$define"
+	d_fd_set="$define"
+	echo "Well, your system knows about the normal fd_set typedef..." >&4
+	if ./fd_set; then
+		echo "and you have the normal fd_set macros (just as I'd expect)." >&4
+		d_fd_macros="$define"
+	else
+		$cat >&4 <<'EOM'
+but not the normal fd_set macros!  Gaaack!  I'll have to cover for you.
+EOM
+		d_fd_macros="$undef"
+	fi
+else
+	$cat <<'EOM'
+Hmm, your compiler has some difficulty with fd_set.  Checking further...
+EOM
+	if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+		d_fds_bits="$undef"
+		d_fd_set="$define"
+		echo "Well, your system has some sort of fd_set available..." >&4
+		if ./fd_set; then
+			echo "and you have the normal fd_set macros." >&4
+			d_fd_macros="$define"
+		else
+			$cat <<'EOM'
+but not the normal fd_set macros!  Gross!  More work for me...
+EOM
+			d_fd_macros="$undef"
+		fi
+	else
+	echo "Well, you got zip.  That's OK, I can roll my own fd_set stuff." >&4
+		d_fd_set="$undef"
+		d_fds_bits="$undef"
+		d_fd_macros="$undef"
+	fi
+fi
+$rm -f fd_set*
+
+
+: check for type of arguments to select.  This will only really
+: work if the system supports prototypes and provides one for
+: select.
+case "$d_select" in
+$define)
+	: Make initial guess
+	case "$selecttype" in
+	''|' ')
+		case "$d_fd_set" in
+		$define) xxx='fd_set *' ;;
+		*) xxx='int *' ;;
+		esac
+		;;
+	*) 	xxx="$selecttype" 
+		;;
+	esac
+	: backup guess
+	case "$xxx" in
+	'fd_set *') yyy='int *' ;;
+	'int *') yyy='fd_set *' ;;
+	esac
+
+	$cat <<EOM
+
+Checking to see what type of arguments are expected by select().
+EOM
+	$cat >try.c <<EOCP
+#$i_systime I_SYS_TIME
+#$i_sysselct I_SYS_SELECT
+#$d_socket HAS_SOCKET
+#include <sys/types.h>
+#ifdef HAS_SOCKET
+#include <sys/socket.h> /* Might include <sys/bsdtypes.h> */
+#endif
+#ifdef I_SYS_TIME
+#include <sys/time.h>
+#else
+#ifdef I_SYS_SELECT
+#include <sys/select.h>
+#endif
+#endif
+main()
+{
+	int width;
+	Select_fd_set_t readfds;
+	Select_fd_set_t writefds;
+	Select_fd_set_t exceptfds;
+	struct timeval timeout;
+	select(width, readfds, writefds, exceptfds, &timeout);
+	exit(0);
+}
+EOCP
+	if $cc $ccflags -c -DSelect_fd_set_t="$xxx" try.c >/dev/null 2>&1 ; then
+		selecttype="$xxx"
+		echo "Your system uses $xxx for the arguments to select." >&4
+	elif $cc $ccflags -c -DSelect_fd_set_t="$yyy" try.c >/dev/null 2>&1 ; then
+		selecttype="$yyy"
+		echo "Your system uses $yyy for the arguments to select." >&4
+	else
+		rp='What is the type for the 2nd, 3rd, and 4th arguments to select?'
+		dflt="$xxx"
+		. ./myread
+		selecttype="$ans"
+	fi
+	$rm -f try.[co]
+	;;
+*)	selecttype='int *'
+	;;
+esac
+
+: Trace out the files included by signal.h, then look for SIGxxx names.
+: Remove SIGARRAYSIZE used by HPUX.
+: Remove SIGTYP void lines used by OS2.
+xxx=`echo '#include <signal.h>' |
+	$cppstdin $cppminus $cppflags 2>/dev/null |
+	$grep '^[ 	]*#.*include' | 
+	$awk "{print \\$$fieldn}" | $sed 's!"!!g' | $sort | $uniq`
+: Check this list of files to be sure we have parsed the cpp output ok.
+: This will also avoid potentially non-existent files, such 
+: as ../foo/bar.h
+xxxfiles=''
+for xx in $xxx /dev/null ; do
+	$test -f "$xx" && xxxfiles="$xxxfiles $xx"
+done
+: If we have found no files, at least try signal.h
+case "$xxxfiles" in
+'')	xxxfiles=`./findhdr signal.h` ;;
+esac
+xxx=`awk '
+$1 ~ /^#define$/ && $2 ~ /^SIG[A-Z0-9]*$/ && $2 !~ /SIGARRAYSIZE/ && $3 !~ /void/ {
+	print substr($2, 4, 20)
+}
+$1 == "#" && $2 ~ /^define$/ && $3 ~ /^SIG[A-Z0-9]*$/ && $3 !~ /SIGARRAYSIZE/ && $4 !~ /void/ {
+	print substr($3, 4, 20)
+}' $xxxfiles`
+: Append some common names just in case the awk scan failed.
+xxx="$xxx ABRT ALRM BUS CHLD CLD CONT DIL EMT FPE HUP ILL INT IO IOT KILL"
+xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP"
+xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM"
+xxx="$xxx WINCH WIND WINDOW XCPU XFSZ"
+: generate a few handy files for later
+$cat > signal.c <<'EOP'
+#include <sys/types.h>
+#include <signal.h>
+int main() {
+#ifdef NSIG
+printf("NSIG %d\n", NSIG);
+#else
+#ifdef _NSIG
+printf("NSIG %d\n", _NSIG);
+#endif
+#endif
+EOP
+echo $xxx | $tr ' ' '\012' | $sort | $uniq | $awk '
+{
+	printf "#ifdef SIG"; printf $1; printf "\n"
+	printf "printf(\""; printf $1; printf " %%d\\n\",SIG";
+	printf $1; printf ");\n"
+	printf "#endif\n"
+}
+END {
+	printf "}\n";
+}
+' >>signal.c
+$cat >signal.awk <<'EOP'
+BEGIN { ndups = 0 }
+$1 ~ /^NSIG$/ { nsig = $2 }
+($1 !~ /^NSIG$/) && (NF == 2) {
+    if ($2 > maxsig) { maxsig = $2 }
+    if (sig_name[$2]) {
+	dup_name[ndups] = $1
+	dup_num[ndups] = $2
+	ndups++ 
+    }
+    else {
+	sig_name[$2] = $1
+	sig_num[$2] = $2
+    }
+
+}
+END { 
+    if (nsig == 0) { nsig = maxsig + 1 }
+	for (n = 1; n < nsig; n++) {
+		if (sig_name[n]) {
+			printf("%s %d\n", sig_name[n], sig_num[n])
+		}
+		else {
+			printf("NUM%d %d\n", n, n) 
+		}
+	}
+    for (n = 0; n < ndups; n++) {
+		printf("%s %d\n", dup_name[n], dup_num[n])
+    }
+}
+EOP
+$cat >signal_cmd <<EOS
+$startsh
+$test -s signal.lst && exit 0
+if $cc $ccflags signal.c -o signal $ldflags >/dev/null 2>&1; then
+	./signal | $sort -n +1 | $uniq | $awk -f signal.awk >signal.lst
+else
+	echo "(I can't seem be able to compile the test program -- Guessing)"
+	echo 'kill -l' >signal
+	set X \`csh -f <signal\`
+	$rm -f signal
+	shift
+	case \$# in
+	0) set HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM;;
+	esac
+	echo \$@ | $tr ' ' '\012' | \
+		$awk '{ printf $1; printf " %d\n", ++s; }' >signal.lst
+fi
+$rm -f signal.c signal signal.o
+EOS
+chmod a+x signal_cmd
+$eunicefix signal_cmd
+
+: generate list of signal names
+echo " "
+case "$sig_name" in
+'')	sig_num='' ;;
+esac
+case "$sig_num" in
+'')	sig_name='' ;;
+esac
+case "$sig_name" in
+'')
+	echo "Generating a list of signal names and numbers..." >&4
+	./signal_cmd
+	sig_name=`$awk '{printf "%s ", $1}' signal.lst`
+	sig_name="ZERO $sig_name"
+	sig_num=`$awk '{printf "%d ", $2}' signal.lst`
+	sig_num="0 $sig_num"
+	;;
+esac
+echo "The following signals are available:"
+echo " "
+echo $sig_name | $awk \
+'BEGIN { linelen = 0 }
+{
+	for (i = 1; i <= NF; i++) {
+		name = "SIG" $i " "
+		linelen = linelen + length(name)
+		if (linelen > 70) {
+			printf "\n"
+			linelen = length(name)
+		}
+		printf "%s", name
+	}
+	printf "\n"
+}'
+$rm -f signal signal.c signal.awk signal.lst signal_cmd 
+
+: see what type is used for size_t
+set size_t sizetype 'unsigned int' stdio.h sys/types.h
+eval $typedef
+dflt="$sizetype"
+echo " "
+rp="What type is used for the length parameter for string functions?"
+. ./myread
+sizetype="$ans"
+
+: see what type is used for signed size_t
+set ssize_t ssizetype int stdio.h sys/types.h
+eval $typedef
+dflt="$ssizetype"
+$cat > ssize.c <<EOM
+#include <stdio.h>
+#include <sys/types.h>
+#define Size_t $sizetype
+#define SSize_t $dflt
+main()
+{
+	if (sizeof(Size_t) == sizeof(SSize_t))
+		printf("$dflt\n");
+	else if (sizeof(Size_t) == sizeof(int))
+		printf("int\n");
+	else 
+		printf("long\n");
+}
+EOM
+echo " "
+if $cc $ccflags $ldflags -o ssize ssize.c $libs > /dev/null 2>&1 ; then
+	ssizetype=`./ssize`
+	echo "I'll be using $ssizetype for functions returning a byte count." >&4
+else
+	echo "(I can't compile the test program--please enlighten me!)"
+	$cat <<EOM
+
+I need a type that is the same size as $sizetype, but is guaranteed to
+be signed.  Common values are int and long.
+
+EOM
+	rp="What signed type is the same size as $sizetype?"
+	. ./myread
+	ssizetype="$ans"
+fi
+$rm -f ssize ssize.[co]
+
+: see what type of char stdio uses.
+echo " "
+if $contains 'unsigned.*char.*_ptr;' `./findhdr stdio.h` >/dev/null 2>&1 ; then
+	echo "Your stdio uses unsigned chars." >&4
+	stdchar="unsigned char"
+else
+	echo "Your stdio uses signed chars." >&4
+	stdchar="char"
+fi
+
+: see if time exists
+echo " "
+if set time val -f d_time; eval $csym; $val; then
+	echo 'time() found.' >&4
+	val="$define"
+	set time_t timetype long stdio.h sys/types.h
+	eval $typedef
+	dflt="$timetype"
+	echo " "
+	rp="What type is returned by time() on this system?"
+	. ./myread
+	timetype="$ans"
+else
+	echo 'time() not found, hope that will do.' >&4
+	val="$undef"
+	timetype='int';
+fi
+set d_time
+eval $setvar
+
+: see what type uids are declared as in the kernel
+set uid_t uidtype xxx stdio.h sys/types.h
+eval $typedef
+case "$uidtype" in
+xxx)
+	xxx=`./findhdr sys/user.h`
+	set `grep '_ruid;' "$xxx" 2>/dev/null` unsigned short
+	case $1 in
+	unsigned) dflt="$1 $2" ;;
+	*) dflt="$1" ;;
+	esac
+	;;
+*) dflt="$uidtype";;
+esac
+echo " "
+rp="What is the type for user ids returned by getuid()?"
+. ./myread
+uidtype="$ans"
+
+: see if dbm.h is available
+: see if dbmclose exists
+set dbmclose d_dbmclose
+eval $inlibc
+
+case "$d_dbmclose" in
+$define)
+	set dbm.h i_dbm
+	eval $inhdr
+	case "$i_dbm" in
+	$define)
+		val="$undef"
+		set i_rpcsvcdbm
+		eval $setvar
+		;;
+	*)	set rpcsvc/dbm.h i_rpcsvcdbm
+		eval $inhdr
+		;;
+	esac
+	;;
+*)	echo "We won't be including <dbm.h>"
+	val="$undef"
+	set i_dbm
+	eval $setvar
+	val="$undef"
+	set i_rpcsvcdbm
+	eval $setvar
+	;;
+esac
+
+: see if this is a sys/file.h system
+val=''
+set sys/file.h val
+eval $inhdr
+
+: do we need to include sys/file.h ?
+case "$val" in
+"$define")
+	echo " "
+	if $h_sysfile; then
+		val="$define"
+		echo "We'll be including <sys/file.h>." >&4
+	else
+		val="$undef"
+		echo "We won't be including <sys/file.h>." >&4
+	fi
+	;;
+*)
+	h_sysfile=false
+	;;
+esac
+set i_sysfile
+eval $setvar
+
+: see if fcntl.h is there
+val=''
+set fcntl.h val
+eval $inhdr
+
+: see if we can include fcntl.h
+case "$val" in
+"$define")
+	echo " "
+	if $h_fcntl; then
+		val="$define"
+		echo "We'll be including <fcntl.h>." >&4
+	else
+		val="$undef"
+		if $h_sysfile; then
+	echo "We don't need to include <fcntl.h> if we include <sys/file.h>." >&4
+		else
+			echo "We won't be including <fcntl.h>." >&4
+		fi
+	fi
+	;;
+*)
+	h_fcntl=false
+	val="$undef"
+	;;
+esac
+set i_fcntl
+eval $setvar
+
+: see if this is an grp system
+set grp.h i_grp
+eval $inhdr
+
+: see if locale.h is available
+set locale.h i_locale
+eval $inhdr
+
+: see if this is a math.h system
+set math.h i_math
+eval $inhdr
+
+: see if memory.h is available.
+val=''
+set memory.h val
+eval $inhdr
+
+: See if it conflicts with string.h
+case "$val" in
+$define)
+	case "$strings" in
+	'') ;;
+	*)
+		$cppstdin $cppflags $cppminus < $strings > mem.h
+		if $contains 'memcpy' mem.h >/dev/null 2>&1; then
+			echo " "
+			echo "We won't be including <memory.h>."
+			val="$undef"
+		fi
+		$rm -f mem.h
+		;;
+	esac
+esac
+set i_memory
+eval $setvar
+
+: see if ndbm.h is available
+set ndbm.h t_ndbm
+eval $inhdr
+case "$t_ndbm" in
+$define)
+	: see if dbm_open exists
+	set dbm_open d_dbm_open
+	eval $inlibc
+	case "$d_dbm_open" in
+	$undef)
+		t_ndbm="$undef"
+		echo "We won't be including <ndbm.h>"
+		;;
+	esac
+	;;
+esac
+val="$t_ndbm"
+set i_ndbm
+eval $setvar
+
+: see if net/errno.h is available
+val=''
+set net/errno.h val
+eval $inhdr
+
+: Unfortunately, it causes problems on some systems.  Arrgh.
+case "$val" in
+$define)
+	cat > try.c <<'EOM'
+#include <stdio.h>
+#include <errno.h>
+#include <net/errno.h>
+int func()
+{
+	return ENOTSOCK;
+}
+EOM
+	if $cc $ccflags -c try.c >/dev/null 2>&1; then
+		echo "We'll be including <net/errno.h>." >&4
+	else
+		echo "We won't be including <net/errno.h>." >&4
+		val="$undef"
+	fi
+	$rm -f try.* try
+	;;
+esac
+set i_neterrno
+eval $setvar
+
+: get C preprocessor symbols handy
+echo " "
+$echo $n "Hmm... $c"
+echo $al | $tr ' ' '\012' >Cppsym.know
+$cat <<EOSS >Cppsym
+$startsh
+case "\$1" in
+-l) list=true
+	shift
+	;;
+esac
+unknown=''
+case "\$list\$#" in
+1|2)
+	for sym do
+		if $contains "^\$1$" Cppsym.true >/dev/null 2>&1; then
+			exit 0
+		elif $contains "^\$1$" Cppsym.know >/dev/null 2>&1; then
+			:
+		else
+			unknown="\$unknown \$sym"
+		fi
+	done
+	set X \$unknown
+	shift
+	;;
+esac
+case \$# in
+0) exit 1;;
+esac
+echo \$* | $tr ' ' '\012' | $sed -e 's/\(.*\)/\\
+#ifdef \1\\
+exit 0; _ _ _ _\1\\	 \1\\
+#endif\\
+/' >Cppsym\$\$
+echo "exit 1; _ _ _" >>Cppsym\$\$
+$cppstdin $cppminus <Cppsym\$\$ | $grep '^exit [01]; _ _'  >Cppsym2\$\$
+case "\$list" in
+true) $awk 'NF > 5 {print substr(\$6,2,100)}' <Cppsym2\$\$ ;;
+*)
+	sh Cppsym2\$\$
+	status=\$?
+	;;
+esac
+$rm -f Cppsym\$\$ Cppsym2\$\$
+exit \$status
+EOSS
+chmod +x Cppsym
+$eunicefix Cppsym
+./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true
+
+: now check the C compiler for additional symbols
+$cat >ccsym <<EOS
+$startsh
+$cat >tmp.c <<EOF
+extern int foo;
+EOF
+for i in \`$cc -v -c tmp.c 2>&1\`
+do
+	case "\$i" in
+	-D*) echo "\$i" | $sed 's/^-D//';;
+	-A*) $test "$gccversion" && echo "\$i" | $sed 's/^-A\(.*\)(\(.*\))/\1=\2/';;
+	esac
+done
+$rm -f try.c
+EOS
+chmod +x ccsym
+$eunicefix ccsym
+./ccsym | $sort | $uniq >ccsym.raw
+$awk '/\=/ { print $0; next }
+	{ print $0"=1" }' ccsym.raw >ccsym.list
+$awk '{ print $0"=1" }' Cppsym.true >ccsym.true
+$comm -13 ccsym.true ccsym.list >ccsym.own
+$comm -12 ccsym.true ccsym.list >ccsym.com
+$comm -23 ccsym.true ccsym.list >ccsym.cpp
+also=''
+symbols='symbols'
+if $test -z ccsym.raw; then
+	echo "Your C compiler doesn't seem to define any symbol!" >&4
+	echo " "
+	echo "However, your C preprocessor defines the following ones:"
+	$cat Cppsym.true
+else
+	if $test -s ccsym.com; then
+		echo "Your C compiler and pre-processor define these symbols:"
+		$sed -e 's/\(.*\)=.*/\1/' ccsym.com
+		also='also '
+		symbols='ones'
+		$test "$silent" || sleep 1
+	fi
+	if $test -s ccsym.cpp; then
+		$test "$also" && echo " "
+		echo "Your C pre-processor ${also}defines the following $symbols:"
+		$sed -e 's/\(.*\)=.*/\1/' ccsym.cpp
+		also='further '
+		$test "$silent" || sleep 1
+	fi
+	if $test -s ccsym.own; then
+		$test "$also" && echo " "
+		echo "Your C compiler ${also}defines the following cpp variables:"
+		$sed -e 's/\(.*\)=1/\1/' ccsym.own
+		$sed -e 's/\(.*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true
+		$test "$silent" || sleep 1
+	fi
+fi
+$rm -f ccsym*
+
+: see if this is a termio system
+val="$undef"
+val2="$undef"
+val3="$undef"
+if $test `./findhdr termios.h`; then
+	set tcsetattr i_termios
+	eval $inlibc
+	val3="$i_termios"
+fi
+echo " "
+case "$val3" in
+"$define") echo "You have POSIX termios.h... good!" >&4;;
+*) if ./Cppsym pyr; then
+		case "`/bin/universe`" in
+		ucb) if $test `./findhdr sgtty.h`; then
+				val2="$define"
+				echo "<sgtty.h> found." >&4
+			else
+				echo "System is pyramid with BSD universe."
+				echo "<sgtty.h> not found--you could have problems." >&4
+			fi;;
+		*) if $test `./findhdr termio.h`; then
+				val="$define"
+				echo "<termio.h> found." >&4
+			else
+				echo "System is pyramid with USG universe."
+				echo "<termio.h> not found--you could have problems." >&4
+			fi;;
+		esac
+	elif ./usg; then
+		if $test `./findhdr termio.h`; then
+			echo "<termio.h> found." >&4
+			val="$define"
+		elif $test `./findhdr sgtty.h`; then
+			echo "<sgtty.h> found." >&4
+			val2="$define"
+		else
+echo "Neither <termio.h> nor <sgtty.h> found--you could have problems." >&4
+		fi
+	else
+		if $test `./findhdr sgtty.h`; then
+			echo "<sgtty.h> found." >&4
+			val2="$define"
+		elif $test `./findhdr termio.h`; then
+			echo "<termio.h> found." >&4
+			val="$define"
+		else
+echo "Neither <sgtty.h> nor <termio.h> found--you could have problems." >&4
+		fi
+	fi;;
+esac
+set i_termio; eval $setvar
+val=$val2; set i_sgtty; eval $setvar
+val=$val3; set i_termios; eval $setvar
+
+: see if stdarg is available
+echo " "
+if $test `./findhdr stdarg.h`; then
+	echo "<stdarg.h> found." >&4
+	valstd="$define"
+else
+	echo "<stdarg.h> NOT found." >&4
+	valstd="$undef"
+fi
+
+: see if varags is available
+echo " "
+if $test `./findhdr varargs.h`; then
+	echo "<varargs.h> found." >&4
+else
+	echo "<varargs.h> NOT found, but that's ok (I hope)." >&4
+fi
+
+: set up the varargs testing programs
+$cat > varargs.c <<EOP
+#ifdef I_STDARG
+#include <stdarg.h>
+#endif
+#ifdef I_VARARGS
+#include <varargs.h>
+#endif
+
+#ifdef I_STDARG
+int f(char *p, ...)
+#else
+int f(va_alist)
+va_dcl
+#endif
+{
+	va_list ap;
+#ifndef I_STDARG
+	char *p;
+#endif
+#ifdef I_STDARG
+	va_start(ap,p);
+#else
+	va_start(ap);
+	p = va_arg(ap, char *);
+#endif
+	va_end(ap);
+}
+EOP
+$cat > varargs <<EOP
+$startsh
+if $cc -c $ccflags -D\$1 varargs.c >/dev/null 2>&1; then
+	echo "true"
+else
+	echo "false"
+fi
+$rm -f varargs.o
+EOP
+chmod +x varargs
+
+: now check which varargs header should be included
+echo " "
+i_varhdr=''
+case "$valstd" in
+"$define")
+	if `./varargs I_STDARG`; then
+		val='stdarg.h'
+	elif `./varargs I_VARARGS`; then
+		val='varargs.h'
+	fi
+	;;
+*)
+	if `./varargs I_VARARGS`; then
+		val='varargs.h'
+	fi
+	;;
+esac
+case "$val" in
+'')
+echo "I could not find the definition for va_dcl... You have problems..." >&4
+	val="$undef"; set i_stdarg; eval $setvar
+	val="$undef"; set i_varargs; eval $setvar
+	;;
+*) 
+	set i_varhdr
+	eval $setvar
+	case "$i_varhdr" in
+	stdarg.h)
+		val="$define"; set i_stdarg; eval $setvar
+		val="$undef"; set i_varargs; eval $setvar
+		;;
+	varargs.h)
+		val="$undef"; set i_stdarg; eval $setvar
+		val="$define"; set i_varargs; eval $setvar
+		;;
+	esac
+	echo "We'll include <$i_varhdr> to get va_dcl definition." >&4;;
+esac
+$rm -f varargs*
+
+: see if stddef is available
+set stddef.h i_stddef
+eval $inhdr
+
+: see if ioctl defs are in sgtty, termio, sys/filio or sys/ioctl
+set sys/filio.h i_sysfilio
+eval $inhdr
+echo " "
+if $test `./findhdr sys/ioctl.h`; then
+	val="$define"
+	echo '<sys/ioctl.h> found.' >&4
+else
+	val="$undef"
+	if $test $i_sysfilio = "$define"; then
+	    echo '<sys/ioctl.h> NOT found.' >&4
+	else
+		$test $i_sgtty = "$define" && xxx="sgtty.h"
+		$test $i_termio = "$define" && xxx="termio.h"
+		$test $i_termios = "$define" && xxx="termios.h"
+echo "No <sys/ioctl.h> found, assuming ioctl args are defined in <$xxx>." >&4
+	fi
+fi
+set i_sysioctl
+eval $setvar
+
+: see if this is a sys/param system
+set sys/param.h i_sysparam
+eval $inhdr
+
+: see if sys/stat.h is available
+set sys/stat.h i_sysstat
+eval $inhdr
+
+: see if sys/types.h has to be included
+set sys/types.h i_systypes
+eval $inhdr
+
+: see if this is a sys/un.h system
+set sys/un.h i_sysun
+eval $inhdr
+
+: see if this is a unistd.h system
+set unistd.h i_unistd
+eval $inhdr
+
+: see if this is an utime system
+set utime.h i_utime
+eval $inhdr
+
+: see if this is a vfork system
+case "$d_vfork" in
+"$define")
+	set vfork.h i_vfork
+	eval $inhdr
+	;;
+*)
+	i_vfork="$undef"
+	;;
+esac
+
+: see if gdbm.h is available
+set gdbm.h t_gdbm
+eval $inhdr
+case "$t_gdbm" in
+$define)
+	: see if gdbm_open exists
+	set gdbm_open d_gdbm_open
+	eval $inlibc
+	case "$d_gdbm_open" in
+	$undef)
+		t_gdbm="$undef"
+		echo "We won't be including <gdbm.h>"
+		;;
+	esac
+	;;
+esac
+val="$t_gdbm"
+set i_gdbm
+eval $setvar
+
+echo " "
+echo "Looking for extensions..." >&4
+cd ../ext
+: If we are using the old config.sh, known_extensions may contain
+: old or inaccurate or duplicate values.
+known_extensions=''
+: We do not use find because it might not be available.
+: We do not just use MANIFEST because the user may have dropped
+: some additional extensions into the source tree and expect them
+: to be built.
+for xxx in * ; do
+	if $test -f $xxx/$xxx.xs; then
+		known_extensions="$known_extensions $xxx"
+	else
+		if $test -d $xxx; then
+			cd $xxx
+			for yyy in * ; do
+				if $test -f $yyy/$yyy.xs; then
+					known_extensions="$known_extensions $xxx/$yyy"
+				fi
+			done
+			cd ..
+		fi
+	fi
+done
+set X $known_extensions
+shift
+known_extensions="$*"
+cd ../UU
+
+: Now see which are supported on this system.
+avail_ext=''
+for xxx in $known_extensions ; do
+    case "$xxx" in
+    DB_File) case "$i_db" in 
+	    $define) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    GDBM_File) case "$i_gdbm" in 
+	    $define) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    NDBM_File) case "$i_ndbm" in 
+	    $define) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    ODBM_File) case "${i_dbm}${i_rpcsvcdbm}" in 
+	    *"${define}"*) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    POSIX) case "$useposix" in 
+	    true|define|y) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    SAFE) case "$usesafe" in 
+	    true|define|y) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    Socket) case "$d_socket" in 
+	    $define) avail_ext="$avail_ext $xxx" ;;
+	    esac
+	    ;;
+    *)      avail_ext="$avail_ext $xxx"
+	    ;;
+    esac
+done
+
+set X $avail_ext
+shift
+avail_ext="$*"
+
+case $usedl in
+$define)
+	$cat <<EOM
+A number of extensions are supplied with $package.  You may choose to
+compile these extensions for dynamic loading (the default), compile
+them into the $package executable (static loading), or not include
+them at all.  Answer "none" to include no extensions.
+
+EOM
+	case "$dynamic_ext" in
+	'') dflt="$avail_ext" ;;
+	*)	dflt="$dynamic_ext" ;;
+	esac
+	case "$dflt" in
+	'')	dflt=none;;
+	esac
+	rp="What extensions do you wish to load dynamically?"
+	. ./myread
+	case "$ans" in
+	none) dynamic_ext=' ' ;;
+	*) dynamic_ext="$ans" ;;
+	esac
+
+	case "$static_ext" in
+	'')
+		: Exclude those already listed in dynamic linking
+		dflt=''
+		for xxx in $avail_ext; do
+			case " $dynamic_ext " in
+			*" $xxx "*) ;;
+			*) dflt="$dflt $xxx" ;;
+			esac
+		done
+		set X $dflt
+		shift
+		dflt="$*"
+		;;
+	*)  dflt="$static_ext" 
+		;;
+	esac
+
+	case "$dflt" in
+	'')	dflt=none;;
+	esac
+	rp="What extensions do you wish to load statically?"
+	. ./myread
+	case "$ans" in
+	none) static_ext=' ' ;;
+	*) static_ext="$ans" ;;
+	esac
+	;;
+*)
+	$cat <<EOM
+A number of extensions are supplied with $package.  Answer "none" 
+to include no extensions. 
+
+EOM
+	case "$static_ext" in
+	'') dflt="$avail_ext" ;;
+	*)	dflt="$static_ext" ;;
+	esac
+
+	case "$dflt" in
+	'')	dflt=none;;
+	esac
+	rp="What extensions do you wish to include?"
+	. ./myread
+	case "$ans" in
+	none) static_ext=' ' ;;
+	*) static_ext="$ans" ;;
+	esac
+	;;
+esac
+
+set X $dynamic_ext $static_ext
+shift
+extensions="$*"
+
+: Remove build directory name from cppstdin so it can be used from
+: either the present location or the final installed location.
+echo " "
+: Get out of the UU directory to get correct path name.
+cd ..
+case "$cppstdin" in
+`pwd`/cppstdin)
+	echo "Stripping down cppstdin path name"
+	cppstdin=cppstdin
+	;;
+esac
+cd UU
+
+: end of configuration questions
+echo " "
+echo "End of configuration questions."
+echo " "
+
+: back to where it started
+if test -d ../UU; then
+	cd ..
+fi
+
+: configuration may be patched via a 'config.over' file
+if $test -f config.over; then
+	echo " "
+	dflt=y
+	rp='I see a config.over file.  Do you wish to load it?'
+	. UU/myread
+	case "$ans" in
+	n*) echo "OK, I'll ignore it.";;
+	*)	. ./config.over
+		echo "Configuration override changes have been loaded."
+		;;
+	esac
+fi
+
+: in case they want portability, strip down executable paths
+case "$d_portable" in
+"$define")
+	echo " "
+	echo "Stripping down executable paths..." >&4
+	for file in $loclist $trylist; do
+		eval $file="\$file"
+	done
+	;;
+esac
+
+: create config.sh file
+echo " "
+echo "Creating config.sh..." >&4
+$spitshell <<EOT >config.sh
+$startsh
+#
+# This file was produced by running the Configure script. It holds all the
+# definitions figured out by Configure. Should you modify one of these values,
+# do not forget to propagate your changes by running "Configure -der". You may
+# instead choose to run each of the .SH files by yourself, or "Configure -S".
+#
+
+# Configuration time: $cf_time
+# Configured by: $cf_by
+# Target system: $myuname
+
+Author='$Author'
+Date='$Date'
+Header='$Header'
+Id='$Id'
+Locker='$Locker'
+Log='$Log'
+Mcc='$Mcc'
+RCSfile='$RCSfile'
+Revision='$Revision'
+Source='$Source'
+State='$State'
+afs='$afs'
+alignbytes='$alignbytes'
+aphostname='$aphostname'
+ar='$ar'
+archlib='$archlib'
+archlibexp='$archlibexp'
+archname='$archname'
+archobjs='$archobjs'
+awk='$awk'
+baserev='$baserev'
+bash='$bash'
+bin='$bin'
+binexp='$binexp'
+bison='$bison'
+byacc='$byacc'
+byteorder='$byteorder'
+c='$c'
+castflags='$castflags'
+cat='$cat'
+cc='$cc'
+cccdlflags='$cccdlflags'
+ccdlflags='$ccdlflags'
+ccflags='$ccflags'
+cf_by='$cf_by'
+cf_email='$cf_email'
+cf_time='$cf_time'
+chgrp='$chgrp'
+chmod='$chmod'
+chown='$chown'
+clocktype='$clocktype'
+comm='$comm'
+compress='$compress'
+contains='$contains'
+cp='$cp'
+cpio='$cpio'
+cpp='$cpp'
+cpp_stuff='$cpp_stuff'
+cppflags='$cppflags'
+cpplast='$cpplast'
+cppminus='$cppminus'
+cpprun='$cpprun'
+cppstdin='$cppstdin'
+cryptlib='$cryptlib'
+csh='$csh'
+d_Gconvert='$d_Gconvert'
+d_access='$d_access'
+d_alarm='$d_alarm'
+d_archlib='$d_archlib'
+d_attribut='$d_attribut'
+d_bcmp='$d_bcmp'
+d_bcopy='$d_bcopy'
+d_bsd='$d_bsd'
+d_bsdpgrp='$d_bsdpgrp'
+d_bzero='$d_bzero'
+d_casti32='$d_casti32'
+d_castneg='$d_castneg'
+d_charvspr='$d_charvspr'
+d_chown='$d_chown'
+d_chroot='$d_chroot'
+d_chsize='$d_chsize'
+d_closedir='$d_closedir'
+d_const='$d_const'
+d_crypt='$d_crypt'
+d_csh='$d_csh'
+d_cuserid='$d_cuserid'
+d_dbl_dig='$d_dbl_dig'
+d_difftime='$d_difftime'
+d_dirnamlen='$d_dirnamlen'
+d_dlerror='$d_dlerror'
+d_dlopen='$d_dlopen'
+d_dlsymun='$d_dlsymun'
+d_dosuid='$d_dosuid'
+d_dup2='$d_dup2'
+d_eofnblk='$d_eofnblk'
+d_eunice='$d_eunice'
+d_fchmod='$d_fchmod'
+d_fchown='$d_fchown'
+d_fcntl='$d_fcntl'
+d_fd_macros='$d_fd_macros'
+d_fd_set='$d_fd_set'
+d_fds_bits='$d_fds_bits'
+d_fgetpos='$d_fgetpos'
+d_flexfnam='$d_flexfnam'
+d_flock='$d_flock'
+d_fork='$d_fork'
+d_fpathconf='$d_fpathconf'
+d_fsetpos='$d_fsetpos'
+d_getgrps='$d_getgrps'
+d_gethent='$d_gethent'
+d_gethname='$d_gethname'
+d_getlogin='$d_getlogin'
+d_getpgrp2='$d_getpgrp2'
+d_getpgrp='$d_getpgrp'
+d_getppid='$d_getppid'
+d_getprior='$d_getprior'
+d_htonl='$d_htonl'
+d_index='$d_index'
+d_isascii='$d_isascii'
+d_killpg='$d_killpg'
+d_link='$d_link'
+d_locconv='$d_locconv'
+d_lockf='$d_lockf'
+d_lstat='$d_lstat'
+d_mblen='$d_mblen'
+d_mbstowcs='$d_mbstowcs'
+d_mbtowc='$d_mbtowc'
+d_memcmp='$d_memcmp'
+d_memcpy='$d_memcpy'
+d_memmove='$d_memmove'
+d_memset='$d_memset'
+d_mkdir='$d_mkdir'
+d_mkfifo='$d_mkfifo'
+d_mktime='$d_mktime'
+d_msg='$d_msg'
+d_msgctl='$d_msgctl'
+d_msgget='$d_msgget'
+d_msgrcv='$d_msgrcv'
+d_msgsnd='$d_msgsnd'
+d_mymalloc='$d_mymalloc'
+d_nice='$d_nice'
+d_oldarchlib='$d_oldarchlib'
+d_oldsock='$d_oldsock'
+d_open3='$d_open3'
+d_pathconf='$d_pathconf'
+d_pause='$d_pause'
+d_phostname='$d_phostname'
+d_pipe='$d_pipe'
+d_poll='$d_poll'
+d_portable='$d_portable'
+d_pwage='$d_pwage'
+d_pwchange='$d_pwchange'
+d_pwclass='$d_pwclass'
+d_pwcomment='$d_pwcomment'
+d_pwexpire='$d_pwexpire'
+d_pwquota='$d_pwquota'
+d_readdir='$d_readdir'
+d_readlink='$d_readlink'
+d_rename='$d_rename'
+d_rewinddir='$d_rewinddir'
+d_rmdir='$d_rmdir'
+d_safebcpy='$d_safebcpy'
+d_safemcpy='$d_safemcpy'
+d_seekdir='$d_seekdir'
+d_select='$d_select'
+d_sem='$d_sem'
+d_semctl='$d_semctl'
+d_semget='$d_semget'
+d_semop='$d_semop'
+d_setegid='$d_setegid'
+d_seteuid='$d_seteuid'
+d_setlinebuf='$d_setlinebuf'
+d_setlocale='$d_setlocale'
+d_setpgid='$d_setpgid'
+d_setpgrp2='$d_setpgrp2'
+d_setpgrp='$d_setpgrp'
+d_setprior='$d_setprior'
+d_setregid='$d_setregid'
+d_setresgid='$d_setresgid'
+d_setresuid='$d_setresuid'
+d_setreuid='$d_setreuid'
+d_setrgid='$d_setrgid'
+d_setruid='$d_setruid'
+d_setsid='$d_setsid'
+d_shm='$d_shm'
+d_shmat='$d_shmat'
+d_shmatprototype='$d_shmatprototype'
+d_shmctl='$d_shmctl'
+d_shmdt='$d_shmdt'
+d_shmget='$d_shmget'
+d_shrplib='$d_shrplib'
+d_sigaction='$d_sigaction'
+d_sigintrp='$d_sigintrp'
+d_sigsetjmp='$d_sigsetjmp'
+d_sigvec='$d_sigvec'
+d_sigvectr='$d_sigvectr'
+d_socket='$d_socket'
+d_sockpair='$d_sockpair'
+d_statblks='$d_statblks'
+d_stdio_cnt_lval='$d_stdio_cnt_lval'
+d_stdio_ptr_lval='$d_stdio_ptr_lval'
+d_stdiobase='$d_stdiobase'
+d_stdstdio='$d_stdstdio'
+d_strchr='$d_strchr'
+d_strcoll='$d_strcoll'
+d_strctcpy='$d_strctcpy'
+d_strerrm='$d_strerrm'
+d_strerror='$d_strerror'
+d_strxfrm='$d_strxfrm'
+d_suidsafe='$d_suidsafe'
+d_symlink='$d_symlink'
+d_syscall='$d_syscall'
+d_sysconf='$d_sysconf'
+d_sysernlst='$d_sysernlst'
+d_syserrlst='$d_syserrlst'
+d_system='$d_system'
+d_tcgetpgrp='$d_tcgetpgrp'
+d_tcsetpgrp='$d_tcsetpgrp'
+d_telldir='$d_telldir'
+d_time='$d_time'
+d_times='$d_times'
+d_truncate='$d_truncate'
+d_tzname='$d_tzname'
+d_umask='$d_umask'
+d_uname='$d_uname'
+d_vfork='$d_vfork'
+d_void_closedir='$d_void_closedir'
+d_voidsig='$d_voidsig'
+d_voidtty='$d_voidtty'
+d_volatile='$d_volatile'
+d_vprintf='$d_vprintf'
+d_wait4='$d_wait4'
+d_waitpid='$d_waitpid'
+d_wcstombs='$d_wcstombs'
+d_wctomb='$d_wctomb'
+d_xenix='$d_xenix'
+date='$date'
+db_hashtype='$db_hashtype'
+db_prefixtype='$db_prefixtype'
+defvoidused='$defvoidused'
+direntrytype='$direntrytype'
+dlext='$dlext'
+dlsrc='$dlsrc'
+dynamic_ext='$dynamic_ext'
+eagain='$eagain'
+echo='$echo'
+egrep='$egrep'
+emacs='$emacs'
+eunicefix='$eunicefix'
+exe_ext='$exe_ext'
+expr='$expr'
+extensions='$extensions'
+find='$find'
+firstmakefile='$firstmakefile'
+flex='$flex'
+fpostype='$fpostype'
+freetype='$freetype'
+full_csh='$full_csh'
+full_sed='$full_sed'
+gcc='$gcc'
+gccversion='$gccversion'
+gidtype='$gidtype'
+glibpth='$glibpth'
+grep='$grep'
+groupcat='$groupcat'
+groupstype='$groupstype'
+h_fcntl='$h_fcntl'
+h_sysfile='$h_sysfile'
+hint='$hint'
+hostcat='$hostcat'
+huge='$huge'
+i_bsdioctl='$i_bsdioctl'
+i_db='$i_db'
+i_dbm='$i_dbm'
+i_dirent='$i_dirent'
+i_dld='$i_dld'
+i_dlfcn='$i_dlfcn'
+i_fcntl='$i_fcntl'
+i_float='$i_float'
+i_gdbm='$i_gdbm'
+i_grp='$i_grp'
+i_limits='$i_limits'
+i_locale='$i_locale'
+i_malloc='$i_malloc'
+i_math='$i_math'
+i_memory='$i_memory'
+i_ndbm='$i_ndbm'
+i_neterrno='$i_neterrno'
+i_niin='$i_niin'
+i_pwd='$i_pwd'
+i_rpcsvcdbm='$i_rpcsvcdbm'
+i_sgtty='$i_sgtty'
+i_stdarg='$i_stdarg'
+i_stddef='$i_stddef'
+i_stdlib='$i_stdlib'
+i_string='$i_string'
+i_sysdir='$i_sysdir'
+i_sysfile='$i_sysfile'
+i_sysfilio='$i_sysfilio'
+i_sysin='$i_sysin'
+i_sysioctl='$i_sysioctl'
+i_sysndir='$i_sysndir'
+i_sysparam='$i_sysparam'
+i_sysselct='$i_sysselct'
+i_syssockio='$i_syssockio'
+i_sysstat='$i_sysstat'
+i_systime='$i_systime'
+i_systimek='$i_systimek'
+i_systimes='$i_systimes'
+i_systypes='$i_systypes'
+i_sysun='$i_sysun'
+i_termio='$i_termio'
+i_termios='$i_termios'
+i_time='$i_time'
+i_unistd='$i_unistd'
+i_utime='$i_utime'
+i_varargs='$i_varargs'
+i_varhdr='$i_varhdr'
+i_vfork='$i_vfork'
+incpath='$incpath'
+inews='$inews'
+installarchlib='$installarchlib'
+installbin='$installbin'
+installman1dir='$installman1dir'
+installman3dir='$installman3dir'
+installprivlib='$installprivlib'
+installscript='$installscript'
+installsitearch='$installsitearch'
+installsitelib='$installsitelib'
+intsize='$intsize'
+known_extensions='$known_extensions'
+ksh='$ksh'
+large='$large'
+ld='$ld'
+lddlflags='$lddlflags'
+ldflags='$ldflags'
+less='$less'
+lib_ext='$lib_ext'
+libc='$libc'
+libpth='$libpth'
+libs='$libs'
+libswanted='$libswanted'
+line='$line'
+lint='$lint'
+lkflags='$lkflags'
+ln='$ln'
+lns='$lns'
+locincpth='$locincpth'
+loclibpth='$loclibpth'
+lp='$lp'
+lpr='$lpr'
+ls='$ls'
+lseektype='$lseektype'
+mail='$mail'
+mailx='$mailx'
+make='$make'
+mallocobj='$mallocobj'
+mallocsrc='$mallocsrc'
+malloctype='$malloctype'
+man1dir='$man1dir'
+man1direxp='$man1direxp'
+man1ext='$man1ext'
+man3dir='$man3dir'
+man3direxp='$man3direxp'
+man3ext='$man3ext'
+medium='$medium'
+mips='$mips'
+mips_type='$mips_type'
+mkdir='$mkdir'
+models='$models'
+modetype='$modetype'
+more='$more'
+mv='$mv'
+myarchname='$myarchname'
+mydomain='$mydomain'
+myhostname='$myhostname'
+myuname='$myuname'
+n='$n'
+nm_opt='$nm_opt'
+nm_so_opt='$nm_so_opt'
+nroff='$nroff'
+o_nonblock='$o_nonblock'
+obj_ext='$obj_ext'
+oldarchlib='$oldarchlib'
+oldarchlibexp='$oldarchlibexp'
+optimize='$optimize'
+orderlib='$orderlib'
+osname='$osname'
+osvers='$osvers'
+package='$package'
+pager='$pager'
+passcat='$passcat'
+patchlevel='$patchlevel'
+path_sep='$path_sep'
+perl='$perl'
+perladmin='$perladmin'
+perlpath='$perlpath'
+pg='$pg'
+phostname='$phostname'
+plibpth='$plibpth'
+pmake='$pmake'
+pr='$pr'
+prefix='$prefix'
+prefixexp='$prefixexp'
+privlib='$privlib'
+privlibexp='$privlibexp'
+prototype='$prototype'
+randbits='$randbits'
+ranlib='$ranlib'
+rd_nodata='$rd_nodata'
+rm='$rm'
+rmail='$rmail'
+runnm='$runnm'
+scriptdir='$scriptdir'
+scriptdirexp='$scriptdirexp'
+sed='$sed'
+selecttype='$selecttype'
+sendmail='$sendmail'
+sh='$sh'
+shar='$shar'
+sharpbang='$sharpbang'
+shmattype='$shmattype'
+shrpdir='$shrpdir'
+shsharp='$shsharp'
+sig_name='$sig_name'
+sig_num='$sig_num'
+signal_t='$signal_t'
+sitearch='$sitearch'
+sitearchexp='$sitearchexp'
+sitelib='$sitelib'
+sitelibexp='$sitelibexp'
+sizetype='$sizetype'
+sleep='$sleep'
+smail='$smail'
+small='$small'
+so='$so'
+sockethdr='$sockethdr'
+socketlib='$socketlib'
+sort='$sort'
+spackage='$spackage'
+spitshell='$spitshell'
+split='$split'
+ssizetype='$ssizetype'
+startperl='$startperl'
+startsh='$startsh'
+static_ext='$static_ext'
+stdchar='$stdchar'
+stdio_base='$stdio_base'
+stdio_bufsiz='$stdio_bufsiz'
+stdio_cnt='$stdio_cnt'
+stdio_ptr='$stdio_ptr'
+strings='$strings'
+submit='$submit'
+subversion='$subversion'
+sysman='$sysman'
+tail='$tail'
+tar='$tar'
+tbl='$tbl'
+test='$test'
+timeincl='$timeincl'
+timetype='$timetype'
+touch='$touch'
+tr='$tr'
+troff='$troff'
+uidtype='$uidtype'
+uname='$uname'
+uniq='$uniq'
+usedl='$usedl'
+usemymalloc='$usemymalloc'
+usenm='$usenm'
+useposix='$useposix'
+usesafe='$usesafe'
+usevfork='$usevfork'
+usrinc='$usrinc'
+uuname='$uuname'
+vi='$vi'
+voidflags='$voidflags'
+xlibpth='$xlibpth'
+zcat='$zcat'
+EOT
+
+: add special variables
+$test -f patchlevel.h && \
+awk '/^#define/ {printf "%s=%s\n",$2,$3}' patchlevel.h >>config.sh
+echo "CONFIG=true" >>config.sh
+
+: propagate old symbols
+if $test -f UU/config.sh; then
+	<UU/config.sh sort | uniq >UU/oldconfig.sh
+	sed -n 's/^\([a-zA-Z_0-9]*\)=.*/\1/p' config.sh config.sh UU/oldconfig.sh |\
+	sort | uniq -u >UU/oldsyms
+	set X `cat UU/oldsyms`
+	shift
+	case $# in
+	0) ;;
+	*)
+		cat <<EOM
+Hmm...You had some extra variables I don't know about...I'll try to keep 'em...
+EOM
+		echo "# Variables propagated from previous config.sh file." >>config.sh
+		for sym in `cat UU/oldsyms`; do
+			echo "    Propagating $hint variable "'$'"$sym..."
+			eval 'tmp="$'"${sym}"'"'
+			echo "$tmp" | \
+				sed -e "s/'/'\"'\"'/g" -e "s/^/$sym='/" -e "s/$/'/" >>config.sh
+		done
+		;;
+	esac
+fi
+
+: Finish up by extracting the .SH files
+case "$alldone" in
+exit)
+	$rm -rf UU
+	echo "Done."
+	exit 0
+	;;
+cont)
+	;;
+'')
+	dflt=''
+	nostick=true
+	$cat <<EOM
+
+If you'd like to make any changes to the config.sh file before I begin
+to configure things, do it as a shell escape now (e.g. !vi config.sh).
+
+EOM
+	rp="Press return or use a shell escape to edit config.sh:"
+	. UU/myread
+	nostick=''
+	case "$ans" in
+	'') ;;
+	*) : in case they cannot read
+		sh 1>&4 -c "$ans";;
+	esac
+	;;
+esac
+
+: if this fails, just run all the .SH files by hand
+. ./config.sh
+
+echo " "
+exec 1>&4
+. ./UU/extract
+
+if $contains '^depend:' [Mm]akefile >/dev/null 2>&1; then
+	dflt=y
+	case "$silent" in
+	true) ;;
+	*)
+		$cat <<EOM
+
+Now you need to generate make dependencies by running "make depend".
+You might prefer to run it in background: "make depend > makedepend.out &"
+It can take a while, so you might not want to run it right now.
+
+EOM
+		;;
+	esac
+	rp="Run make depend now?"
+	. UU/myread
+	case "$ans" in
+	y*)
+		make depend && echo "Now you must run a make."
+		;;
+	*)
+		echo "You must run 'make depend' then 'make'."
+		;;
+	esac
+elif test -f [Mm]akefile; then
+	echo " "
+	echo "Now you must run a make."
+else
+	echo "Done."
+fi
+
+$rm -f kit*isdone ark*isdone
+$rm -rf UU
+
+: End of Configure
+
diff --git a/gnu/usr.bin/perl/Copying b/gnu/usr.bin/perl/Copying
new file mode 100644
index 00000000000..3c68f02bb42
--- /dev/null
+++ b/gnu/usr.bin/perl/Copying
@@ -0,0 +1,248 @@
+		    GNU GENERAL PUBLIC LICENSE
+		     Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+                    675 Mass Ave, Cambridge, MA 02139, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The license agreements of most software companies try to keep users
+at the mercy of those companies.  By contrast, our General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  The
+General Public License applies to the Free Software Foundation's
+software and to any other program whose authors commit to using it.
+You can use it for your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Specifically, the General Public License is designed to make
+sure that you have the freedom to give away or sell copies of free
+software, that you receive source code or can get it if you want it,
+that you can change the software or use pieces of it in new free
+programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of a such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must tell them their rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License Agreement applies to any program or other work which
+contains a notice placed by the copyright holder saying it may be
+distributed under the terms of this General Public License.  The
+"Program", below, refers to any such program or work, and a "work based
+on the Program" means either the Program or any work containing the
+Program or a portion of it, either verbatim or with modifications.  Each
+licensee is addressed as "you".
+
+  1. You may copy and distribute verbatim copies of the Program's source
+code as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+General Public License and to the absence of any warranty; and give any
+other recipients of the Program a copy of this General Public License
+along with the Program.  You may charge a fee for the physical act of
+transferring a copy.
+
+  2. You may modify your copy or copies of the Program or any portion of
+it, and copy and distribute such modifications under the terms of Paragraph
+1 above, provided that you also do the following:
+
+    a) cause the modified files to carry prominent notices stating that
+    you changed the files and the date of any change; and
+
+    b) cause the whole of any work that you distribute or publish, that
+    in whole or in part contains the Program or any part thereof, either
+    with or without modifications, to be licensed at no charge to all
+    third parties under the terms of this General Public License (except
+    that you may choose to grant warranty protection to some or all
+    third parties, at your option).
+
+    c) If the modified program normally reads commands interactively when
+    run, you must cause it, when started running for such interactive use
+    in the simplest and most usual way, to print or display an
+    announcement including an appropriate copyright notice and a notice
+    that there is no warranty (or else, saying that you provide a
+    warranty) and that users may redistribute the program under these
+    conditions, and telling the user how to view a copy of this General
+    Public License.
+
+    d) You may charge a fee for the physical act of transferring a
+    copy, and you may at your option offer warranty protection in
+    exchange for a fee.
+
+Mere aggregation of another independent work with the Program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other work under the scope of these terms.
+
+  3. You may copy and distribute the Program (or a portion or derivative of
+it, under Paragraph 2) in object code or executable form under the terms of
+Paragraphs 1 and 2 above provided that you also do one of the following:
+
+    a) accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    b) accompany it with a written offer, valid for at least three
+    years, to give any third party free (except for a nominal charge
+    for the cost of distribution) a complete machine-readable copy of the
+    corresponding source code, to be distributed under the terms of
+    Paragraphs 1 and 2 above; or,
+
+    c) accompany it with the information you received as to where the
+    corresponding source code may be obtained.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form alone.)
+
+Source code for a work means the preferred form of the work for making
+modifications to it.  For an executable file, complete source code means
+all the source code for all modules it contains; but, as a special
+exception, it need not include source code for modules which are standard
+libraries that accompany the operating system on which the executable
+file runs, or for standard header files or definitions files that
+accompany that operating system.
+
+  4. You may not copy, modify, sublicense, distribute or transfer the
+Program except as expressly provided under this General Public License.
+Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+the Program is void, and will automatically terminate your rights to use
+the Program under this License.  However, parties who have received
+copies, or rights to use copies, from you under this General Public
+License will not have their licenses terminated so long as such parties
+remain in full compliance.
+
+  5. By copying, distributing or modifying the Program (or any work based
+on the Program) you indicate your acceptance of this license to do so,
+and all its terms and conditions.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these
+terms and conditions.  You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein.
+
+  7. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of the license which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+the license, you may choose any version ever published by the Free Software
+Foundation.
+
+  8. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	Appendix: How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to humanity, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+  To do so, attach the following notices to the program.  It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) 19yy  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 1, or (at your option)
+    any later version.
+
+    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 the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) 19xx name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License.  Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the
+  program `Gnomovision' (a program to direct compilers to make passes
+  at assemblers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+That's all there is to it!
diff --git a/gnu/usr.bin/perl/EXTERN.h b/gnu/usr.bin/perl/EXTERN.h
new file mode 100644
index 00000000000..dedd37958c1
--- /dev/null
+++ b/gnu/usr.bin/perl/EXTERN.h
@@ -0,0 +1,29 @@
+/*    EXTERN.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * EXT  designates a global var which is defined in perl.h
+ * dEXT designates a global var which is defined in another
+ *      file, so we can't count on finding it in perl.h
+ *      (this practice should be avoided).
+ */
+#undef EXT
+#undef dEXT
+#if defined(VMS) && !defined(__GNUC__)
+#  define EXT globalref
+#  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#else
+#  define EXT extern
+#  define dEXT
+#endif
+
+#undef INIT
+#define INIT(x)
+
+#undef DOINIT
diff --git a/gnu/usr.bin/perl/INSTALL b/gnu/usr.bin/perl/INSTALL
new file mode 100644
index 00000000000..3274ddbb7e7
--- /dev/null
+++ b/gnu/usr.bin/perl/INSTALL
@@ -0,0 +1,743 @@
+=head1 NAME
+
+Install - Build and Installation guide for perl5.
+
+=head1 SYNOPSIS
+
+The basic steps to build and install perl5 are:
+
+	rm -f config.sh
+	sh Configure
+	make
+	make test
+	make install
+
+Each of these is explained in further detail below.
+
+You should probably at least skim through this entire document before
+proceeding.  Special notes specific to this release are identified
+by B<NOTE>.
+
+=head1 BUILDING PERL5
+
+=head1 Start with a Fresh Distribution.
+
+If you have built perl before, you should clean out the build directory
+with the command
+
+	make realclean
+	
+The results of a Configure run are stored in the config.sh file.  If
+you are upgrading from a previous version of perl, or if you change
+systems or compilers or make other significant changes, or if you are
+experiencing difficulties building perl, you should probably I<not>
+re-use your old config.sh.  Simply remove it or rename it, e.g.
+
+	mv config.sh config.sh.old
+
+Then run Configure.
+
+=head1 Run Configure.
+
+Configure will figure out various things about your system.  Some
+things Configure will figure out for itself, other things it will ask
+you about.  To accept the default, just press C<RETURN>.   The default
+is almost always ok.
+
+After it runs, Configure will perform variable substitution on all the
+F<*.SH> files and offer to run B<make depend>.
+
+Configure supports a number of useful options.  Run B<Configure -h>
+to get a listing.  To compile with gcc, for example, you can run
+
+	sh Configure -Dcc=gcc
+
+This is the preferred way to specify gcc (or another alternative
+compiler) so that the hints files can set appropriate defaults.
+
+If you want to use your old config.sh but override some of the items
+with command line options, you need to use B<Configure -O>.
+
+If you are willing to accept all the defaults, and you want terse
+output, you can run
+
+	sh Configure -des
+
+By default, for most systems, perl will be installed in
+/usr/local/{bin, lib, man}.  You can specify a different 'prefix' for
+the default installation directory, when Configure prompts you or by
+using the Configure command line option -Dprefix='/some/directory',
+e.g.
+
+	sh Configure -Dprefix=/opt/perl
+
+If your prefix contains the string "perl", then the directories
+are simplified.  For example, if you use prefix=/opt/perl,
+then Configure will suggest /opt/perl/lib instead of
+/usr/local/lib/perl5/.
+
+By default, Configure will compile perl to use dynamic loading, if
+your system supports it.  If you want to force perl to be compiled
+statically, you can either choose this when Configure prompts you or by
+using the Configure command line option -Uusedl.
+
+=head2 Extensions
+
+By default, Configure will offer to build every extension which appears
+to be supported.  For example, Configure will offer to build GDBM_File
+only if it is able to find the gdbm library.  (See examples below.)
+DynaLoader, Fcntl and FileHandle are always built by default.
+Configure does not contain code to test for POSIX compliance, so POSIX
+is always built by default as well.  If you wish to skip POSIX, you can
+set the Configure variable useposix=false either in a hint file or from
+the Configure command line.  Similarly, the Safe extension is always
+built by default, but you can skip it by setting the Configure variable
+usesafe=false either in a hint file for from the command line.
+
+In summary, here are the Configure command-line variables you can set
+to turn off each extension:
+
+    DB_File		i_db
+    DynaLoader		(Must always be included)
+    Fcntl		(Always included by default)
+    FileHandle		(Always included by default)
+    GDBM_File		i_gdbm
+    NDBM_File		i_ndbm
+    ODBM_File		i_dbm
+    POSIX		useposix
+    SDBM_File		(Always included by default)
+    Safe		usesafe
+    Socket		d_socket
+
+Thus to skip the NDBM_File extension, you can use
+
+	sh Configure -Ui_ndbm
+
+Again, this is taken care of automatically if you don't have the ndbm
+library.
+
+Of course, you may always run Configure interactively and select only
+the Extensions you want.
+
+Finally, if you have dynamic loading (most modern Unix systems do)
+remember that these extensions do not increase the size of your perl
+executable, nor do they impact start-up time, so you probably might as
+well build all the ones that will work on your system.
+
+=head2 GNU-style configure
+
+If you prefer the GNU-style B<configure> command line interface, you can
+use the supplied B<configure> command, e.g.
+
+	CC=gcc ./configure
+
+The B<configure> script emulates several of the more common configure
+options.  Try
+
+	./configure --help
+
+for a listing.
+
+Cross compiling is currently not supported.
+
+=head2 Including locally-installed libraries
+
+Perl5 comes with interfaces to number of database extensions, including
+dbm, ndbm, gdbm, and Berkeley db.  For each extension, if
+Configure can find the appropriate header files and libraries, it will
+automatically include that extension.  The gdbm and db libraries
+are B<not> included with perl.  See the library documentation for
+how to obtain the libraries.
+
+I<Note:>  If your database header (.h) files are not in a
+directory normally searched by your C compiler, then you will need to
+include the appropriate B<-I/your/directory> option when prompted by
+Configure.  If your database library (.a) files are not in a directory
+normally searched by your C compiler and linker, then you will need to
+include the appropriate B<-L/your/directory> option when prompted by
+Configure.  See the examples below.
+
+=head2 Examples
+
+=over 4
+
+=item gdbm in /usr/local.
+
+Suppose you have gdbm and want Configure to find it and build the
+GDBM_File extension.  This examples assumes you have F<gdbm.h>
+installed in F</usr/local/include/gdbm.h> and F<libgdbm.a> installed in
+F</usr/local/lib/libgdbm.a>.  Configure should figure all the
+necessary steps out automatically.
+
+Specifically, when Configure prompts you for flags for
+your C compiler, you should include  C<-I/usr/local/include>.
+
+When Configure prompts you for linker flags, you should include
+C<-L/usr/local/lib>.
+
+If you are using dynamic loading, then when Configure prompts you for
+linker flags for dynamic loading, you should again include
+C<-L/usr/local/lib>.
+
+Again, this should all happen automatically.  If you want to accept the
+defaults for all the questions and have Configure print out only terse
+messages, then you can just run
+
+	sh Configure -des
+
+and Configure should include the GDBM_File extension automatically.
+
+This should actually work if you have gdbm installed in any of
+(/usr/local, /opt/local, /usr/gnu, /opt/gnu, /usr/GNU, or /opt/GNU).
+
+=item gdbm in /usr/you
+
+Suppose you have gdbm installed in some place other than /usr/local/,
+but you still want Configure to find it.  To be specific, assume  you
+have F</usr/you/include/gdbm.h> and F</usr/you/lib/libgdbm.a>.  You
+still have to add B<-I/usr/you/include> to cc flags, but you have to take
+an extra step to help Configure find F<libgdbm.a>.  Specifically, when
+Configure prompts you for library directories, you have to add
+F</usr/you/lib> to the list.
+
+It is possible to specify this from the command line too (all on one
+line):
+
+	sh Configure -des \
+		-Dlocincpth="/usr/you/include" \
+		-Dloclibpth="/usr/you/lib"
+
+C<locincpth> is a space-separated list of include directories to search.
+Configure will automatically add the appropriate B<-I> directives.
+
+C<loclibpth> is a space-separated list of library directories to search.
+Configure will automatically add the appropriate B<-L> directives.  If
+you have some libraries under F</usr/local/> and others under
+F</usr/you>, then you have to include both, namely
+
+	sh Configure -des \
+		-Dlocincpth="/usr/you/include /usr/local/include" \
+		-Dloclibpth="/usr/you/lib /usr/local/lib"
+
+=back
+
+=head2 Installation Directories.
+
+The installation directories can all be changed by answering the
+appropriate questions in Configure.  For convenience, all the
+installation questions are near the beginning of Configure.
+
+By default, Configure uses the following directories for
+library files  (archname is a string like sun4-sunos, determined
+by Configure)
+
+	/usr/local/lib/perl5/archname/5.002
+	/usr/local/lib/perl5/
+	/usr/local/lib/perl5/site_perl/archname
+	/usr/local/lib/perl5/site_perl
+
+and the following directories for manual pages:
+
+	/usr/local/man/man1
+	/usr/local/lib/perl5/man/man3
+
+(Actually, Configure recognizes the SVR3-style
+/usr/local/man/l_man/man1 directories, if present, and uses those
+instead.) The module man pages are stuck in that strange spot so that
+they don't collide with other man pages stored in /usr/local/man/man3,
+and so that Perl's man pages don't hide system man pages.  On some
+systems, B<man less> would end up calling up Perl's less.pm module man
+page, rather than the B<less> program.
+
+If you specify a prefix that contains the string "perl", then the
+directory structure is simplified.  For example, if you Configure
+with -Dprefix=/opt/perl, then the defaults are
+
+	/opt/perl/lib/archname/5.002
+	/opt/perl/lib
+	/opt/perl/lib/site_perl/archname
+	/opt/perl/lib/site_perl
+
+	/opt/perl/man/man1
+	/opt/perl/man/man3
+
+The perl executable will search the libraries in the order given
+above.
+
+The  directories site_perl and site_perl/archname are empty, but are
+intended to be used for installing local or site-wide extensions.  Perl
+will automatically look in these directories.  Previously, most sites
+just put their local extensions in with the standard distribution.
+
+In order to support using things like #!/usr/local/bin/perl5.002 after
+a later version is released, architecture-dependent libraries are
+stored in a version-specific directory, such as
+/usr/local/lib/perl5/archname/5.002/.  In 5.000 and 5.001, these files
+were just stored in /usr/local/lib/perl5/archname/.  If you will not be
+using 5.001 binaries, you can delete the standard extensions from the
+/usr/local/lib/perl5/archname/ directory.  Locally-added extensions can
+be moved to the site_perl and site_perl/archname directories.
+
+Again, these are just the defaults, and can be changed as you run
+Configure.
+
+=head2 Changing the installation directory
+
+Configure distinguishes between the directory in which perl (and its
+associated files) should be installed and the directory in which it
+will eventually reside.  For most sites, these two are the same; for
+sites that use AFS, this distinction is handled automatically.
+However, sites that use software such as B<depot> to manage software
+packages may also wish to install perl into a different directory and
+use that management software to move perl to its final destination.
+This section describes how to do this.  Someday, Configure may support
+an option C<-Dinstallprefix=/foo> to simplify this.
+
+Suppose you want to install perl under the F</tmp/perl5> directory.
+You can edit F<config.sh> and change all the install* variables to
+point to F</tmp/perl5> instead of F</usr/local/wherever>.  You could
+also set them all from the Configure command line.  Or, you can
+automate this process by placing the following lines in a file
+F<config.over> B<before> you run Configure (replace /tmp/perl5 by a
+directory of your choice):
+
+    installprefix=/tmp/perl5
+    test -d $installprefix || mkdir $installprefix
+    test -d $installprefix/bin || mkdir $installprefix/bin
+    installarchlib=`echo $installarchlib | sed "s!$prefix!$installprefix!"`
+    installbin=`echo $installbin | sed "s!$prefix!$installprefix!"`
+    installman1dir=`echo $installman1dir | sed "s!$prefix!$installprefix!"`
+    installman3dir=`echo $installman3dir | sed "s!$prefix!$installprefix!"`
+    installprivlib=`echo $installprivlib | sed "s!$prefix!$installprefix!"`
+    installscript=`echo $installscript | sed "s!$prefix!$installprefix!"`
+    installsitelib=`echo $installsitelib | sed "s!$prefix!$installprefix!"`
+    installsitearch=`echo $installsitearch | sed "s!$prefix!$installprefix!"`
+    shrpdir=`echo $shrpdir | sed "s!$prefix!$installprefix!"`
+
+Then, you can Configure and install in the usual way:
+
+    sh Configure -des
+    make
+    make test
+    make install
+
+=head2 Creating an installable tar archive
+
+If you need to install perl on many identical systems, it is
+convenient to compile it once and create an archive that can be
+installed on multiple systems.  Here's one way to do that:
+
+    # Set up config.over to install perl into a different directory,
+    # e.g. /tmp/perl5 (see previous part).
+    sh Configure -des
+    make
+    make test
+    make install
+    cd /tmp/perl5
+    tar cvf ../perl5-archive.tar .
+    # Then, on each machine where you want to install perl,
+    cd /usr/local  # Or wherever you specified as $prefix
+    tar xvf perl5-archive.tar
+
+=head2 What if it doesn't work?
+
+=over 4
+
+=item Running Configure Interactively
+
+If Configure runs into trouble, remember that you can always run
+Configure interactively so that you can check (and correct) its
+guesses.
+
+All the installation questions have been moved to the top, so you don't
+have to wait for them.  Once you've handled them (and your C compiler &
+flags) you can type   '&-d'  at the next Configure prompt and Configure
+will use the defaults from then on.
+
+If you find yourself trying obscure command line incantations and
+config.over tricks, I recommend you run Configure interactively
+instead.  You'll probably save yourself time in the long run.
+
+=item Hint files.
+
+The perl distribution includes a number of system-specific hints files
+in the hints/ directory.  If one of them matches your system, Configure
+will offer to use that hint file.
+
+Several of the hint files contain additional important information.
+If you have any problems, it is a good idea to read the relevant hint
+file for further information.  See F<hints/solaris_2.sh> for an
+extensive example.
+
+=item *** WHOA THERE!!! ***
+
+Occasionally, Configure makes a wrong guess.  For example, on SunOS
+4.1.3, Configure incorrectly concludes that tzname[] is in the
+standard C library.  The hint file is set up to correct for this.  You
+will see a message:
+
+    *** WHOA THERE!!! ***
+	The recommended value for $d_tzname on this machine was "undef"!
+	Keep the recommended value? [y]
+
+You should always keep the recommended value unless, after reading the
+relevant section of the hint file, you are sure you want to try
+overriding it.
+
+If you are re-using an old config.sh, the word "previous" will be
+used instead of "recommended".  Again, you will almost always want
+to keep the previous value, unless you have changed something on your
+system.
+
+For example, suppose you have added libgdbm.a to your system
+and you decide to reconfigure perl to use GDBM_File.  When you run
+Configure again, you will need to add -lgdbm to the list of libraries.
+Now, Configure will find your gdbm library and will issue a message:
+
+    *** WHOA THERE!!! ***
+	The previous value for $i_gdbm on this machine was "undef"!
+	Keep the previous value? [y]
+
+In this case, you do I<not> want to keep the previous value, so you
+should answer 'n'.  (You'll also have to manuually add GDBM_File to
+the list of dynamic extensions to build.)
+
+=item Changing Compilers
+
+If you change compilers or make other significant changes, you should
+probably I<not> re-use your old config.sh.  Simply remove it or
+rename it, e.g. mv config.sh config.sh.old.  Then rerun Configure
+with the options you want to use.
+
+This is a common source of problems.  If you change from B<cc> to
+B<gcc>, you should almost always remove your old config.sh.
+
+=item Propagating your changes
+
+If you later make any changes to F<config.sh>, you should propagate
+them to all the .SH files by running  B<sh Configure -S>.
+
+=item config.over
+
+You can also supply a shell script config.over to over-ride Configure's
+guesses.  It will get loaded up at the very end, just before config.sh
+is created.  You have to be careful with this, however, as Configure
+does no checking that your changes make sense.  See the section on
+changing the installation directory for an example.
+
+=item config.h
+
+Many of the system dependencies are contained in F<config.h>.
+F<Configure> builds F<config.h> by running the F<config_h.SH> script.
+The values for the variables are taken from F<config.sh>.
+
+If there are any problems, you can edit F<config.h> directly.  Beware,
+though, that the next time you run B<Configure>, your changes will be
+lost.
+
+=item cflags
+
+If you have any additional changes to make to the C compiler command
+line, they can be made in F<cflags.SH>.  For instance, to turn off the
+optimizer on F<toke.c>, find the line in the switch structure for
+F<toke.c> and put the command C<optimize='-g'> before the C<;;>.  You
+can also edit F<cflags> directly, but beware that your changes will be
+lost the next time you run B<Configure>.
+
+To change the C flags for all the files, edit F<config.sh>
+and change either C<$ccflags> or C<$optimize>,
+and then re-run  B<sh Configure -S ; make depend>.
+
+=item No sh.
+
+If you don't have sh, you'll have to copy the sample file config_H to
+config.h and edit the config.h to reflect your system's peculiarities.
+You'll probably also have to extensively modify the extension building
+mechanism.
+
+=back
+
+=head1 make depend
+
+This will look for all the includes.
+The output is stored in F<makefile>.  The only difference between
+F<Makefile> and F<makefile> is the dependencies at the bottom of
+F<makefile>.  If you have to make any changes, you should edit
+F<makefile>, not F<Makefile> since the Unix B<make> command reads
+F<makefile> first.
+
+Configure will offer to do this step for you, so it isn't listed
+explicitly above.
+
+=head1 make
+
+This will attempt to make perl in the current directory.
+
+If you can't compile successfully, try some of the following ideas.
+
+=over 4
+
+=item *
+
+If you used a hint file, try reading the comments in the hint file
+for further tips and information.
+
+=item *
+
+If you can't compile successfully, try adding a C<-DCRIPPLED_CC> flag.
+(Just because you get no errors doesn't mean it compiled right!)
+This simplifies some complicated expressions for compilers that
+get indigestion easily.  If that has no effect, try turning off
+optimization.  If you have missing routines, you probably need to
+add some library or other, or you need to undefine some feature that
+Configure thought was there but is defective or incomplete.
+
+=item *
+
+Some compilers will not compile or optimize the larger files without
+some extra switches to use larger jump offsets or allocate larger
+internal tables.  You can customize the switches for each file in
+F<cflags>.  It's okay to insert rules for specific files into
+F<makefile> since a default rule only takes effect in the absence of a
+specific rule.
+
+=item *
+
+If you can successfully build F<miniperl>, but the process crashes
+during the building of extensions, you should run
+
+    	make minitest
+
+to test your version of miniperl.
+
+=item *
+
+Some additional things that have been reported for either perl4 or perl5:
+
+Genix may need to use libc rather than libc_s, or #undef VARARGS.
+
+NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR.
+
+UTS may need one or more of B<-DCRIPPLED_CC>, B<-K> or B<-g>, and undef LSTAT.
+
+If you get syntax errors on '(', try -DCRIPPLED_CC.
+
+Machines with half-implemented dbm routines will need to #undef I_ODBM
+
+SCO prior to 3.2.4 may be missing dbmclose().  An upgrade to 3.2.4
+that includes libdbm.nfs (which includes dbmclose()) may be available.
+
+If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC.
+
+If you get duplicate function definitions (a perl function has the
+same name as another function on your system) try -DEMBED.
+
+If you get varags problems with gcc, be sure that gcc is installed
+correctly.  When using gcc, you should probably have i_stdarg='define'
+and i_varags='undef' in config.sh.  The problem is usually solved
+by running fixincludes correctly.
+
+If you have problems with dynamic loading using gcc on SunOS or
+Solaris, and you are using GNU as and GNU ld, you may need to add
+B<-B/bin/> (for SunOS) or B<-B/usr/ccs/bin> (for Solaris) to your
+$ccflags, $ldflags, and $lddlflags so that the system's versions of as
+and ld are used.
+
+If you run into dynamic loading problems, check your setting of
+the LD_LIBRARY_PATH environment variable.  Perl should build
+fine with LD_LIBRARY_PATH unset, though that may depend on details
+of your local set-up.
+
+If Configure seems to be having trouble finding library functions,
+try not using nm extraction.  You can do this from the command line
+with
+
+	sh Configure -Uusenm
+
+=back
+
+=head1 make test
+
+This will run the regression tests on the perl you just made.  If it
+doesn't say "All tests successful" then something went wrong.  See the
+file F<t/README> in the F<t> subdirectory.  Note that you can't run it
+in background if this disables opening of /dev/tty.  If B<make test>
+bombs out, just B<cd> to the F<t> directory and run B<TEST> by hand
+to see if it makes any difference.
+If individual tests bomb, you can run them by hand, e.g.,
+
+	./perl op/groups.t
+
+B<Note>: one possible reason for errors is that some external programs
+may be broken due to the combination of your environment and the way
+C<make test> exercises them. This may happen for example if you have
+one or more of these environment variables set:
+C<LC_ALL LC_CTYPE LANG>. In certain UNIXes especially the non-English
+locales are known to cause programs to exhibit mysterious errors.
+If you have any of the above environment variables set, please try
+C<setenv LC_ALL C> or <LC_ALL=C;export LC_ALL>, for C<csh>-style and
+C<Bourne>-style shells, respectively, from the command line and then
+retry C<make test>. If the tests then succeed, you may have a broken
+program that is confusing the testing. Please run the troublesome test
+by hand as shown above and see whether you can locate the program.
+Look for things like:
+C<exec, `backquoted command`, system, open("|...")> or C<open("...|")>.
+All these mean that Perl is trying to run some external program.
+=head1 INSTALLING PERL5
+
+=head1 make install
+
+This will put perl into the public directory you specified to
+B<Configure>; by default this is F</usr/local/bin>.  It will also try
+to put the man pages in a reasonable place.  It will not nroff the man
+page, however.  You may need to be root to run B<make install>.  If you
+are not root, you must own the directories in question and you should
+ignore any messages about chown not working.
+
+B<NOTE:>  In the 5.002 release, you will see some harmless error
+messages and warnings from pod2man.  You may safely ignore them.  (Yes,
+they should be fixed, but they didn't seem important enough to warrant
+holding up the entire 5.002 release.)
+
+If you want to see exactly what will happen without installing
+anything, you can run
+
+	./perl installperl -n
+	./perl installman -n
+
+B<make install> will install the following:
+
+	perl,
+	    perl5.nnn	where nnn is the current release number.  This
+			will be a link to perl.
+	suidperl,
+	    sperl5.nnn	If you requested setuid emulation.
+	a2p          	awk-to-perl translator
+	cppstdin	This is used by perl -P, if your cc -E can't
+			read from stdin.
+	c2ph, pstruct	Scripts for handling C structures in header files.
+	s2p		sed-to-perl translator
+	find2perl	find-to-perl translator
+	h2xs		Converts C .h header files to Perl extensions.
+	perlbug		Tool to report bugs in Perl.
+	perldoc		Tool to read perl's pod documentation.
+	pod2html,	Converters from perl's pod documentation format
+	pod2latex, and 	to other useful formats.
+	pod2man
+
+	library files	in $privlib and $archlib specified to
+			Configure, usually under /usr/local/lib/perl5/.
+	man pages	in the location specified to Configure, usually
+			something like /usr/local/man/man1.
+	module		in the location specified to Configure, usually
+	man pages	under /usr/local/lib/perl5/man/man3.
+	pod/*.pod	in $privlib/pod/.
+
+Installperl will also create the library directories $siteperl and
+$sitearch listed in config.sh.  Usually, these are something like
+	/usr/local/lib/perl5/site_perl/
+	/usr/local/lib/perl5/site_perl/$archname
+where $archname is something like sun4-sunos.  These directories
+will be used for installing extensions.
+
+Perl's *.h header files and the libperl.a library are also
+installed under $archlib so that any user may later build new
+extensions even if the Perl source is no longer available.
+
+The libperl.a library is only needed for building new
+extensions and linking them statically into a new perl executable.
+If you will not be doing that, then you may safely delete
+$archlib/libperl.a after perl is installed.
+
+make install may also offer to install perl in a "standard" location.
+
+Most of the documentation in the pod/ directory is also available
+in HTML and LaTeX format.  Type
+
+	cd pod; make html; cd ..
+
+to generate the html versions, and
+
+	cd pod; make tex; cd ..
+
+to generate the LaTeX versions.
+
+=head1 Coexistence with earlier versions of perl5.
+
+You can safely install the current version of perl5 and still run
+scripts under the old binaries.  Instead of starting your script with
+#!/usr/local/bin/perl, just start it with #!/usr/local/bin/perl5.001
+(or whatever version you want to run.)
+
+The architecture-dependent files are stored in a version-specific
+directory (such as F</usr/local/lib/perl5/sun4-sunos/5.002>) so that
+they are still accessible.  I<Note:> perl5.000 and perl5.001 did not
+put their architecture-dependent libraries in a version-specific
+directory.  They are simply in F</usr/local/lib/perl5/$archname>.  If
+you will not be using 5.000 or 5.001, you may safely remove those
+files.
+
+The standard library files in F</usr/local/lib/perl5>
+should be useable by all versions of perl5.
+
+Most extensions will probably not need to be recompiled to use with a newer
+version of perl.  If you do run into problems, and you want to continue
+to use the old version of perl along with your extension, simply move
+those extension files to the appropriate version directory, such as
+F</usr/local/lib/perl/archname/5.002>.  Then perl5.002 will find your
+files in the 5.002 directory, and newer versions of perl will find your
+newer extension in the site_perl directory.
+
+Some users may prefer to keep all versions of perl in completely
+separate directories.  One convenient way to do this is by
+using a separate prefix for each version, such as
+
+	sh Configure -Dprefix=/opt/perl5.002
+
+and adding /opt/perl5.002/bin to the shell PATH variable.  Such users
+may also wish to add a symbolic link /usr/local/bin/perl so that
+scripts can still start with #!/usr/local/bin/perl.
+
+B<NOTE>: Starting with 5.002_01, all functions in the perl C source
+code are protected by default by the prefix Perl_ (or perl_) so that
+you may link with third-party libraries without fear of namespace
+collisons.  This breaks compatability with the initially released
+version of 5.002, so once you install 5.002_01 (or higher) you will
+need to re-build and install all of your dynamically loadable
+extensions.  (The standard extensions supplied with Perl are handled
+automatically).  You can turn off this namespace protection by adding
+-DNO_EMBED to your ccflags variable in config.sh.  This is a one-time
+change.  In the future, we certainly hope that most extensions won't
+need to be recompiled for use with a newer version of perl.
+
+=head1 Coexistence with perl4
+
+You can safely install perl5 even if you want to keep perl4 around.
+
+By default, the perl5 libraries go into F</usr/local/lib/perl5/>, so
+they don't override the perl4 libraries in F</usr/local/lib/perl/>.
+
+In your /usr/local/bin directory, you should have a binary named
+F<perl4.036>.  That will not be touched by the perl5 installation
+process.  Most perl4 scripts should run just fine under perl5.
+However, if you have any scripts that require perl4, you can replace
+the C<#!> line at the top of them by C<#!/usr/local/bin/perl4.036>
+(or whatever the appropriate pathname is).  See pod/perltrap.pod
+for possible problems running perl4 scripts under perl5.
+
+=head1 DOCUMENTATION
+
+Read the manual entries before running perl.  The main documentation is
+in the pod/ subdirectory and should have been installed during the
+build process.  Type B<man perl> to get started.  Alternatively, you
+can type B<perldoc perl> to use the supplied B<perldoc> script.  This
+is sometimes useful for finding things in the library modules.
+
+=head1 AUTHOR
+
+Andy Dougherty <doughera@lafcol.lafayette.edu>, borrowing I<very> heavily
+from the original README by Larry Wall.
+
+=head1 LAST MODIFIED
+
+19 March 1996
diff --git a/gnu/usr.bin/perl/INTERN.h b/gnu/usr.bin/perl/INTERN.h
new file mode 100644
index 00000000000..d89d2e68a44
--- /dev/null
+++ b/gnu/usr.bin/perl/INTERN.h
@@ -0,0 +1,29 @@
+/*    INTERN.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * EXT  designates a global var which is defined in perl.h
+ * dEXT designates a global var which is defined in another
+ *      file, so we can't count on finding it in perl.h
+ *      (this practice should be avoided).
+ */
+#undef EXT
+#undef dEXT
+#if defined(VMS) && !defined(__GNUC__)
+#  define EXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#  define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare
+#else
+#  define EXT
+#  define dEXT
+#endif
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT
diff --git a/gnu/usr.bin/perl/MANIFEST b/gnu/usr.bin/perl/MANIFEST
new file mode 100644
index 00000000000..e493f4e7c76
--- /dev/null
+++ b/gnu/usr.bin/perl/MANIFEST
@@ -0,0 +1,600 @@
+Artistic		The "Artistic License"
+Changes			Differences from previous versions.
+Changes.Conf		Recent changes in the Configure & build process
+configure		Crude emulation of GNU configure
+Configure		Portability tool
+Copying			The GNU General Public License
+EXTERN.h		Included before foreign .h files
+INSTALL			Detailed installation instructions.
+INTERN.h		Included before domestic .h files
+MANIFEST		This list of files
+Makefile.SH		A script that generates Makefile
+README			The Instructions
+README.vms		Notes about VMS
+Todo			The Wishlist
+XSUB.h			Include file for extension subroutines
+av.c			Array value code
+av.h			Array value header
+cflags.SH		A script that emits C compilation flags per file
+config_H		Sample config.h
+config_h.SH		Produces config.h
+configpm		Produces lib/Config.pm
+cop.h			Control operator header
+cv.h			Code value header
+deb.c			Debugging routines
+doio.c			I/O operations
+doop.c			Support code for various operations
+dosish.h		Some defines for MS/DOSish machines
+dump.c			Debugging output
+eg/ADB			An adb wrapper to put in your crash dir
+eg/README		Intro to example perl scripts
+eg/changes		A program to list recently changed files
+eg/client		A sample client
+eg/down			A program to do things to subdirectories
+eg/dus			A program to do du -s on non-mounted dirs
+eg/findcp		A find wrapper that implements a -cp switch
+eg/findtar		A find wrapper that pumps out a tar file
+eg/g/gcp		A program to do a global rcp
+eg/g/gcp.man		Manual page for gcp
+eg/g/ged		A program to do a global edit
+eg/g/ghosts		A sample /etc/ghosts file
+eg/g/gsh		A program to do a global rsh
+eg/g/gsh.man		Manual page for gsh
+eg/muck			A program to find missing make dependencies
+eg/muck.man		Manual page for muck
+eg/myrup		A program to find lightly loaded machines
+eg/nih			Script to insert #! workaround
+eg/relink		A program to change symbolic links
+eg/rename		A program to rename files
+eg/rmfrom		A program to feed doomed filenames to
+eg/scan/scan_df		Scan for filesystem anomalies
+eg/scan/scan_last	Scan for login anomalies
+eg/scan/scan_messages	Scan for console message anomalies
+eg/scan/scan_passwd	Scan for passwd file anomalies
+eg/scan/scan_ps		Scan for process anomalies
+eg/scan/scan_sudo	Scan for sudo anomalies
+eg/scan/scan_suid	Scan for setuid anomalies
+eg/scan/scanner		An anomaly reporter
+eg/server		A sample server
+eg/shmkill		A program to remove unused shared memory
+eg/sysvipc/README	Intro to Sys V IPC examples
+eg/sysvipc/ipcmsg	Example of SYS V IPC message queues
+eg/sysvipc/ipcsem	Example of Sys V IPC semaphores
+eg/sysvipc/ipcshm	Example of Sys V IPC shared memory
+eg/travesty		A program to print travesties of its input text
+eg/unuc			Un-uppercases an all-uppercase text
+eg/uudecode		A version of uudecode
+eg/van/empty		A program to empty the trashcan
+eg/van/unvanish		A program to undo what vanish does
+eg/van/vanexp		A program to expire vanished files
+eg/van/vanish		A program to put files in a trashcan
+eg/who			A sample who program
+eg/wrapsuid		A setuid script wrapper generator
+emacs/cperl-mode.el	An alternate perl-mode
+embed.h			Maps symbols to safer names
+embed.pl		Produces embed.h
+ext/DB_File/DB_File.pm		Berkeley DB extension Perl module
+ext/DB_File/DB_File.xs		Berkeley DB extension external subroutines
+ext/DB_File/DB_File_BS		Berkeley DB extension mkbootstrap fodder
+ext/DB_File/Makefile.PL		Berkeley DB extension makefile writer
+ext/DB_File/typemap		Berkeley DB extension interface types
+ext/DynaLoader/DynaLoader.pm	Dynamic Loader perl module
+ext/DynaLoader/Makefile.PL	Dynamic Loader makefile writer
+ext/DynaLoader/README		Dynamic Loader notes and intro
+ext/DynaLoader/dl_aix.xs	AIX implementation
+ext/DynaLoader/dl_dld.xs	GNU dld style implementation
+ext/DynaLoader/dl_dlopen.xs	BSD/SunOS4&5 dlopen() style implementation
+ext/DynaLoader/dl_hpux.xs	HP-UX implementation
+ext/DynaLoader/dl_next.xs	Next implementation
+ext/DynaLoader/dl_none.xs	Stub implementation
+ext/DynaLoader/dl_os2.xs	OS/2 implementation
+ext/DynaLoader/dl_vms.xs	VMS implementation
+ext/DynaLoader/dlutils.c	Dynamic loader utilities for dl_*.xs files
+ext/Fcntl/Fcntl.pm		Fcntl extension Perl module
+ext/Fcntl/Fcntl.xs		Fcntl extension external subroutines
+ext/Fcntl/Makefile.PL		Fcntl extension makefile writer
+ext/FileHandle/FileHandle.pm	FileHandle extension Perl module
+ext/FileHandle/FileHandle.xs	FileHandle extension external subroutines
+ext/FileHandle/Makefile.PL	FileHandle extension makefile writer
+ext/GDBM_File/GDBM_File.pm	GDBM extension Perl module
+ext/GDBM_File/GDBM_File.xs	GDBM extension external subroutines
+ext/GDBM_File/Makefile.PL	GDBM extension makefile writer
+ext/GDBM_File/typemap		GDBM extension interface types
+ext/NDBM_File/Makefile.PL	NDBM extension makefile writer
+ext/NDBM_File/NDBM_File.pm	NDBM extension Perl module
+ext/NDBM_File/NDBM_File.xs	NDBM extension external subroutines
+ext/NDBM_File/hints/solaris.pl	Hint for NDBM_File for named architecture
+ext/NDBM_File/hints/svr4.pl	Hint for NDBM_File for named architecture
+ext/NDBM_File/typemap		NDBM extension interface types
+ext/ODBM_File/Makefile.PL	ODBM extension makefile writer
+ext/ODBM_File/ODBM_File.pm	ODBM extension Perl module
+ext/ODBM_File/ODBM_File.xs	ODBM extension external subroutines
+ext/ODBM_File/hints/dec_osf.pl	Hint for ODBM_File for named architecture
+ext/ODBM_File/hints/sco.pl	Hint for ODBM_File for named architecture
+ext/ODBM_File/hints/solaris.pl	Hint for ODBM_File for named architecture
+ext/ODBM_File/hints/svr4.pl	Hint for ODBM_File for named architecture
+ext/ODBM_File/typemap		ODBM extension interface types
+ext/POSIX/Makefile.PL		POSIX extension makefile writer
+ext/POSIX/POSIX.pm		POSIX extension Perl module
+ext/POSIX/POSIX.pod		POSIX extension documentation
+ext/POSIX/POSIX.xs		POSIX extension external subroutines
+ext/POSIX/typemap		POSIX extension interface types
+ext/SDBM_File/Makefile.PL	SDBM extension makefile writer
+ext/SDBM_File/SDBM_File.pm	SDBM extension Perl module
+ext/SDBM_File/SDBM_File.xs	SDBM extension external subroutines
+ext/SDBM_File/sdbm/CHANGES		SDBM kit
+ext/SDBM_File/sdbm/COMPARE		SDBM kit
+ext/SDBM_File/sdbm/Makefile.PL		SDBM kit
+ext/SDBM_File/sdbm/README		SDBM kit
+ext/SDBM_File/sdbm/README.too		SDBM kit
+ext/SDBM_File/sdbm/biblio		SDBM kit
+ext/SDBM_File/sdbm/dba.c		SDBM kit
+ext/SDBM_File/sdbm/dbd.c		SDBM kit
+ext/SDBM_File/sdbm/dbe.1		SDBM kit
+ext/SDBM_File/sdbm/dbe.c		SDBM kit
+ext/SDBM_File/sdbm/dbm.c		SDBM kit
+ext/SDBM_File/sdbm/dbm.h		SDBM kit
+ext/SDBM_File/sdbm/dbu.c		SDBM kit
+ext/SDBM_File/sdbm/grind		SDBM kit
+ext/SDBM_File/sdbm/hash.c		SDBM kit
+ext/SDBM_File/sdbm/linux.patches	SDBM kit
+ext/SDBM_File/sdbm/makefile.sdbm	SDBM kit
+ext/SDBM_File/sdbm/pair.c		SDBM kit
+ext/SDBM_File/sdbm/pair.h		SDBM kit
+ext/SDBM_File/sdbm/readme.ms		SDBM kit
+ext/SDBM_File/sdbm/readme.ps		SDBM kit
+ext/SDBM_File/sdbm/sdbm.3		SDBM kit
+ext/SDBM_File/sdbm/sdbm.c		SDBM kit
+ext/SDBM_File/sdbm/sdbm.h		SDBM kit
+ext/SDBM_File/sdbm/tune.h		SDBM kit
+ext/SDBM_File/sdbm/util.c		SDBM kit
+ext/SDBM_File/typemap		SDBM extension interface types
+ext/Safe/Makefile.PL		Safe extension makefile writer
+ext/Safe/Safe.pm		Safe extension Perl module
+ext/Safe/Safe.xs		Safe extension external subroutines
+ext/Socket/Makefile.PL	Socket extension makefile writer
+ext/Socket/Socket.pm	Socket extension Perl module
+ext/Socket/Socket.xs	Socket extension external subroutines
+ext/util/extliblist	Used by extension Makefile.PL to make lib lists
+ext/util/make_ext	Used by Makefile to execute extension Makefiles
+ext/util/mkbootstrap	Turns ext/*/*_BS into bootstrap info
+form.h			Public declarations for the above
+global.sym		Symbols that need hiding when embedded
+globals.c		File to declare global symbols (for shared library)
+gv.c			Glob value code
+gv.h			Glob value header
+h2pl/README		How to turn .ph files into .pl files
+h2pl/cbreak.pl		cbreak routines using .ph
+h2pl/cbreak2.pl		cbreak routines using .pl
+h2pl/eg/sizeof.ph	Sample sizeof array initialization
+h2pl/eg/sys/errno.pl	Sample translated errno.pl
+h2pl/eg/sys/ioctl.pl	Sample translated ioctl.pl
+h2pl/eg/sysexits.pl	Sample translated sysexits.pl
+h2pl/getioctlsizes	Program to extract types from ioctl.h
+h2pl/mksizes		Program to make %sizeof array
+h2pl/mkvars		Program to make .pl from .ph files
+h2pl/tcbreak		cbreak test routine using .ph
+h2pl/tcbreak2		cbreak test routine using .pl
+handy.h			Handy definitions
+hints/3b1.sh		Hints for named architecture
+hints/3b1cc		Hints for named architecture
+hints/README.hints	Notes about hints.
+hints/aix.sh		Hints for named architecture
+hints/altos486.sh	Hints for named architecture
+hints/apollo.sh		Hints for named architecture
+hints/aux.sh		Hints for named architecture
+hints/bsdos.sh		Hints for named architecture
+hints/convexos.sh	Hints for named architecture
+hints/cxux.sh		Hints for named architecture
+hints/dec_osf.sh	Hints for named architecture
+hints/dgux.sh		Hints for named architecture
+hints/dnix.sh		Hints for named architecture
+hints/dynix.sh		Hints for named architecture
+hints/dynixptx.sh	Hints for named architecture
+hints/epix.sh		Hints for named architecture
+hints/esix4.sh		Hints for named architecture
+hints/fps.sh		Hints for named architecture
+hints/freebsd.sh	Hints for named architecture
+hints/genix.sh		Hints for named architecture
+hints/greenhills.sh	Hints for named architecture
+hints/hpux.sh		Hints for named architecture
+hints/i386.sh		Hints for named architecture
+hints/irix_4.sh		Hints for named architecture
+hints/irix_5.sh		Hints for named architecture
+hints/irix_6.sh		Hints for named architecture
+hints/irix_6_2.sh	Hints for named architecture
+hints/isc.sh		Hints for named architecture
+hints/isc_2.sh		Hints for named architecture
+hints/linux.sh		Hints for named architecture
+hints/machten.sh	Hints for named architecture
+hints/machten_2.sh	Hints for named architecture
+hints/mips.sh		Hints for named architecture
+hints/mpc.sh		Hints for named architecture
+hints/mpeix.sh		Hints for named architecture
+hints/ncr_tower.sh	Hints for named architecture
+hints/netbsd.sh		Hints for named architecture
+hints/next_3.sh		Hints for named architecture
+hints/next_3_0.sh	Hints for named architecture
+hints/opus.sh		Hints for named architecture
+hints/os2.sh		Hints for named architecture
+hints/powerux.sh	Hints for named architecture
+hints/sco.sh		Hints for named architecture
+hints/sco_2_3_0.sh	Hints for named architecture
+hints/sco_2_3_1.sh	Hints for named architecture
+hints/sco_2_3_2.sh	Hints for named architecture
+hints/sco_2_3_3.sh	Hints for named architecture
+hints/sco_2_3_4.sh	Hints for named architecture
+hints/solaris_2.sh	Hints for named architecture
+hints/stellar.sh	Hints for named architecture
+hints/sunos_4_0.sh	Hints for named architecture
+hints/sunos_4_1.sh	Hints for named architecture
+hints/svr4.sh		Hints for named architecture
+hints/ti1500.sh		Hints for named architecture
+hints/titanos.sh	Hints for named architecture
+hints/ultrix_4.sh	Hints for named architecture
+hints/unicos.sh		Hints for named architecture
+hints/unisysdynix.sh	Hints for named architecture
+hints/utekv.sh		Hints for named architecture
+hints/uts.sh		Hints for named architecture
+hv.c			Hash value code
+hv.h			Hash value header
+installman		Perl script to install man pages for pods.
+installperl		Perl script to do "make install" dirty work
+interp.sym		Interpreter specific symbols to hide in a struct
+keywords.h		The keyword numbers
+keywords.pl		Program to write keywords.h
+lib/AnyDBM_File.pm	Perl module to emulate dbmopen
+lib/AutoLoader.pm	Autoloader base class
+lib/AutoSplit.pm	A module to split up autoload functions
+lib/Benchmark.pm	A module to time pieces of code and such
+lib/Carp.pm		Error message base class
+lib/Cwd.pm		Various cwd routines (getcwd, fastcwd, chdir)
+lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
+lib/DirHandle.pm	like FileHandle only for directories
+lib/English.pm		Readable aliases for short variables
+lib/Env.pm		Map environment into ordinary variables
+lib/Exporter.pm		Exporter base class
+lib/ExtUtils/Install.pm	Handles 'make install' on extensions
+lib/ExtUtils/Liblist.pm	Locates libraries
+lib/ExtUtils/MM_OS2.pm		MakeMaker methods for OS/2
+lib/ExtUtils/MM_Unix.pm		MakeMaker base class for Unix
+lib/ExtUtils/MM_VMS.pm		MakeMaker methods for VMS.
+lib/ExtUtils/MakeMaker.pm	Write Makefiles for extensions
+lib/ExtUtils/Manifest.pm	Utilities to write MANIFEST files
+lib/ExtUtils/Mkbootstrap.pm	Writes a bootstrap file (see MakeMaker)
+lib/ExtUtils/Mksymlists.pm	Writes a linker options file for extensions
+lib/ExtUtils/testlib.pm	Fixes up @INC to use just-built extension
+lib/ExtUtils/typemap		Extension interface types
+lib/ExtUtils/xsubpp		External subroutine preprocessor
+lib/File/Basename.pm	A module to emulate the basename program
+lib/File/CheckTree.pm	Perl module supporting wholesale file mode validation
+lib/File/Copy.pm	Emulation of cp command
+lib/File/Find.pm	Routines to do a find
+lib/File/Path.pm	A module to do things like `mkdir -p' and `rm -r'
+lib/FileCache.pm	Keep more files open than the system permits
+lib/Getopt/Long.pm	A module to fetch command options (GetOptions)
+lib/Getopt/Std.pm	A module to fetch command options (getopt, getopts)
+lib/I18N/Collate.pm	Routines to do strxfrm-based collation
+lib/IPC/Open2.pm	Open a two-ended pipe
+lib/IPC/Open3.pm	Open a three-ended pipe!
+lib/Math/BigFloat.pm	An arbitrary precision floating-point arithmetic package
+lib/Math/BigInt.pm	An arbitrary precision integer arithmetic package
+lib/Math/Complex.pm	A Complex package
+lib/Net/Ping.pm		Ping methods
+lib/Pod/Functions.pm	used by pod/splitpod
+lib/Pod/Text.pm		Convert POD data to formatted ASCII text
+lib/Search/Dict.pm	A module to do binary search on dictionaries
+lib/SelectSaver.pm	A module to enforce proper select scoping
+lib/SelfLoader.pm	A module to load functions only on demand.
+lib/Shell.pm		A module to make AUTOLOADed system() calls
+lib/Symbol.pm		Symbol table manipulation routines
+lib/Sys/Hostname.pm	Hostname methods
+lib/Sys/Syslog.pm	Perl module supporting syslogging
+lib/Term/Cap.pm		Perl module supporting termcap usage
+lib/Term/Complete.pm	A command completion subroutine
+lib/Term/ReadLine.pm	Stub readline library
+lib/Test/Harness.pm	A test harness
+lib/Text/Abbrev.pm	An abbreviation table builder
+lib/Text/ParseWords.pm	Perl module to split words on arbitrary delimiter
+lib/Text/Soundex.pm	Perl module to implement Soundex
+lib/Text/Tabs.pm	Do expand and unexpand
+lib/Text/Wrap.pm	Paragraph formatter
+lib/Tie/Hash.pm		Base class for tied hashes
+lib/Tie/Scalar.pm	Base class for tied scalars
+lib/Tie/SubstrHash.pm	Compact hash for known key, value and table size
+lib/Time/Local.pm	Reverse translation of localtime, gmtime
+lib/abbrev.pl		An abbreviation table builder
+lib/assert.pl		assertion and panic with stack trace
+lib/bigfloat.pl		An arbitrary precision floating point package
+lib/bigint.pl		An arbitrary precision integer arithmetic package
+lib/bigrat.pl		An arbitrary precision rational arithmetic package
+lib/cacheout.pl		Manages output filehandles when you need too many
+lib/chat2.inter		A chat2 with interaction
+lib/chat2.pl		Randal's famous expect-ish routines
+lib/complete.pl		A command completion subroutine
+lib/ctime.pl		A ctime workalike
+lib/diagnostics.pm	Print verbose diagnostics
+lib/dotsh.pl		Code to "dot" in a shell script
+lib/dumpvar.pl		A variable dumper
+lib/exceptions.pl	catch and throw routines
+lib/fastcwd.pl		a faster but more dangerous getcwd
+lib/find.pl		A find emulator--used by find2perl
+lib/finddepth.pl	A depth-first find emulator--used by find2perl
+lib/flush.pl		Routines to do single flush
+lib/ftp.pl		FTP code
+lib/getcwd.pl		A getcwd() emulator
+lib/getopt.pl		Perl library supporting option parsing
+lib/getopts.pl		Perl library supporting option parsing
+lib/hostname.pl		Old hostname code
+lib/importenv.pl	Perl routine to get environment into variables
+lib/integer.pm		For "use integer"
+lib/less.pm		For "use less"
+lib/lib.pm		For "use lib"
+lib/look.pl		A "look" equivalent
+lib/newgetopt.pl	A perl library supporting long option parsing
+lib/open2.pl		Open a two-ended pipe
+lib/open3.pl		Open a three-ended pipe
+lib/overload.pm		Module for overloading perl operators.
+lib/perl5db.pl		Perl debugging routines
+lib/pwd.pl		Routines to keep track of PWD environment variable
+lib/shellwords.pl	Perl library to split into words with shell quoting
+lib/sigtrap.pm		For trapping an abort and giving traceback
+lib/splain		Standalone program to print verbose diagnostics.
+lib/stat.pl		Perl library supporting stat function
+lib/strict.pm		For "use strict"
+lib/subs.pm		Declare overriding subs
+lib/syslog.pl		Perl library supporting syslogging
+lib/tainted.pl		Old code for tainting
+lib/termcap.pl		Perl library supporting termcap usage
+lib/timelocal.pl	Perl library supporting inverse of localtime, gmtime
+lib/validate.pl		Perl library supporting wholesale file mode validation
+lib/vars.pm		Declare pseudo-imported global variables
+makeaperl.SH		perl script that produces a new perl binary
+makedepend.SH		Precursor to makedepend
+makedir.SH		Precursor to makedir
+malloc.c		A version of malloc you might not want
+mg.c			Magic code
+mg.h			Magic header
+minimod.pl		Writes lib/ExtUtils/Miniperl.pm
+miniperlmain.c		Basic perl w/o dynamic loading or extensions
+mv-if-diff		Script to mv a file if it changed
+myconfig		Prints summary of the current configuration
+op.c			Opcode syntax tree code
+op.h			Opcode syntax tree header
+opcode.h		Automatically generated opcode header
+opcode.pl		Opcode header generatore
+os2/diff.configure	Patches to Configure
+os2/diff.db_file	patch to DB_File
+os2/Makefile.SHs	Shared library generation for OS/2
+os2/POSIX.mkfifo	POSIX.xs patch.
+os2/README		OS/2 port info.
+os2/README.old		previous OS/2 port info, partially relevant.
+os2/notes		Notes for perl maintainer
+os2/os2.c		Additional code for OS/2
+os2/os2ish.h		Header for OS/2
+os2/perl2cmd.pl		Corrects installed binaries under OS/2
+patchlevel.h		The current patch level of perl
+perl.c			main()
+perl.h			Global declarations
+perl_exp.SH		Creates list of exported symbols for AIX.
+perlsh			A poor man's perl shell
+perly.c			A byacc'ed perly.y
+perly.c.diff		Fixup perly.c to allow recursion
+perly.fixer		A program to remove yacc stack limitations
+perly.h			The header file for perly.c
+perly.y			Yacc grammar for perl
+pod/Makefile		Make pods into something else
+pod/buildtoc		generate perltoc.pod
+pod/perl.pod		Top level perl man page
+pod/perlbook.pod	Book info
+pod/perlbot.pod		Object-oriented Bag o' Tricks
+pod/perlcall.pod	Callback info
+pod/perldata.pod	Data structure info
+pod/perldebug.pod	Debugger info
+pod/perldiag.pod	Diagnostic info
+pod/perldsc.pod		Data Structures Cookbook
+pod/perlembed.pod	Embedding info
+pod/perlform.pod	Format info
+pod/perlfunc.pod	Function info
+pod/perlguts.pod	Internals info
+pod/perlipc.pod		IPC info
+pod/perllol.pod		How to use lists of lists.
+pod/perlmod.pod		Module info
+pod/perlobj.pod		Object info
+pod/perlop.pod		Operator info
+pod/perlovl.pod		Overloading info
+pod/perlpod.pod		Pod info
+pod/perlre.pod		Regular expression info
+pod/perlref.pod		References info
+pod/perlrun.pod		Execution info
+pod/perlsec.pod		Security info
+pod/perlstyle.pod	Style info
+pod/perlsub.pod		Subroutine info
+pod/perlsyn.pod		Syntax info
+pod/perltie.pod		Tieing an object class into a simple variable
+pod/perltoc.pod		Table of Contents info
+pod/perltrap.pod	Trap info
+pod/perlvar.pod		Variable info
+pod/perlxs.pod		XS api info
+pod/perlxstut.pod	XS tutorial
+pod/pod2html.PL		Precursor for translator to turn pod into HTML
+pod/pod2latex.PL	Precursor for translator to turn pod into LaTeX
+pod/pod2man.PL		Precursor for translator to turn pod into manpage
+pod/pod2text.PL	        Precursor for translator to turn pod into text
+pod/roffitall		troff the whole man page set
+pod/splitman		Splits perlfunc into multiple man pages
+pod/splitpod		Splits perlfunc into multiple pod pages
+pp.c			Push/Pop code
+pp.h			Push/Pop code defs
+pp_ctl.c		Push/Pop code for control flow
+pp_hot.c		Push/Pop code for heavily used opcodes
+pp_sys.c		Push/Pop code for system interaction
+proto.h			Prototypes
+regcomp.c		Regular expression compiler
+regcomp.h		Private declarations for above
+regexec.c		Regular expression evaluator
+regexp.h		Public declarations for the above
+run.c			The interpreter loop
+scope.c			Scope entry and exit code
+scope.h			Scope entry and exit header
+sv.c			Scalar value code
+sv.h			Scalar value header
+t/README		Instructions for regression tests
+t/TEST			The regression tester
+t/base/cond.t		See if conditionals work
+t/base/if.t		See if if works
+t/base/lex.t		See if lexical items work
+t/base/pat.t		See if pattern matching works
+t/base/term.t		See if various terms work
+t/cmd/elsif.t		See if else-if works
+t/cmd/for.t		See if for loops work
+t/cmd/mod.t		See if statement modifiers work
+t/cmd/subval.t		See if subroutine values work
+t/cmd/switch.t		See if switch optimizations work
+t/cmd/while.t		See if while loops work
+t/comp/cmdopt.t		See if command optimization works
+t/comp/cpp.aux		main file for cpp.t
+t/comp/cpp.t		See if C preprocessor works
+t/comp/decl.t		See if declarations work
+t/comp/multiline.t	See if multiline strings work
+t/comp/package.t	See if packages work
+t/comp/script.t		See if script invokation works
+t/comp/term.t		See if more terms work
+t/harness		Finer diagnostics from test suite
+t/io/argv.t		See if ARGV stuff works
+t/io/dup.t		See if >& works right
+t/io/fs.t		See if directory manipulations work
+t/io/inplace.t		See if inplace editing works
+t/io/pipe.t		See if secure pipes work
+t/io/print.t		See if print commands work
+t/io/tell.t		See if file seeking works
+t/lib/anydbm.t		See if AnyDBM_File works
+t/lib/bigint.t		See if bigint.pl works
+t/lib/bigintpm.t	See if BigInt.pm works
+t/lib/db-btree.t	See if DB_File works
+t/lib/db-hash.t		See if DB_File works
+t/lib/db-recno.t	See if DB_File works
+t/lib/dirhand.t		See if DirHandle works
+t/lib/english.t		See if English works
+t/lib/filehand.t	See if FileHandle works
+t/lib/gdbm.t		See if GDBM_File works
+t/lib/ndbm.t		See if NDBM_File works
+t/lib/odbm.t		See if ODBM_File works
+t/lib/posix.t		See if POSIX works
+t/lib/safe.t		See if Safe works
+t/lib/sdbm.t		See if SDBM_File works
+t/lib/socket.t		See if Socket works
+t/lib/soundex.t		See if Soundex works
+t/op/append.t		See if . works
+t/op/array.t		See if array operations work
+t/op/auto.t		See if autoincrement et all work
+t/op/chop.t		See if chop works
+t/op/cond.t		See if conditional expressions work
+t/op/delete.t		See if delete works
+t/op/do.t		See if subroutines work
+t/op/each.t		See if associative iterators work
+t/op/eval.t		See if eval operator works
+t/op/exec.t		See if exec and system work
+t/op/exp.t		See if math functions work
+t/op/flip.t		See if range operator works
+t/op/fork.t		See if fork works
+t/op/glob.t		See if <*> works
+t/op/goto.t		See if goto works
+t/op/groups.t		See if $( works
+t/op/index.t		See if index works
+t/op/int.t		See if int works
+t/op/join.t		See if join works
+t/op/list.t		See if array lists work
+t/op/local.t		See if local works
+t/op/magic.t		See if magic variables work
+t/op/misc.t		See if miscellaneous bugs have been fixed
+t/op/mkdir.t		See if mkdir works
+t/op/my.t		See if lexical scoping works
+t/op/oct.t		See if oct and hex work
+t/op/ord.t		See if ord works
+t/op/overload.t		See if operator overload works
+t/op/pack.t		See if pack and unpack work
+t/op/pat.t		See if esoteric patterns work
+t/op/push.t		See if push and pop work
+t/op/quotemeta.t	See if quotemeta works
+t/op/rand.t		See if rand works
+t/op/range.t		See if .. works
+t/op/re_tests		Input file for op.regexp
+t/op/read.t		See if read() works
+t/op/readdir.t		See if readdir() works
+t/op/ref.t		See if refs and objects work
+t/op/regexp.t		See if regular expressions work
+t/op/repeat.t		See if x operator works
+t/op/sleep.t		See if sleep works
+t/op/sort.t		See if sort works
+t/op/split.t		See if split works
+t/op/sprintf.t		See if sprintf works
+t/op/stat.t		See if stat works
+t/op/study.t		See if study works
+t/op/subst.t		See if substitution works
+t/op/substr.t		See if substr works
+t/op/time.t		See if time functions work
+t/op/undef.t		See if undef works
+t/op/unshift.t		See if unshift works
+t/op/vec.t		See if vectors work
+t/op/write.t		See if write works
+t/re_tests		Regular expressions for regexp.t
+taint.c			Tainting code
+toke.c			The tokener
+unixish.h		Defines that are assumed on Unix
+util.c			Utility routines
+util.h			Public declarations for the above
+utils/Makefile		Extract the utility scripts.
+utils/c2ph.PL		program to translate dbx stabs to perl
+utils/h2ph.PL		A thing to turn C .h files into perl .ph files
+utils/h2xs.PL		Program to make .xs files from C header files
+utils/perlbug.PL	A simple tool to submit a bug report
+utils/perldoc.PL	A simple tool to find & display perl's documentation
+utils/pl2pm.PL		A pl to pm translator
+vms/Makefile		VMS port
+vms/config.vms		default config.h for VMS
+vms/descrip.mms		MM[SK] description file for build
+vms/ext/Filespec.pm	VMS-Unix file syntax interconversion
+vms/ext/Stdio/0README.txt	ReadMe file for VMS::Stdio
+vms/ext/Stdio/Makefile.PL	MakeMaker driver for VMS::Stdio
+vms/ext/Stdio/Stdio.pm	VMS options to stdio routines
+vms/ext/Stdio/Stdio.xs	VMS options to stdio routines
+vms/ext/Stdio/test.pl	regression tests for VMS::Stdio
+vms/fndvers.com	parse Perl version from patchlevel.h
+vms/gen_shrfls.pl	generate options files and glue for shareable image
+vms/genconfig.pl	retcon config.sh from config.h
+vms/genopt.com		hack to write options files in case of broken makes
+vms/make_command.com	record MM[SK] command used to build Perl
+vms/mms2make.pl		convert descrip.mms to make syntax
+vms/myconfig.com	record local configuration info for bug report
+vms/perlvms.pod		VMS-specific additions to Perl documentation
+vms/perly_c.vms		perly.c with fixed declarations for global syms
+vms/perly_h.vms		perly.h with fixed declarations for global syms
+vms/sockadapt.c		glue for SockshShr socket support
+vms/sockadapt.h		glue for SockshShr socket support
+vms/test.com		DCL driver for regression tests
+vms/vms.c		VMS-specific C code for Perl core
+vms/vms_yfix.pl		convert Unix perly.[ch] to VMS perly_[ch].vms
+vms/vmsish.h		VMS-specific C header for Perl core
+vms/writemain.pl	Generate perlmain.c from miniperlmain.c+extensions
+writemain.SH		Generate perlmain.c from miniperlmain.c+extensions
+x2p/EXTERN.h		Same as above
+x2p/INTERN.h		Same as above
+x2p/Makefile.SH		Precursor to Makefile
+x2p/a2p.c		Output of a2p.y run through byacc
+x2p/a2p.h		Global declarations
+x2p/a2p.man		Manual page for awk to perl translator
+x2p/a2p.y		A yacc grammer for awk
+x2p/a2py.c		Awk compiler, sort of
+x2p/cflags.SH		A script that emits C compilation flags per file
+x2p/find2perl.PL	A find to perl translator
+x2p/handy.h		Handy definitions
+x2p/hash.c		Associative arrays again
+x2p/hash.h		Public declarations for the above
+x2p/s2p.PL		Sed to perl translator
+x2p/s2p.man		Manual page for sed to perl translator
+x2p/str.c		String handling package
+x2p/str.h		Public declarations for the above
+x2p/util.c		Utility routines
+x2p/util.h		Public declarations for the above
+x2p/walk.c		Parse tree walker
diff --git a/gnu/usr.bin/perl/Makefile.SH b/gnu/usr.bin/perl/Makefile.SH
new file mode 100644
index 00000000000..7eaa4e46dd5
--- /dev/null
+++ b/gnu/usr.bin/perl/Makefile.SH
@@ -0,0 +1,492 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+
+case "$d_dosuid" in
+*define*) suidperl='suidperl' ;;
+*) suidperl='';;
+esac
+
+shrpenv=""
+case "$d_shrplib" in
+*define*)
+    patchlevel=`egrep '^#define[ 	]+PATCHLEVEL' patchlevel.h \
+	| awk '{print $3}'`
+    case "$patchlevel" in
+     *[0-9]) plibsuf=.$so.$patchlevel;;
+     *)	    plibsuf=.$so;;
+    esac
+    if test "x$plibext" != "x" ; then  plibsuf=$plibext d_shrplib=custom ; fi
+    case "$shrpdir" in
+     /usr/lib)	;;
+     "")	;;
+     *)		shrpenv="env LD_RUN_PATH=$shrpdir";;
+    esac
+    pldlflags="$cccdlflags";;
+*)  plibsuf=$lib_ext
+    pldlflags="";;
+esac
+
+: Prepare dependency lists for Makefile.
+dynamic_list=' '
+for f in $dynamic_ext; do
+    : the dependency named here will never exist
+      base=`echo "$f" | sed 's/.*\///'`
+    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
+done
+
+static_list=' '
+static_ai_list=' '
+for f in $static_ext; do
+	base=`echo "$f" | sed 's/.*\///'`
+	static_list="$static_list lib/auto/$f/$base\$(LIB_EXT)"
+	if test -f ext/$f/AutoInit.c; then
+	    static_ai_list="$static_ai_list ext/$f/AutoInit.c"
+	fi
+	if test -f ext/$f/AutoInit.pl; then
+	    static_ai_list="$static_ai_list ext/$f/AutoInit.pl"
+	fi
+done
+
+echo "Extracting Makefile (with variable substitutions)"
+$spitshell >Makefile <<'!NO!SUBS!'
+# Makefile.SH
+# This file is derived from Makefile.SH.  Any changes made here will
+# be lost the next time you run Configure.
+#  Makefile is used to generate makefile.  The only difference
+#  is that makefile has the dependencies filled in at the end.
+#
+#
+!NO!SUBS!
+
+$spitshell >>Makefile <<!GROK!THIS!
+# I now supply perly.c with the kits, so don't remake perly.c without byacc
+BYACC = $byacc
+CC = $cc
+LD = $ld
+
+LDFLAGS = $ldflags
+CLDFLAGS = $ldflags
+
+SMALL = $small
+LARGE = $large $split
+mallocsrc = $mallocsrc
+mallocobj = $mallocobj
+LNS = $lns
+RMS = rm -f
+ranlib = $ranlib
+
+# The following are mentioned only to make metaconfig include the
+# appropriate questions in Configure.  If you want to change these,
+# edit config.sh instead, or specify --man1dir=/wherever on
+# installman commandline.
+bin = $installbin
+scriptdir = $scriptdir
+privlib = $installprivlib
+man1dir = $man1dir
+man1ext = $man1ext
+man3dir = $man3dir
+man3ext = $man3ext
+
+# The following are used to build and install shared libraries for
+# dynamic loading.
+LDDLFLAGS = $lddlflags
+CCDLFLAGS = $ccdlflags
+DLSUFFIX = .$dlext
+PLDLFLAGS = $pldlflags
+PLIBSUF = $plibsuf
+SHRPENV = $shrpenv
+
+dynamic_ext = $dynamic_list
+static_ext = $static_list
+ext = \$(dynamic_ext) \$(static_ext)
+static_ext_autoinit = $static_ai_list
+DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT)
+
+libs = $libs $cryptlib
+
+public = perl $suidperl utilities translators
+
+shellflags = $shellflags
+
+## To use an alternate make, set \$altmake in config.sh.
+MAKE = ${altmake-make}
+
+# These variables will be used in a future version to make
+# the make file more portable to non-unix systems.
+AR = $ar
+EXE_EXT = $exe_ext
+LIB_EXT = $lib_ext
+OBJ_EXT = $obj_ext
+PATH_SEP = $path_sep
+
+FIRSTMAKEFILE = $firstmakefile
+
+# Any special object files needed by this architecture, e.g. os2/os2.obj
+ARCHOBJS = $archobjs
+
+.SUFFIXES: .c \$(OBJ_EXT)
+
+!GROK!THIS!
+
+## In the following dollars and backticks do not need the extra backslash.
+$spitshell >>Makefile <<'!NO!SUBS!'
+
+CCCMD = `sh $(shellflags) cflags $(perllib) $@`
+
+private = preplibrary lib/ExtUtils/Miniperl.pm lib/Config.pm
+
+# Files to be built with variable substitution before miniperl
+# is available.
+sh = Makefile.SH cflags.SH config_h.SH makeaperl.SH makedepend.SH \
+	makedir.SH perl_exp.SH writemain.SH
+
+shextract = Makefile cflags config.h makeaperl makedepend \
+	makedir perl_exp writemain
+
+# Files to be built with variable substitution after miniperl is
+# available.  Dependencies handled manually below (for now).
+
+pl = pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL
+
+plextract = pod/pod2html pod/pod2latex pod/pod2man pod/pod2text
+
+addedbyconf = UU $(shextract) $(plextract) pstruct
+
+h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
+h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
+h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
+h4 = regexp.h scope.h sv.h unixish.h util.h
+h = $(h1) $(h2) $(h3) $(h4)
+
+c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
+c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c
+c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c globals.c
+
+c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c
+
+obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT)
+obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT)
+obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) globals$(OBJ_EXT)
+  
+obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
+
+# Once perl has been Configure'd and built ok you build different
+# perl variants (Debugging, Embedded, Multiplicity etc) by saying:
+#	make clean; make perllib=libperl<type>.a
+# where <type> is some combination of 'd' and(or) 'e' or 'm'.
+# See cflags to understand how this works.
+#
+# Eventually some form of 'make-a-perl' script will automate this
+# together with linking a perl executable with any desired
+# static modules.
+perllib = libperl$(PLIBSUF)
+
+lintflags = -hbvxac
+
+# grrr
+SHELL = /bin/sh
+
+.c$(OBJ_EXT):
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+all: makefile miniperl $(private) $(plextract) $(public) $(dynamic_ext)
+	@echo " "; echo "	Everything is up to date."
+
+translators:	miniperl lib/Config.pm FORCE
+	@echo " "; echo "	Making x2p stuff"; cd x2p; $(MAKE) all
+
+utilities:	miniperl lib/Config.pm FORCE
+	@echo " "; echo "	Making utilities"; cd utils; $(MAKE) all
+
+
+# This is now done by installman only if you actually want the man pages.
+#	@echo " "; echo "	Making docs"; cd pod; $(MAKE) all;
+
+# Phony target to force checking subdirectories.
+# Apparently some makes require an action for the FORCE target.
+FORCE:
+	@sh -c true
+
+# The $& notation tells Sequent machines that it can do a parallel make,
+# and is harmless otherwise.
+# The miniperl -w -MExporter line is a basic cheap test to catch errors
+# before make goes on to run preplibrary and then MakeMaker on extensions.
+# This is very handy because later errors are often caused by miniperl
+# build problems but that's not obvious to the novice.
+# The Module used here must not depend on Config or any extensions.
+
+miniperl: $& miniperlmain$(OBJ_EXT) $(perllib)
+	$(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(perllib) $(libs)
+	@./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest
+
+miniperlmain$(OBJ_EXT): miniperlmain.c
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit)
+	sh writemain $(DYNALOADER) $(static_ext) > tmp
+	sh mv-if-diff tmp perlmain.c
+
+perlmain$(OBJ_EXT): perlmain.c
+	$(CCCMD) $(PLDLFLAGS) $*.c
+
+# The file ext.libs is a list of libraries that must be linked in
+# for static extensions, e.g. -lm -lgdbm, etc.  The individual
+# static extension Makefile's add to it.
+ext.libs: $(static_ext)
+	-@test -f ext.libs || touch ext.libs
+
+perl: $& perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) ext.libs
+	$(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs)
+
+pureperl: $& perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) ext.libs
+	purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs)
+
+quantperl: $& perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) ext.libs
+	quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs)
+
+$(perllib): $& perl$(OBJ_EXT) $(obj)
+!NO!SUBS!
+
+case "$d_shrplib" in
+*define*)
+$spitshell >>Makefile <<'!NO!SUBS!'
+	$(LD) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj)
+!NO!SUBS!
+;;
+custom)
+if test -r $osname/Makefile.SHs ; then 
+  . $osname/Makefile.SHs
+  $spitshell >>Makefile <<!GROK!THIS!
+
+Makefile: $osname/Makefile.SHs
+
+!GROK!THIS!
+else
+  echo "Could not find $osname/Makefile.SH! Skipping target \$(perllib) in Makefile!"
+fi
+;;
+*)
+$spitshell >>Makefile <<'!NO!SUBS!'
+	rm -f $(perllib)
+	$(AR) rcu $(perllib) perl$(OBJ_EXT) $(obj)
+	@$(ranlib) $(perllib)
+!NO!SUBS!
+;;
+esac
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+
+# This version, if specified in Configure, does ONLY those scripts which need
+# set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
+# checks as well as the special code to validate that the script in question
+# has been invoked correctly.
+
+suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) ext.libs
+	$(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs)
+
+sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h)
+	$(RMS) sperl.c
+	$(LNS) perl.c sperl.c
+	$(CCCMD) -DIAMSUID sperl.c
+	$(RMS) sperl.c
+
+# We have to call our ./makedir because Ultrix 4.3 make can't handle the line
+#	test -d lib/auto || mkdir lib/auto
+#
+preplibrary: miniperl lib/Config.pm $(plextract)
+	@sh ./makedir lib/auto
+	@echo "	AutoSplitting perl library"
+	@./miniperl -Ilib -e 'use AutoSplit; \
+		autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm
+
+# Take care to avoid modifying lib/Config.pm without reason
+lib/Config.pm: config.sh miniperl
+	./miniperl configpm tmp
+	sh mv-if-diff tmp lib/Config.pm
+
+lib/ExtUtils/Miniperl.pm: miniperlmain.c miniperl minimod.pl lib/Config.pm
+	./miniperl minimod.pl > tmp && mv tmp $@
+
+$(plextract):	miniperl lib/Config.pm
+	./miniperl -Ilib $@.PL
+
+install: all install.perl install.man
+
+install.perl:	all installperl
+	./perl installperl
+
+install.man:	all installman
+	./perl installman
+
+# Not implemented yet.
+#install.html:	all installhtml
+#	./perl installhtml
+
+# I now supply perly.c with the kits, so the following section is
+# used only if you force byacc to run by saying
+# 	make run_byacc
+# Since we patch up the byacc output, the perly.fixer script needs
+# to run with precisely the same version of byacc as I use.  You
+# normally shouldn't remake perly.[ch].
+
+run_byacc:	FORCE
+	@ echo 'Expect' 130 shift/reduce and 1 reduce/reduce conflict
+	$(BYACC) -d perly.y
+	sh $(shellflags) ./perly.fixer y.tab.c perly.c
+	mv y.tab.h perly.h
+	echo 'extern YYSTYPE yylval;' >>perly.h
+	- perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
+
+# We don't want to regenerate perly.c and perly.h, but they might
+# appear out-of-date after a patch is applied or a new distribution is
+# made.
+perly.c: perly.y
+	-@sh -c true
+
+perly.h: perly.y
+	-@sh -c true
+
+# The following three header files are generated automatically
+#	keywords.h:	keywords.pl
+#	opcode.h:	opcode.pl
+#	embed.h:  	embed.pl global.sym interp.sym
+# The correct versions should be already supplied with the perl kit,
+# in case you don't have perl available.
+# To force them to run, type
+#	make regen_headers
+regen_headers:	FORCE
+	perl keywords.pl
+	perl opcode.pl
+	perl embed.pl
+
+# Extensions:
+# Names added to $(dynamic_ext) or $(static_ext) will automatically
+# get built.  There should ordinarily be no need to change any of
+# this part of makefile.
+#
+# The dummy dependency is a place holder in case $(dynamic_ext) or
+# $(static_ext) is empty.
+#
+# DynaLoader may be needed for extensions that use Makefile.PL.
+
+$(DYNALOADER):	miniperl preplibrary FORCE
+	@sh ext/util/make_ext static $@ LIBPERL_A=$(perllib)
+
+d_dummy $(dynamic_ext):	miniperl preplibrary $(DYNALOADER) FORCE
+	@sh ext/util/make_ext dynamic $@ LIBPERL_A=$(perllib)
+
+s_dummy $(static_ext):	miniperl preplibrary $(DYNALOADER) FORCE
+	@sh ext/util/make_ext static $@ LIBPERL_A=$(perllib)
+
+clean:
+	rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c
+	rm -f perl.exp ext.libs
+	-rm perl.export perl.dll perl.libexp perl.map perl.def
+	-cd pod; $(MAKE) clean
+	-cd utils; $(MAKE) clean
+	-cd x2p; $(MAKE) clean
+	-@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
+	sh ext/util/make_ext clean $$x ; \
+	done
+	rm -f perl suidperl miniperl $(perllib)
+
+realclean: clean
+	-cd os2; rm -f Makefile
+	-cd pod; $(MAKE) realclean
+	-cd utils; $(MAKE) realclean
+	-cd x2p; $(MAKE) realclean
+	-@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
+	sh ext/util/make_ext realclean $$x ; \
+	done
+	rm -f *.orig */*.orig *~ */*~ core t/core t/c t/perl
+	rm -rf $(addedbyconf)
+	rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old
+	rm -f $(private)
+	rm -rf lib/auto
+	rm -f lib/.exists
+	rm -f h2ph.man pstruct
+	rm -rf .config
+	@echo "Note that make realclean does not delete config.sh"
+
+clobber:	realclean
+	rm -f config.sh cppstdin
+
+distclean:	clobber
+
+# The following lint has practically everything turned on.  Unfortunately,
+# you have to wade through a lot of mumbo jumbo that can't be suppressed.
+# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
+# for that spot.
+
+lint: perly.c $(c)
+	lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz
+
+# Need to unset during recursion to go out of loop
+
+MAKEDEPEND = makedepend
+
+$(FIRSTMAKEFILE):	Makefile $(MAKEDEPEND)
+	$(MAKE) depend MAKEDEPEND=
+
+config.h: config.sh
+	/bin/sh config_h.SH
+
+# When done, touch perlmain.c so that it doesn't get remade each time.
+depend: makedepend
+	sh ./makedepend
+	- test -s perlmain.c && touch perlmain.c
+	cd x2p; $(MAKE) depend
+
+# Cannot postpone this until $firstmakefile is ready ;-)
+makedepend: makedepend.SH config.sh
+	sh ./makedepend.SH
+
+test: miniperl perl preplibrary $(dynamic_ext)
+	- cd t && chmod +x TEST */*.t
+	- cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) && ./perl TEST </dev/tty
+
+minitest: miniperl
+	- cd t && chmod +x TEST */*.t
+	- cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \
+		&& ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t </dev/tty
+
+clist:	$(c)
+	echo $(c) | tr ' ' '\012' >.clist
+
+hlist:  $(h)
+	echo $(h) | tr ' ' '\012' >.hlist
+
+shlist: $(sh)
+	echo $(sh) | tr ' ' '\012' >.shlist
+
+pllist: $(pl)
+	echo $(pl) | tr ' ' '\012' >.pllist
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+# If this runs make out of memory, delete /usr/include lines.
+!NO!SUBS!
+
+$eunicefix Makefile
+case `pwd` in
+*SH)
+    $rm -f ../Makefile
+    $ln Makefile ../Makefile
+    ;;
+esac
+$rm -f $firstmakefile
diff --git a/gnu/usr.bin/perl/Makefile.bsd-wrapper b/gnu/usr.bin/perl/Makefile.bsd-wrapper
new file mode 100644
index 00000000000..b28f904bbce
--- /dev/null
+++ b/gnu/usr.bin/perl/Makefile.bsd-wrapper
@@ -0,0 +1,94 @@
+#	$OpenBSD: Makefile.bsd-wrapper,v 1.1.1.1 1996/08/19 10:11:52 downsj Exp $
+#
+# Build wrapper for Perl 5.003.
+#
+
+MAN=		x2p/a2p.man x2p/s2p.man pod/perl.man pod/perlbook.man \
+		pod/perlbot.man pod/perlcall.man pod/perldata.man \
+		pod/perldebug.man pod/perldiag.man pod/perldsc.man \
+		pod/perlembed.man pod/perlform.man pod/perlfunc.man \
+		pod/perlguts.man pod/perlipc.man pod/perllol.man \
+		pod/perlmod.man pod/perlobj.man pod/perlop.man \
+		pod/perlovl.man pod/perlpod.man pod/perlre.man \
+		pod/perlref.man pod/perlrun.man pod/perlsec.man \
+		pod/perlstyle.man pod/perlsub.man pod/perlsyn.man \
+		pod/perltie.man pod/perltoc.man pod/perltrap.man \
+		pod/perlvar.man pod/perlxs.man pod/perlxstut.man
+
+MANALL=		${MAN:S/.man$/.cat1/g}
+
+MANLOCALBUILD=	yes
+
+.SUFFIXES: .man .cat1
+
+.man.cat1:
+	@echo "${NROFF} -mandoc ${.IMPSRC} > ${.TARGET}"
+	@${NROFF} -mandoc ${.IMPSRC} > ${.TARGET} || (rm -f ${.TARGET}; false)
+
+GENERATED=	config.sh Makefile cflags config.h makeaperl makedepend \
+		makedir perl.exp writemain x2p/Makefile x2p/cflags
+
+CLEANFILES=	config.sh
+
+.BEGIN:
+	@if [ ${.CURDIR} != ${.OBJDIR} ]; then lndir -s -e obj -e obj.${MACHINE_ARCH} -e Makefile.bsd-wrapper ${.CURDIR}; fi
+
+all:	${GENERATED}
+	(cd ${.OBJDIR}; ${MAKE})
+	(cd ${.OBJDIR}/pod; ${MAKE} man)
+
+config.sh:
+	(cd ${.OBJDIR}; /bin/sh Configure -f config.sh.OpenBSD -dsE)
+
+Makefile:
+	(cd ${.OBJDIR}; /bin/sh Makefile.SH)
+
+cflags:
+	(cd ${.OBJDIR}; /bin/sh cflags.SH)
+
+config.h:
+	(cd ${.OBJDIR}; /bin/sh config_h.SH)
+
+makeaperl:
+	(cd ${.OBJDIR}; /bin/sh makeaperl.SH)
+
+makedepend:
+	(cd ${.OBJDIR}; /bin/sh makedepend.SH)
+
+makedir:
+	(cd ${.OBJDIR}; /bin/sh makedir.SH)
+
+perl.exp:
+	(cd ${.OBJDIR}; /bin/sh perl_exp.SH)
+
+writemain:
+	(cd ${.OBJDIR}; /bin/sh writemain.SH)
+
+x2p/Makefile:
+	(cd ${.OBJDIR}/x2p; /bin/sh Makefile.SH)
+
+x2p/cflags:
+	(cd ${.OBJDIR}/x2p; /bin/sh cflags.SH)
+
+install: ${MANALL} maninstall
+	(cd ${.OBJDIR}; ${MAKE} install)
+
+clean:
+	-@if [ -e Makefile ]; then ${MAKE} realclean; fi
+
+cleandir:
+	-@if [ -e Makefile ]; then ${MAKE} realclean; fi
+	-@rm -f ${CLEANFILES}
+
+depend:
+	# Nothing here so far...
+
+lint:
+	# Nothing here so far...
+
+tags:
+	# Nothing here so far...
+
+.include <bsd.obj.mk>
+.include <bsd.subdir.mk>
+.include <bsd.man.mk>
diff --git a/gnu/usr.bin/perl/README b/gnu/usr.bin/perl/README
new file mode 100644
index 00000000000..0a7ab1ce967
--- /dev/null
+++ b/gnu/usr.bin/perl/README
@@ -0,0 +1,102 @@
+
+			   Perl Kit, Version 5.0
+
+		       Copyright 1989-1996, Larry Wall
+			    All rights reserved.
+
+    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, I'll be glad to provide one.
+
+    You should also have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+    For those of you that choose to use the GNU General Public License,
+    my interpretation of the GNU General Public License is that no Perl
+    script falls under the terms of the GPL unless you explicitly put
+    said script under the terms of the GPL yourself.  Furthermore, any
+    object code linked with perl does not automatically fall under the
+    terms of the GPL, provided such object code only adds definitions
+    of subroutines and variables, and does not otherwise impair the
+    resulting interpreter from executing any standard Perl script.  I
+    consider linking in C subroutines in this manner to be the moral
+    equivalent of defining subroutines in the Perl language itself.  You
+    may sell such an object file as proprietary provided that you provide
+    or offer to provide the Perl source, as specified by the GNU General
+    Public License.  (This is merely an alternate way of specifying input
+    to the program.)  You may also sell a binary produced by the dumping of
+    a running Perl script that belongs to you, provided that you provide or
+    offer to provide the Perl source as specified by the GPL.  (The
+    fact that a Perl interpreter and your code are in the same binary file
+    is, in this case, a form of mere aggregation.)  This is my interpretation
+    of the GPL.  If you still have concerns or difficulties understanding
+    my intent, feel free to contact me.  Of course, the Artistic License
+    spells all this out for your protection, so you may prefer to use that.
+
+--------------------------------------------------------------------------
+
+Perl is a language that combines some of the features of C, sed, awk
+and shell.  See the manual page for more hype.  There are also two Nutshell
+Handbooks published by O'Reilly & Assoc.  See pod/perlbook.pod
+for more information.
+
+Please read all the directions below before you proceed any further, and
+then follow them carefully.
+
+After you have unpacked your kit, you should have all the files listed
+in MANIFEST.
+
+Installation
+
+1) Detailed instructions are in the file INSTALL.  In brief, the
+following should work on most systems:
+	rm -f config.sh
+	sh Configure
+	make
+	make test
+	make install
+For most systems, it should be safe to accept all the Configure
+defaults.
+
+2) Read the manual entries before running perl.
+
+3) IMPORTANT!  Help save the world!  Communicate any problems and suggested
+patches to me, lwall@sems.com (Larry Wall), so we can
+keep the world in sync.  If you have a problem, there's someone else
+out there who either has had or will have the same problem.
+It's usually helpful if you send the output of the "myconfig" script
+in the main perl directory.
+
+If you've succeeded in compiling perl, the perlbug script in the utils/
+subdirectory can be used to help mail in a bug report.
+
+If possible, send in patches such that the patch program will apply them.
+Context diffs are the best, then normal diffs.  Don't send ed scripts--
+I've probably changed my copy since the version you have.
+
+Watch for perl patches in comp.lang.perl.announce.  Patches will generally
+be in a form usable by the patch program.  If you are just now bringing
+up perl and aren't sure how many patches there are, write to me and I'll
+send any you don't have.  Your current patch level is shown in
+patchlevel.h.
+
+
+Just a personal note:  I want you to know that I create nice things like this
+because it pleases the Author of my story.  If this bothers you, then your
+notion of Authorship needs some revision.  But you can use perl anyway. :-)
+
+							The author.
diff --git a/gnu/usr.bin/perl/README.vms b/gnu/usr.bin/perl/README.vms
new file mode 100644
index 00000000000..ba0ba190fd7
--- /dev/null
+++ b/gnu/usr.bin/perl/README.vms
@@ -0,0 +1,355 @@
+Last revised: 19-Jan-1996 by Charles Bailey  bailey@genetics.upenn.edu
+
+The VMS port of Perl is still under development.  At this time, the Perl
+binaries built under VMS handle internal operations properly, for the most
+part, as well as most of the system calls which have close equivalents under
+VMS. There are still some incompatibilities in process handling (e.g the
+fork/exec model for creating subprocesses doesn't do what you might expect
+under Unix), and there remain some file handling differences from Unix.  Over
+the longer term, we'll try to get many of the useful VMS system services
+integrated as well, depending on time and people available.  Of course, if
+you'd like to add something yourself, or join the porting team, we'd love to
+have you!
+
+The current sources and build procedures have been tested on a VAX using VAXC
+and DECC, and on an AXP using DECC.  If you run into problems with other
+compilers, please let us know.
+
+Note to DECC users: Some early versions of the DECCRTL contained a few bugs
+which affect Perl performance:
+    - Newlines are lost on I/O through pipes, causing lines to run together.
+      This shows up as RMS RTB errors when reading from a pipe.  You can
+      work around this by having one process write data to a file, and
+      then having the other read the file, instead of the pipe.  This is
+      fixed in version 4 of DECC.
+    - The modf() routine returns a non-integral value for some values above
+      INT_MAX; the Perl "int" operator will return a non-integral value in
+      these cases.  This is fixed in version 4 of DECC.
+    - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine 
+      changes the process default device and directory permanently, even
+      though the call specified that the change should not persist after
+      Perl exited.  This is fixed by DEC CSC patch AXPACRT04_061.
+
+* Other software required
+
+At the moment, in addition to basic VMS, you'll need two things:
+   - a C compiler: VAXC, DECC, or gcc for the VAX; DECC for the AXP
+   - a make tool: DEC's MMS (version 2.6 or later) or the free analog MMK
+     (available from ftp.spc.edu), or a standard make utility (e.g. GNU make,
+     also available from ftp.spc.edu).
+In addition, you may include socket support if you have an IP stack running
+on your system.  See the topic "Socket support" for more information.
+
+* Socket support
+
+Perl includes a number of IP socket routines among its builtin functions,
+which are available if you choose to compile Perl with socket support.  Since
+IP networking is an optional addition to VMS, there are several different IP
+stacks available, so it's difficult to automate the process of building Perl
+with socket support in a way which will work on all systems.  
+
+By default, Perl is built without IP socket support.  If you define the macro
+SOCKET when invoking MMK, however, socket support will be included.  As
+distributed, Perl for VMS includes support for the SOCKETSHR socket library,
+which is layered on MadGoat software's vendor-independent NETLIB interface. 
+This provides support for all socket calls used by Perl except the
+[g|s]etnet*() routines, which are replaced for the moment by stubs which
+generate a fatal error if a Perl script attempts to call one of these routines. 
+Both SOCKETSHR and NETLIB are available from MadGoat ftp sites, such as
+ftp.spc.edu or ftp.wku.edu.
+
+You can link Perl directly to your TCP/IP stack's library, *as long as* it
+supplies shims for stdio routines which will properly handle both sockets and
+normal file descriptors.  This is necessary because Perl does not distinguish
+between the two, and will try to make normal stdio calls such as read() and
+getc() on socket file descriptors.  If you'd like to link Perl directly to
+your IP stack, then make the following changes:
+  - In Descrip.MMS, locate the section beginning with .ifdef SOCKET, and
+    change the SOCKLIB macro so that it translates to  the filespec of your
+    IP stack's socket library.  This will be added to the RTL options file.
+  - Edit the file SockAdapt.H in the [.VMS] subdirectory so that it
+    includes the Socket.H, In.H, Inet.H, NetDb.H, and, if necessary,
+    Errno.H header files for your IP stack, or so that it declares the
+    standard TCP/IP constants and data structures appropriately.  (See
+    the distributed copy of SockAdapt.H for a collection of the structures
+    needed by Perl itself, and [.ext.Socket]Socket.xs for a list of the
+    constants used by the Socket extension, if you elect to built it.)
+    You should also define any logical names necessary for your C compiler
+    to find these files before invoking MM[KS] to build Perl.
+  - Edit the file SockAdapt.C in the [.VMS] subdirectory so that it
+    contains routines which substitute for any IP library routines
+    required by Perl which your IP stack does not provide.  This may
+    require a little trial and error; we'll try to compile a complete
+    list soon of socket routines required by Perl.
+
+
+* Building Perl under VMS
+
+Since you're reading this, presumably you've unpacked the Perl distribution
+into its directory tree, in which you will find a [.vms] subdirectory below
+the directory in which this file is found.  If this isn't the case, then you'll
+need to unpack the distribution properly, or manually edit Descrip.MMS or
+the VMS Makefile to alter directory paths as necessary.  (I'd advise using the 
+`normal' directory tree, at least for the first time through.)  This
+subdirectory contains several files, among which are the following:
+  Config.VMS     - A template Config.H set up for VMS.
+  Descrip.MMS    - The MMS/MMK dependency file for building Perl
+  GenConfig.Pl   - A Perl script to generate Config.SH retrospectively
+                   from Config.VMS, since the Configure shell script which
+                   normally generates Config.SH doesn't run under VMS.
+  GenOpt.Com     - A little DCL procedure used to write some linker options
+                   files, since not all make utilities can do this easily.
+  Gen_ShrFls.Pl  - A Perl script which generates linker options files and
+                   MACRO declarations for PerlShr.Exe.
+  Makefile       - The make dependency file for building Perl  
+  MMS2Make.Pl    - A Perl script used to generate Makefile from Descrip.MMS
+  PerlVMS.pod    - Documentation for VMS-specific behavior of Perl
+  Perly_[CH].VMS - Versions of the byacc output from Perl's grammar,
+                   modified to include VMS-specific C compiler options
+  SockAdapt.[CH] - C source code used to integrate VMS TCP/IP support
+  Test.Com       - DCL driver for Perl regression tests
+  VMSish.H       - C header file containing VMS-specific definitions
+  VMS.C          - C source code for VMS-specific routines
+  VMS_Yfix.Pl    - Perl script to convert Perly.[CH] to Perly_[CH].VMS
+  WriteMain.Pl   - Perl script to generate Perlmain.C
+The [.Ext...] directories contain VMS-specific extensions distributed with
+Perl.  There may also be other files in [.VMS...] pertaining to features under
+development; for the most part, you can ignore them.  Note that packages in
+[.ext.*] are not built with Perl by default; you build the ones you want
+once the basic Perl build is complete (see the perlvms docs for instructions
+on building extensions.)
+
+Config.VMS and Decrip.MMS/Makefile are set up to build a version of Perl which
+includes all features known to work when this release was assembled.  If you
+have code at your site which would support additional features (e.g. emulation
+of Unix system calls), feel free to make the appropriate changes to these
+files.  (Note: Do not use or edit config.h in the main Perl source directory;
+it is superseded by the current Config.VMS during the build.)  You may also
+wish to make site-specific changes to Descrip.MMS or Makefile to reflect local
+conventions for naming of files, etc.
+
+There are several pieces of system-specific information which become part of
+the Perl Config extension.  Under VMS, the data for Config are generated by the
+script GenConfig.Pl in the [.VMS] subdirectory.  It tries to ascertain the
+necessary information from various files, or from the system itself, and
+generally does the right thing.  There is a list of hard-coded values at the
+end of this script which specifies items that are correct for most VMS systems,
+but may be incorrect for you, if your site is set up in an unusual fashion.  If
+you're familiar with Perl's Config extension, feel free to edit these values as
+necessary.  If this doesn't mean much to you, don't worry -- the information is
+probably correct, and even if it's not, none of these parameters affect your
+ability to build or run Perl.  You'll only get the wrong answer if you ask for
+it specifically from Config.
+
+Examine the information at the beginning of Descrip.MMS for information about
+specifying alternate C compilers or building a version of Perl with debugging
+support.  For instance, if you want to use DECC, you'll need to include the
+/macro="decc=1" qualifier to MMK  (If you're using make, these options are not
+supported.)  If you're on an AXP system, define the macro __AXP__ (MMK does
+this for you), and DECC will automatically be selected.
+
+To start the build, set default to the main source directory.  Since
+Descrip.MMS assumes that VMS commands have their usual meaning, and makes use
+of command-line macros, you may want to be certain that you haven't defined DCL
+symbols which would interfere with the build.  Then, if you are using MMS or
+MMK, say
+$ MMS/Descrip=[.VMS] ! or MMK
+(N.B. If you are using MMS, you must use version 2.6 or later; a bug in
+earlier versions produces malformed cc command lines.)  If you are using a
+version of make, say
+$ Make -f [.VMS]Makefile
+Note that the Makefile doesn't support conditional compilation, is
+set up to use VAXC on a VAX, and does not include socket support.  You can
+either edit the Makefile by hand, using Descrip.MMS as a guide, or use the
+Makefile to build Miniperl.Exe, and then run the Perl script MMS2Make.pl,
+found in the [.VMS] subdirectory, to generate a new Makefile with the options
+appropriate to your site.
+
+If you are using MM[SK], and you decide to rebuild Perl with a different set
+of parameters (e.g. changing the C compiler, or adding socket support), be
+sure to say
+$ MMK/Descrip=[.VMS] realclean
+first, in order to remove files generated during the previous build.  If
+you omit this step, you risk ending up with a copy of Perl which
+composed partially of old files and partially of new ones, which may lead
+to strange effects when you try to run Perl.
+
+A bug in some early versions of the DECC RTL on the AXP causes newlines
+to be lost when writing to a pipe.  A different bug in some patched versions
+of DECC 4.0 for VAX can also scramble preprocessor output.  Finally, gcc 2.7.2
+has yet another preprocessor bug, which causes line breaks to be inserted
+into the output at inopportune times.  Each of these bugs causes Gen_ShrFls.pl
+to fail, since it can't parse the preprocessor output to identify global
+variables and routines.  This problem is generally manifested as missing
+global symbols when linking PerlShr.Exe or Perl.Exe.  You can work around
+it by defining the macro PIPES_BROKEN when you invoke MMS or MMK.
+
+
+This will build the following files:
+  Miniperl.Exe        - a stand-alone version of without any extensions.
+                        Miniperl has all the intrinsic capabilities of Perl,
+                        but cannot make use of the DynaLoader or any
+                        extensions which use XS code.
+  PerlShr.Exe         - a shareable image containing most of Perl's internal
+                        routines and global variables.  Perl.Exe is linked to
+                        this image, as are all dynamic extensions, so everyone's
+                        using the same set of global variables and routines.
+  Perl.Exe            - the main Perl executable image.  It's contains the
+                        main() routine, plus code for any statically linked
+                        extensions.
+  PerlShr_Attr.Opt    - A linker options file which specifies psect attributes
+                        matching those in PerlShr.Exe.  It should be used when
+                        linking images against PerlShr.Exe
+  PerlShr_Bld.Opt     - A linker options file which specifies various things
+                        used to build PerlShr.Exe.  It should be used when
+                        rebuilding PerlShr.Exe via MakeMaker-produced
+                        Descrip.MMS files for static extensions.
+  c2ph                - Perl program which generates template code to access
+                        C struct members from Perl.
+  h2ph                - Perl program which generates template code to access
+                        #defined constants in a C header file from Perl,
+                        using the "old-style" interface.  (Largely supplanted
+                        by h2xs.)
+  h2xs                - Perl program which generates template files for creating
+                        XSUB extensions, optionally beginning with the #defined
+                        constants in a C header file.
+  [.lib.pod]perldoc   - A Perl program which locates and displays documentation
+                        for Perl and its extensions.
+  [.Lib]Config.pm     - the Perl extension which saves configuration information
+                        about Perl and your system.
+  [.Lib]DynaLoader.pm - The Perl extension which performs dynamic linking of
+                        shareable images for extensions.
+  Several subdirectories under [.Lib] containing preprocessed files or
+                        site-specific files.
+There are, of course, a number of other files created for use during the build. 
+Once you've got the binaries built, you may wish to `build' the `tidy' or
+`clean' targets to remove extra files.
+
+If you run into problems during the build, you can get help from the VMSPerl
+or perl5-porters mailing lists (see below).  When you report the problem,
+please include the following information:
+  - The version of Perl you're trying to build.  Please include any
+    "letter" patchlevel, in addition to the version number.  If the
+    build successfully created Miniperl.Exe, you can check this by
+    saying '$ MCR Sys$Disk:[]Miniperl -v'.  Also, please mention
+    where you obtained the distribution kit; in particular, note
+    whether you were using a basic Perl kit or the VMS test kit
+    (see below).
+  - The exact command you issued to build Perl.
+  - A copy of all error messages which were generated during the build.
+    Please include enough of the build log to establish the context of
+    the error messages.
+  - A summary of your configuration.  If the build progressed far enough
+    to generate Miniperl.Exe and [.Lib]Config.pm, you can obtain this
+    by saying '$ MCR Sys$Disk:[]Miniperl "-V"' (note the "" around -V).
+    If not, then you can say '$ MMK/Descrip=[.VMS] printconfig' to
+    produce the summary.
+This may sound like a lot of information to send, but it'll often make
+it easier for someone to spot the problem, instead of having to give
+a spectrum of possibilities.
+  
+
+
+* Installing Perl once it's built
+
+Once the build is complete, you'll need to do the following:
+  - Put PerlShr.Exe in a common directory, and make it world-readable.
+    If you place it in a location other than Sys$Share, you'll need to
+    define the logical name PerlShr to point to the image.  (If you're
+    installing on a VMScluster, be sure that each node is using the
+    copy of PerlShr you expect [e.g. if you put PerlShr.Exe in Sys$Share,
+    do they all share Sys$Share?]).
+  - Put Perl.Exe in a common directory, and make it world-executable.
+  - Define a foreign command to invoke Perl, using a statement like
+    $ Perl == "$dev:[dir]Perl.Exe"
+  - Create a world-readable directory tree for Perl library modules,
+    scripts, and what-have-you, and define PERL_ROOT as a rooted logical
+    name pointing to the top of this tree (i.e. if your Perl files were
+    going to live in DKA1:[Util.Perl5...], then you should
+      $ Define/Translation=Concealed Perl_Root DKA1:[Util.Perl5.]
+    (Be careful to follow the rules for rooted logical names; in particular,
+    remember that a rooted logical name cannot have as its device portion
+    another rooted logical name - you've got to supply the actual device name
+    and directory path to the root directory.)
+  - Place the files from the [.lib...] directory tree in the distribution
+    package into a [.lib...] directory tree off the root directory described
+    above.
+  - Most of the Perl documentation lives in the [.pod] subdirectory, and
+    is written in a simple markup format which can be easily read.  In this
+    directory as well are pod2man and pod2html translators to reformat the
+    docs for common display engines; a pod2hlp translator is under development.
+    These files are copied to [.lib.pod] during the installation.
+  - Define a foreign command to execute perldoc, such as
+    $ Perldoc == "''Perl' Perl_Root:[lib.pod]Perldoc -t"
+    This will allow users to retrieve documentation using Perldoc.  For
+    more details, say "perldoc perldoc".
+That's it.
+
+If you run into a bug in Perl, please submit a bug report.  The PerlBug
+program, found in the [.lib] directory, will walk you through the process
+of assembling the necessary information into a bug report, and sending
+of to the Perl bug reporting address, perlbug@perl.com.
+
+* For more information
+
+If you're interested in more information on Perl in general, consult the Usenet
+newsgroups comp.lang.perl.announce and comp.lang.perl.misc.  The FAQ for these
+groups provides pointers to other online sources of information, as well as
+books describing Perl in depth.
+
+If you're interested in up-to-date information on Perl development and
+internals, you might want to subscribe to the perl5-porters mailing list.  You
+can do this by sending a message to perl5-porters-request@nicoh.com, containing
+the single line
+subscribe perl5-porters
+This is a high-volume list at the moment (>50 messages/day).
+
+If you're interested in ongoing information about the VMS port, you can
+subscribe to the VMSperl mailing list by sending a request to
+bailey@genetics.upenn.edu (it's to a human, not a list server - this is a small
+operation at the moment).  And, as always, we welcome any help or code you'd
+like to offer - you can send mail to bailey@genetics.upenn.edu or directly to
+the VMSperl list at vmsperl@genetics.upenn.edu.
+
+Finally, if you'd like to try out the latest changes to VMS Perl, you can
+retrieve a test distribution kit by anonymous ftp from genetics.upenn.edu, in
+the file [.perl5]perl5_ppp_yymmddx.zip, where "ppp" is the current Perl
+patchlevel, and "yymmddx" is a sequence number indicating the date that
+particular kit was assembled.  In order to make retrieval convenient, this
+kit is also available by the name Perl5_VMSTest.Zip.  These test kits contain
+"unofficial" patches from the perl5-porters group, test patches for important
+bugs, and VMS-specific fixes and improvements which have occurred since the
+last Perl release.  Most of these changes will be incorporated in the next
+release of Perl, but until Larry Wall's looked at them and said they're OK,
+none of them should be considered official.
+
+Good luck using Perl.  Please let us know how it works for you - we can't
+guarantee that we'll be able to fix bugs quickly, but we'll try, and we'd
+certainly like to know they're out there.
+
+
+* Acknowledgements
+
+There are, of course, far too many people involved in the porting and testing
+of Perl to mention everyone who deserves it, so please forgive us if we've
+missed someone.  That said, special thanks are due to the following:
+  Tim Adye <T.J.Adye@rl.ac.uk>
+     for the VMS emulations of getpw*()
+  David Denholm <denholm@conmat.phys.soton.ac.uk>
+     for extensive testing and provision of pipe and SocketShr code,
+  Mark Pizzolato <mark@infocomm.com>
+     for the getredirection() code
+  Rich Salz <rsalz@bbn.com>
+     for readdir() and related routines
+  Richard Dyson <dyson@blaze.physics.uiowa.edu> and
+  Kent Covert <kacovert@miavx1.acs.muohio.edu>
+     for additional testing on the AXP.
+and to the entire VMSperl group for useful advice and suggestions.  In addition
+the perl5-porters, especially Andy Dougherty <doughera@lafcol.lafayette.edu>
+and Tim Bunce <Tim.Bunce@ig.co.uk>,  deserve credit for their creativity and
+willingness to work with the VMS newcomers.  Finally, the greatest debt of
+gratitude is due to Larry Wall <lwall@sems.com>, for having the ideas which
+have made our sleepless nights possible.
+
+Thanks,
+The VMSperl group
diff --git a/gnu/usr.bin/perl/Todo b/gnu/usr.bin/perl/Todo
new file mode 100644
index 00000000000..114a488691e
--- /dev/null
+++ b/gnu/usr.bin/perl/Todo
@@ -0,0 +1,68 @@
+Tie Modules
+	VecArray		Implement array using vec()
+	SubstrArray		Implement array using substr()
+	VirtualArray		Implement array using a file
+	ShiftSplice		Defines shift et al in terms of splice method
+
+Would be nice to have
+	Profiler
+	pack "(stuff)*"
+	Contiguous bitfields in pack/unpack
+	lexperl
+	Bundled perl preprocessor
+	Use posix calls internally where possible
+	const variables
+	gettimeofday
+	bytecompiler
+	format BOTTOM
+	$obj->can("method") to probe method inheritance
+	-iprefix.
+	-i rename file only when successfully changed
+	All ARGV input should act like <>
+	Multiple levels of warning
+	report HANDLE [formats].
+	tie(FILEHANDLE, ...)
+	__DATA__
+	support in perlmain to rerun debugger
+	make 'r' print return value like gdb 'fini'
+	regression tests using __WARN__ and __DIE__ hooks
+
+Possible pragmas
+	debugger
+	optimize (use less memory, CPU)
+
+Optimizations
+	constant function cache
+	switch structures
+	eval qw() at compile time
+	foreach (1..1000000)
+	foreach(reverse...)
+	Set KEEP on constant split
+	Cache eval tree (unless lexical outer scope used (mark in &compiling?))
+	rcatmaybe
+	Shrink opcode tables via multiple implementations selected in peep
+	Cache hash value?  (Not a win, according to Guido)
+	Optimize away @_ where possible
+	sfio?
+	"one pass" global destruction
+	Optimize sort by { $a <=> $b }
+	Rewrite regexp parser for better integrated optimization
+
+Vague possibilities
+	ref function in list context
+	Populate %SIG at startup if appropriate
+	data prettyprint function?  (or is it, as I suspect, a lib routine?)
+	make tr/// return histogram in list context?
+	undef wantarray in void context
+	Loop control on do{} et al
+	Explicit switch statements
+	perl to C translator
+	multi-thread scheduling
+	built-in globbing
+	compile to real threaded code
+	structured types
+	paren counting in tokener to queue remote expectations
+	autocroak?
+	Modifiable $1 et al
+	substr EXPR,OFFSET,LENGTH,STRING
+
diff --git a/gnu/usr.bin/perl/XSUB.h b/gnu/usr.bin/perl/XSUB.h
new file mode 100644
index 00000000000..af452ea5d77
--- /dev/null
+++ b/gnu/usr.bin/perl/XSUB.h
@@ -0,0 +1,56 @@
+#define ST(off) stack_base[ax + (off)]
+
+#ifdef CAN_PROTOTYPE
+#define XS(name) void name(CV* cv)
+#else
+#define XS(name) void name(cv) CV* cv;
+#endif
+
+#define dXSARGS				\
+	dSP; dMARK;			\
+	I32 ax = mark - stack_base + 1;	\
+	I32 items = sp - mark
+
+#define XSANY CvXSUBANY(cv)
+
+#define dXSI32 I32 ix = XSANY.any_i32
+
+#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return
+
+/* Simple macros to put new mortal values onto the stack.   */
+/* Typically used to return values from XS functions.       */
+#define XST_mIV(i,v)  (ST(i) = sv_2mortal(newSViv(v))  )
+#define XST_mNV(i,v)  (ST(i) = sv_2mortal(newSVnv(v))  )
+#define XST_mPV(i,v)  (ST(i) = sv_2mortal(newSVpv(v,0)))
+#define XST_mNO(i)    (ST(i) = &sv_no   )
+#define XST_mYES(i)   (ST(i) = &sv_yes  )
+#define XST_mUNDEF(i) (ST(i) = &sv_undef)
+ 
+#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v);  XSRETURN(1); } STMT_END
+#define XSRETURN_NO    STMT_START { XST_mNO(0);    XSRETURN(1); } STMT_END
+#define XSRETURN_YES   STMT_START { XST_mYES(0);   XSRETURN(1); } STMT_END
+#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END
+#define XSRETURN_EMPTY STMT_START {                XSRETURN(0); } STMT_END
+
+#define newXSproto(a,b,c,d)	sv_setpv((SV*)newXS(a,b,c), d)
+
+#ifdef XS_VERSION
+# define XS_VERSION_BOOTCHECK \
+    STMT_START {                                                                      \
+        char vn[255], *module = SvPV(ST(0),na);                               \
+        if (items >= 2)         /* version supplied as bootstrap arg */       \
+            Sv=ST(1);                                                         \
+        else {                  /* read version from module::VERSION */       \
+            sprintf(vn,"%s::VERSION", module);                                \
+            Sv = perl_get_sv(vn, FALSE);   /* XXX GV_ADDWARN */               \
+        }                                                                     \
+        if (Sv && (!SvOK(Sv) || strNE(XS_VERSION, SvPV(Sv,na))) )             \
+            croak("%s object version %s does not match %s.pm $VERSION %s",    \
+              module,XS_VERSION, module,(Sv && SvOK(Sv))?SvPV(Sv,na):"(undef)");\
+    } STMT_END
+#else
+# define XS_VERSION_BOOTCHECK
+#endif
+
diff --git a/gnu/usr.bin/perl/av.c b/gnu/usr.bin/perl/av.c
new file mode 100644
index 00000000000..b27ec762a63
--- /dev/null
+++ b/gnu/usr.bin/perl/av.c
@@ -0,0 +1,465 @@
+/*    av.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "...for the Entwives desired order, and plenty, and peace (by which they
+ * meant that things should remain where they had set them)." --Treebeard
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static void	av_reify _((AV* av));
+
+static void
+av_reify(av)
+AV* av;
+{
+    I32 key;
+    SV* sv;
+    
+    key = AvMAX(av) + 1;
+    while (key > AvFILL(av) + 1)
+	AvARRAY(av)[--key] = &sv_undef;
+    while (key) {
+	sv = AvARRAY(av)[--key];
+	assert(sv);
+	if (sv != &sv_undef)
+	    (void)SvREFCNT_inc(sv);
+    }
+    AvREAL_on(av);
+}
+
+void
+av_extend(av,key)
+AV *av;
+I32 key;
+{
+    if (key > AvMAX(av)) {
+	SV** ary;
+	I32 tmp;
+	I32 newmax;
+
+	if (AvALLOC(av) != AvARRAY(av)) {
+	    ary = AvALLOC(av) + AvFILL(av) + 1;
+	    tmp = AvARRAY(av) - AvALLOC(av);
+	    Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*);
+	    AvMAX(av) += tmp;
+	    SvPVX(av) = (char*)AvALLOC(av);
+	    if (AvREAL(av)) {
+		while (tmp)
+		    ary[--tmp] = &sv_undef;
+	    }
+	    
+	    if (key > AvMAX(av) - 10) {
+		newmax = key + AvMAX(av);
+		goto resize;
+	    }
+	}
+	else {
+	    if (AvALLOC(av)) {
+#ifndef STRANGE_MALLOC
+		U32 bytes;
+#endif
+
+		newmax = key + AvMAX(av) / 5;
+	      resize:
+#ifdef STRANGE_MALLOC
+		Renew(AvALLOC(av),newmax+1, SV*);
+#else
+		bytes = (newmax + 1) * sizeof(SV*);
+#define MALLOC_OVERHEAD 16
+		tmp = MALLOC_OVERHEAD;
+		while (tmp - MALLOC_OVERHEAD < bytes)
+		    tmp += tmp;
+		tmp -= MALLOC_OVERHEAD;
+		tmp /= sizeof(SV*);
+		assert(tmp > newmax);
+		newmax = tmp - 1;
+		New(2,ary, newmax+1, SV*);
+		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
+		if (AvMAX(av) > 64 && !nice_chunk) {
+		    nice_chunk = (char*)AvALLOC(av);
+		    nice_chunk_size = (AvMAX(av) + 1) * sizeof(SV*);
+		}
+		else
+		    Safefree(AvALLOC(av));
+		AvALLOC(av) = ary;
+#endif
+		ary = AvALLOC(av) + AvMAX(av) + 1;
+		tmp = newmax - AvMAX(av);
+		if (av == stack) {	/* Oops, grew stack (via av_store()?) */
+		    stack_sp = AvALLOC(av) + (stack_sp - stack_base);
+		    stack_base = AvALLOC(av);
+		    stack_max = stack_base + newmax;
+		}
+	    }
+	    else {
+		newmax = key < 4 ? 4 : key;
+		New(2,AvALLOC(av), newmax+1, SV*);
+		ary = AvALLOC(av) + 1;
+		tmp = newmax;
+		AvALLOC(av)[0] = &sv_undef;	/* For the stacks */
+	    }
+	    if (AvREAL(av)) {
+		while (tmp)
+		    ary[--tmp] = &sv_undef;
+	    }
+	    
+	    SvPVX(av) = (char*)AvALLOC(av);
+	    AvMAX(av) = newmax;
+	}
+    }
+}
+
+SV**
+av_fetch(av,key,lval)
+register AV *av;
+I32 key;
+I32 lval;
+{
+    SV *sv;
+
+    if (!av)
+	return 0;
+
+    if (SvRMAGICAL(av)) {
+	if (mg_find((SV*)av,'P')) {
+	    sv = sv_newmortal();
+	    mg_copy((SV*)av, sv, 0, key);
+	    Sv = sv;
+	    return &Sv;
+	}
+    }
+
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return 0;
+    }
+    else if (key > AvFILL(av)) {
+	if (!lval)
+	    return 0;
+	if (AvREALISH(av))
+	    sv = NEWSV(5,0);
+	else
+	    sv = sv_newmortal();
+	return av_store(av,key,sv);
+    }
+    if (AvARRAY(av)[key] == &sv_undef) {
+	if (lval) {
+	    sv = NEWSV(6,0);
+	    return av_store(av,key,sv);
+	}
+	return 0;
+    }
+    return &AvARRAY(av)[key];
+}
+
+SV**
+av_store(av,key,val)
+register AV *av;
+I32 key;
+SV *val;
+{
+    SV** ary;
+
+    if (!av)
+	return 0;
+
+    if (SvRMAGICAL(av)) {
+	if (mg_find((SV*)av,'P')) {
+	    mg_copy((SV*)av, val, 0, key);
+	    return 0;
+	}
+    }
+
+    if (key < 0) {
+	key += AvFILL(av) + 1;
+	if (key < 0)
+	    return 0;
+    }
+    if (!val)
+	val = &sv_undef;
+
+    if (key > AvMAX(av))
+	av_extend(av,key);
+    if (AvREIFY(av))
+	av_reify(av);
+
+    ary = AvARRAY(av);
+    if (AvFILL(av) < key) {
+	if (!AvREAL(av)) {
+	    if (av == stack && key > stack_sp - stack_base)
+		stack_sp = stack_base + key;	/* XPUSH in disguise */
+	    do
+		ary[++AvFILL(av)] = &sv_undef;
+	    while (AvFILL(av) < key);
+	}
+	AvFILL(av) = key;
+    }
+    else if (AvREAL(av))
+	SvREFCNT_dec(ary[key]);
+    ary[key] = val;
+    if (SvSMAGICAL(av)) {
+	if (val != &sv_undef) {
+	    MAGIC* mg = SvMAGIC(av);
+	    sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key);
+	}
+	mg_set((SV*)av);
+    }
+    return &ary[key];
+}
+
+AV *
+newAV()
+{
+    register AV *av;
+
+    av = (AV*)NEWSV(3,0);
+    sv_upgrade((SV *)av, SVt_PVAV);
+    AvREAL_on(av);
+    AvALLOC(av) = 0;
+    SvPVX(av) = 0;
+    AvMAX(av) = AvFILL(av) = -1;
+    return av;
+}
+
+AV *
+av_make(size,strp)
+register I32 size;
+register SV **strp;
+{
+    register AV *av;
+    register I32 i;
+    register SV** ary;
+
+    av = (AV*)NEWSV(8,0);
+    sv_upgrade((SV *) av,SVt_PVAV);
+    New(4,ary,size+1,SV*);
+    AvALLOC(av) = ary;
+    AvFLAGS(av) = AVf_REAL;
+    SvPVX(av) = (char*)ary;
+    AvFILL(av) = size - 1;
+    AvMAX(av) = size - 1;
+    for (i = 0; i < size; i++) {
+	assert (*strp);
+	ary[i] = NEWSV(7,0);
+	sv_setsv(ary[i], *strp);
+	strp++;
+    }
+    return av;
+}
+
+AV *
+av_fake(size,strp)
+register I32 size;
+register SV **strp;
+{
+    register AV *av;
+    register SV** ary;
+
+    av = (AV*)NEWSV(9,0);
+    sv_upgrade((SV *)av, SVt_PVAV);
+    New(4,ary,size+1,SV*);
+    AvALLOC(av) = ary;
+    Copy(strp,ary,size,SV*);
+    AvFLAGS(av) = AVf_REIFY;
+    SvPVX(av) = (char*)ary;
+    AvFILL(av) = size - 1;
+    AvMAX(av) = size - 1;
+    while (size--) {
+	assert (*strp);
+	SvTEMP_off(*strp);
+	strp++;
+    }
+    return av;
+}
+
+void
+av_clear(av)
+register AV *av;
+{
+    register I32 key;
+    SV** ary;
+
+    if (!av || AvMAX(av) < 0)
+	return;
+    /*SUPPRESS 560*/
+
+    if (AvREAL(av)) {
+	ary = AvARRAY(av);
+	key = AvFILL(av) + 1;
+	while (key) {
+	    SvREFCNT_dec(ary[--key]);
+	    ary[key] = &sv_undef;
+	}
+    }
+    if (key = AvARRAY(av) - AvALLOC(av)) {
+	AvMAX(av) += key;
+	SvPVX(av) = (char*)AvALLOC(av);
+    }
+    AvFILL(av) = -1;
+}
+
+void
+av_undef(av)
+register AV *av;
+{
+    register I32 key;
+
+    if (!av)
+	return;
+    /*SUPPRESS 560*/
+    if (AvREAL(av)) {
+	key = AvFILL(av) + 1;
+	while (key)
+	    SvREFCNT_dec(AvARRAY(av)[--key]);
+    }
+    if (key = AvARRAY(av) - AvALLOC(av)) {
+	AvMAX(av) += key;
+	SvPVX(av) = (char*)AvALLOC(av);
+    }
+    Safefree(AvALLOC(av));
+    AvALLOC(av) = 0;
+    SvPVX(av) = 0;
+    AvMAX(av) = AvFILL(av) = -1;
+    if (AvARYLEN(av)) {
+	SvREFCNT_dec(AvARYLEN(av));
+	AvARYLEN(av) = 0;
+    }
+}
+
+void
+av_push(av,val)
+register AV *av;
+SV *val;
+{
+    if (!av)
+	return;
+    av_store(av,AvFILL(av)+1,val);
+}
+
+SV *
+av_pop(av)
+register AV *av;
+{
+    SV *retval;
+
+    if (!av || AvFILL(av) < 0)
+	return &sv_undef;
+    retval = AvARRAY(av)[AvFILL(av)];
+    AvARRAY(av)[AvFILL(av)--] = &sv_undef;
+    if (SvSMAGICAL(av))
+	mg_set((SV*)av);
+    return retval;
+}
+
+void
+av_unshift(av,num)
+register AV *av;
+register I32 num;
+{
+    register I32 i;
+    register SV **sstr,**dstr;
+
+    if (!av || num <= 0)
+	return;
+    if (!AvREAL(av)) {
+	if (AvREIFY(av))
+	    av_reify(av);
+	else
+	    croak("Can't unshift");
+    }
+    i = AvARRAY(av) - AvALLOC(av);
+    if (i) {
+	if (i > num)
+	    i = num;
+	num -= i;
+    
+	AvMAX(av) += i;
+	AvFILL(av) += i;
+	SvPVX(av) = (char*)(AvARRAY(av) - i);
+    }
+    if (num) {
+	av_extend(av,AvFILL(av)+num);
+	AvFILL(av) += num;
+	dstr = AvARRAY(av) + AvFILL(av);
+	sstr = dstr - num;
+#ifdef BUGGY_MSC5
+ # pragma loop_opt(off)	/* don't loop-optimize the following code */
+#endif /* BUGGY_MSC5 */
+	for (i = AvFILL(av) - num; i >= 0; --i) {
+	    *dstr-- = *sstr--;
+#ifdef BUGGY_MSC5
+ # pragma loop_opt()	/* loop-optimization back to command-line setting */
+#endif /* BUGGY_MSC5 */
+	}
+	while (num)
+	    AvARRAY(av)[--num] = &sv_undef;
+    }
+}
+
+SV *
+av_shift(av)
+register AV *av;
+{
+    SV *retval;
+
+    if (!av || AvFILL(av) < 0)
+	return &sv_undef;
+    retval = *AvARRAY(av);
+    if (AvREAL(av))
+	*AvARRAY(av) = &sv_undef;
+    SvPVX(av) = (char*)(AvARRAY(av) + 1);
+    AvMAX(av)--;
+    AvFILL(av)--;
+    if (SvSMAGICAL(av))
+	mg_set((SV*)av);
+    return retval;
+}
+
+I32
+av_len(av)
+register AV *av;
+{
+    return AvFILL(av);
+}
+
+void
+av_fill(av, fill)
+register AV *av;
+I32 fill;
+{
+    if (!av)
+	croak("panic: null array");
+    if (fill < 0)
+	fill = -1;
+    if (fill <= AvMAX(av)) {
+	I32 key = AvFILL(av);
+	SV** ary = AvARRAY(av);
+
+	if (AvREAL(av)) {
+	    while (key > fill) {
+		SvREFCNT_dec(ary[key]);
+		ary[key--] = &sv_undef;
+	    }
+	}
+	else {
+	    while (key < fill)
+		ary[++key] = &sv_undef;
+	}
+	    
+	AvFILL(av) = fill;
+	if (SvSMAGICAL(av))
+	    mg_set((SV*)av);
+    }
+    else
+	(void)av_store(av,fill,&sv_undef);
+}
diff --git a/gnu/usr.bin/perl/av.h b/gnu/usr.bin/perl/av.h
new file mode 100644
index 00000000000..93dcc0cfdc9
--- /dev/null
+++ b/gnu/usr.bin/perl/av.h
@@ -0,0 +1,48 @@
+/*    av.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+struct xpvav {
+    char*	xav_array;	/* pointer to malloced string */
+    SSize_t	xav_fill;
+    SSize_t	xav_max;
+    IV		xof_off;	/* ptr is incremented by offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    SV**	xav_alloc;
+    SV*		xav_arylen;
+    U8		xav_flags;
+};
+
+#define AVf_REAL 1	/* free old entries */
+#define AVf_REIFY 2	/* can become real */
+#define AVf_REUSED 4	/* got undeffed--don't turn old memory into SVs now */
+
+#define Nullav Null(AV*)
+
+#define AvARRAY(av)	((SV**)((XPVAV*)  SvANY(av))->xav_array)
+#define AvALLOC(av)	((XPVAV*)  SvANY(av))->xav_alloc
+#define AvMAX(av)	((XPVAV*)  SvANY(av))->xav_max
+#define AvFILL(av)	((XPVAV*)  SvANY(av))->xav_fill
+#define AvARYLEN(av)	((XPVAV*)  SvANY(av))->xav_arylen
+#define AvFLAGS(av)	((XPVAV*)  SvANY(av))->xav_flags
+
+#define AvREAL(av)	(AvFLAGS(av) & AVf_REAL)
+#define AvREAL_on(av)	(AvFLAGS(av) |= AVf_REAL)
+#define AvREAL_off(av)	(AvFLAGS(av) &= ~AVf_REAL)
+#define AvREIFY(av)	(AvFLAGS(av) & AVf_REIFY)
+#define AvREIFY_on(av)	(AvFLAGS(av) |= AVf_REIFY)
+#define AvREIFY_off(av)	(AvFLAGS(av) &= ~AVf_REIFY)
+#define AvREUSED(av)	(AvFLAGS(av) & AVf_REUSED)
+#define AvREUSED_on(av)	(AvFLAGS(av) |= AVf_REUSED)
+#define AvREUSED_off(av) (AvFLAGS(av) &= ~AVf_REUSED)
+
+#define AvREALISH(av)	AvFLAGS(av)	/* REAL or REIFY -- shortcut */
+
diff --git a/gnu/usr.bin/perl/cflags.SH b/gnu/usr.bin/perl/cflags.SH
new file mode 100644
index 00000000000..9dc5c90127b
--- /dev/null
+++ b/gnu/usr.bin/perl/cflags.SH
@@ -0,0 +1,133 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting cflags (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+$spitshell >cflags <<!GROK!THIS!
+$startsh
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>cflags <<'!NO!SUBS!'
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+
+perltype=''
+optdebug=''	# ensure -g used if building a -DDEBUGGING libperl
+case $# in
+2) case $1 in
+    *perl.*)    perltype='';;
+    *perld.*)   perltype='-DDEBUGGING'; optdebug='-g' ;;
+    *perle.*)   perltype='-DEMBED';;
+    *perlde.*)  perltype='-DDEBUGGING -DEMBED'; optdebug='-g' ;;
+    *perlm.*)   perltype='-DEMBED -DMULTIPLICITY';;
+    *perldm.*)  perltype='-DDEBUGGING -DEMBED -DMULTIPLICITY'; optdebug='-g' ;;
+    esac
+    shift ;;
+esac
+
+also=': '
+case $# in
+1) also='echo 1>&2 "	  CCCMD = "'
+esac
+
+case $# in
+0) set *.c; echo "The current C flags are:" ;;
+esac
+
+set `echo "$* " | sed -e 's/\.[oc] / /g' -e 's/\.obj / /g'`
+
+for file do
+
+    case "$#" in
+    1) ;;
+    *) echo $n "    $file.c	$c" ;;
+    esac
+
+    : allow variables like toke_cflags to be evaluated
+
+    eval 'eval ${'"${file}_cflags"'-""}'
+
+    : or customize here
+
+    case "$file" in
+    DB_File) ;;
+    GDBM_File) ;;
+    NDBM_File) ;;
+    ODBM_File) ;;
+    POSIX) ;;
+    SDBM_File) ;;
+    av) ;;
+    deb) ;;
+    dl) ;;
+    doio) ;;
+    doop) ;;
+    dump) ;;
+    gv) ;;
+    hv) ;;
+    main) ;;
+    malloc) ;;
+    mg) ;;
+    miniperlmain) ;;
+    op) ;;
+    perl) ;;
+    perlmain) ;;
+    perly) ;;
+    pp) ;;
+    pp_ctl) ;;
+    pp_hot) ;;
+    pp_sys) ;;
+    regcomp) ;;
+    regexec) ;;
+    run) ;;
+    scope) ;;
+    sv) ;;
+    taint) ;;
+    toke) ;;
+    usersub) ;;
+    util) ;;
+    *) ;;
+    esac
+
+	if test "X$optdebug" != "X"; then
+		optimize="$optdebug"
+	fi
+
+    echo "$cc -c $ccflags $optimize $perltype $large $split"
+    eval "$also "'"$cc -c $ccflags $optimize $perltype $large $split"'
+
+    . $TOP/config.sh
+
+done
+!NO!SUBS!
+chmod 755 cflags
+$eunicefix cflags
diff --git a/gnu/usr.bin/perl/config.sh.OpenBSD b/gnu/usr.bin/perl/config.sh.OpenBSD
new file mode 100644
index 00000000000..417d7701acf
--- /dev/null
+++ b/gnu/usr.bin/perl/config.sh.OpenBSD
@@ -0,0 +1,487 @@
+#!/bin/sh
+#
+# This file was produced by running the Configure script. It holds all the
+# definitions figured out by Configure. Should you modify one of these values,
+# do not forget to propagate your changes by running "Configure -der". You may
+# instead choose to run each of the .SH files by yourself, or "Configure -S".
+#
+
+# Configuration time: Sun Aug 18 18:11:40 PDT 1996
+# Configured by: downsj
+# Target system: openbsd threadway 1.2 threadway#36 i386 
+
+Author=''
+Date='$Date'
+Header=''
+Id='$Id'
+Locker=''
+Log='$Log'
+Mcc='Mcc'
+RCSfile='$RCSfile'
+Revision='$Revision'
+Source=''
+State=''
+afs='false'
+alignbytes=''
+aphostname=''
+ar='ar'
+archlib="/usr/lib/perl5/`machine`-openbsd/5.003"
+archlibexp="/usr/lib/perl5/`machine`-openbsd/5.003"
+archname="`machine`-openbsd"
+archobjs=''
+awk='awk'
+baserev='5.0'
+bash=''
+bin='/usr/bin'
+binexp='/usr/bin'
+bison=''
+byacc='yacc'
+byteorder=''
+c=''
+castflags='0'
+cat='cat'
+cc='cc'
+cccdlflags='-DPIC -fpic'
+ccdlflags=' '
+ccflags=''
+cf_by='downsj'
+cf_email='downsj@threadway.teeny.org'
+cf_time='Sun Aug 18 18:11:40 PDT 1996'
+chgrp=''
+chmod=''
+chown=''
+clocktype='clock_t'
+comm='comm'
+compress=''
+contains='grep'
+cp='cp'
+cpio=''
+cpp='cpp'
+cpp_stuff='42'
+cppflags=''
+cpplast='-'
+cppminus='-'
+cpprun='cc -E'
+cppstdin='cc -E'
+cryptlib=''
+csh='csh'
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_access='define'
+d_alarm='define'
+d_archlib='define'
+d_attribut='define'
+d_bcmp='define'
+d_bcopy='define'
+d_bsd='define'
+d_bsdpgrp='define'
+d_bzero='define'
+d_casti32='define'
+d_castneg='define'
+d_charvspr='undef'
+d_chown='define'
+d_chroot='define'
+d_chsize='undef'
+d_closedir='define'
+d_const='define'
+d_crypt='define'
+d_csh='define'
+d_cuserid='undef'
+d_dbl_dig='define'
+d_difftime='define'
+d_dirnamlen='define'
+d_dlerror='define'
+d_dlopen='define'
+d_dlsymun='define'
+d_dosuid='undef'
+d_dup2='define'
+d_eofnblk='define'
+d_eunice='undef'
+d_fchmod='define'
+d_fchown='define'
+d_fcntl='define'
+d_fd_macros='define'
+d_fd_set='define'
+d_fds_bits='define'
+d_fgetpos='define'
+d_flexfnam='define'
+d_flock='define'
+d_fork='define'
+d_fpathconf='define'
+d_fsetpos='define'
+d_getgrps='define'
+d_gethent='undef'
+d_gethname='undef'
+d_getlogin='define'
+d_getpgrp2='undef'
+d_getpgrp='define'
+d_getppid='define'
+d_getprior='define'
+d_htonl='define'
+d_index='undef'
+d_isascii='define'
+d_killpg='define'
+d_link='define'
+d_locconv='define'
+d_lockf='undef'
+d_lstat='define'
+d_mblen='define'
+d_mbstowcs='define'
+d_mbtowc='define'
+d_memcmp='define'
+d_memcpy='define'
+d_memmove='define'
+d_memset='define'
+d_mkdir='define'
+d_mkfifo='define'
+d_mktime='define'
+d_msg='define'
+d_msgctl='define'
+d_msgget='define'
+d_msgrcv='define'
+d_msgsnd='define'
+d_mymalloc='undef'
+d_nice='define'
+d_oldarchlib='undef'
+d_oldsock='undef'
+d_open3='define'
+d_pathconf='define'
+d_pause='define'
+d_phostname='undef'
+d_pipe='define'
+d_poll='define'
+d_portable='define'
+d_pwage='undef'
+d_pwchange='define'
+d_pwclass='define'
+d_pwcomment='undef'
+d_pwexpire='define'
+d_pwquota='undef'
+d_readdir='define'
+d_readlink='define'
+d_rename='define'
+d_rewinddir='define'
+d_rmdir='define'
+d_safebcpy='define'
+d_safemcpy='define'
+d_seekdir='define'
+d_select='define'
+d_sem='define'
+d_semctl='define'
+d_semget='define'
+d_semop='define'
+d_setegid='define'
+d_seteuid='define'
+d_setlinebuf='define'
+d_setlocale='define'
+d_setpgid='define'
+d_setpgrp2='undef'
+d_setpgrp='define'
+d_setprior='define'
+d_setregid='undef'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+d_setsid='define'
+d_shm='define'
+d_shmat='define'
+d_shmatprototype='define'
+d_shmctl='define'
+d_shmdt='define'
+d_shmget='define'
+d_shrplib='undef'
+d_sigaction='define'
+d_sigintrp=''
+d_sigsetjmp='define'
+d_sigvec='define'
+d_sigvectr='undef'
+d_socket='define'
+d_sockpair='define'
+d_statblks='define'
+d_stdio_cnt_lval='undef'
+d_stdio_ptr_lval='undef'
+d_stdiobase='undef'
+d_stdstdio='undef'
+d_strchr='define'
+d_strcoll='define'
+d_strctcpy='define'
+d_strerrm='strerror(e)'
+d_strerror='define'
+d_strxfrm='define'
+d_suidsafe='undef'
+d_symlink='define'
+d_syscall='define'
+d_sysconf='define'
+d_sysernlst=''
+d_syserrlst='define'
+d_system='define'
+d_tcgetpgrp='define'
+d_tcsetpgrp='define'
+d_telldir='define'
+d_time='define'
+d_times='define'
+d_truncate='define'
+d_tzname='define'
+d_umask='define'
+d_uname='define'
+d_vfork='undef'
+d_void_closedir='undef'
+d_voidsig='define'
+d_voidtty=''
+d_volatile='define'
+d_vprintf='define'
+d_wait4='define'
+d_waitpid='define'
+d_wcstombs='define'
+d_wctomb='define'
+d_xenix='undef'
+date='date'
+db_hashtype='u_int32_t'
+db_prefixtype='size_t'
+defvoidused='15'
+direntrytype='struct dirent'
+dlext='so'
+dlsrc='dl_dlopen.xs'
+dynamic_ext='DB_File Fcntl FileHandle POSIX SDBM_File Safe Socket'
+eagain='EAGAIN'
+echo='echo'
+egrep='egrep'
+emacs=''
+eunicefix=':'
+exe_ext=''
+expr='expr'
+extensions='DB_File Fcntl FileHandle POSIX SDBM_File Safe Socket'
+find='find'
+firstmakefile='makefile'
+flex=''
+fpostype='fpos_t'
+freetype='void'
+full_csh='/bin/csh'
+full_sed='/usr/bin/sed'
+gcc=''
+gccversion='2.7.2.1'
+gidtype='gid_t'
+glibpth='/usr/shlib  /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
+grep='grep'
+groupcat=''
+groupstype='gid_t'
+h_fcntl='false'
+h_sysfile='true'
+hint='previous'
+hostcat=''
+huge=''
+i_bsdioctl=''
+i_db='define'
+i_dbm='undef'
+i_dirent='define'
+i_dld='undef'
+i_dlfcn='define'
+i_fcntl='undef'
+i_float='define'
+i_gdbm='undef'
+i_grp='define'
+i_limits='define'
+i_locale='define'
+i_malloc='define'
+i_math='define'
+i_memory='undef'
+i_ndbm='define'
+i_neterrno='undef'
+i_niin='define'
+i_pwd='define'
+i_rpcsvcdbm='undef'
+i_sgtty='undef'
+i_stdarg='define'
+i_stddef='define'
+i_stdlib='define'
+i_string='define'
+i_sysdir='define'
+i_sysfile='define'
+i_sysfilio='define'
+i_sysin='undef'
+i_sysioctl='define'
+i_sysndir='undef'
+i_sysparam='define'
+i_sysselct='define'
+i_syssockio=''
+i_sysstat='define'
+i_systime='define'
+i_systimek='undef'
+i_systimes='define'
+i_systypes='define'
+i_sysun='define'
+i_termio='undef'
+i_termios='define'
+i_time='undef'
+i_unistd='define'
+i_utime='define'
+i_varargs='undef'
+i_varhdr='stdarg.h'
+i_vfork='undef'
+incpath=''
+inews=''
+installarchlib="/usr/lib/perl5/`machine`-openbsd/5.003"
+installbin='/usr/bin'
+installman1dir=''
+installman3dir=''
+installprivlib='/usr/lib/perl5'
+installscript='/usr/bin'
+installsitearch="/usr/lib/perl5/site_perl/`machine`-openbsd"
+installsitelib='/usr/lib/perl5/site_perl'
+intsize='4'
+known_extensions='DB_File Fcntl FileHandle GDBM_File NDBM_File ODBM_File POSIX SDBM_File Safe Socket'
+ksh=''
+large=''
+ld='ld'
+lddlflags='-Bforcearchive -Bshareable '
+ldflags=''
+less='less'
+lib_ext='.a'
+libc='/usr/lib/libc.so.12.6'
+libpth='/usr/lib'
+libs='-lm -lc'
+libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl dld ld sun m c cposix posix ndir dir crypt ucb bsd BSD PW x'
+line='line'
+lint=''
+lkflags=''
+ln='ln'
+lns='/bin/ln -s'
+locincpth=''
+loclibpth=''
+lp=''
+lpr=''
+ls='ls'
+lseektype='off_t'
+mail=''
+mailx=''
+make=''
+mallocobj=''
+mallocsrc=''
+malloctype='void *'
+man1dir=' '
+man1direxp=''
+man1ext='0'
+man3dir=' '
+man3direxp=''
+man3ext='0'
+medium=''
+mips=''
+mips_type=''
+mkdir='mkdir'
+models='none'
+modetype='mode_t'
+more='more'
+mv=''
+myarchname="`machine`-openbsd"
+mydomain=''
+myhostname=''
+myuname='openbsd'
+n='-n'
+nm_opt=''
+nm_so_opt=''
+nroff='nroff'
+o_nonblock='O_NONBLOCK'
+obj_ext='.o'
+oldarchlib=''
+oldarchlibexp=''
+optimize='-O2'
+orderlib='false'
+osname='openbsd'
+osvers="`uname -r`"
+package='perl5'
+pager='/usr/bin/more'
+passcat=''
+patchlevel='3'
+path_sep=':'
+perl='perl'
+perladmin='downsj@threadway.teeny.org'
+perlpath='/usr/bin/perl'
+pg='pg'
+phostname='hostname'
+plibpth=''
+pmake=''
+pr=''
+prefix='/usr'
+prefixexp='/usr'
+privlib='/usr/lib/perl5'
+privlibexp='/usr/lib/perl5'
+prototype='define'
+randbits='31'
+ranlib='/usr/bin/ranlib'
+rd_nodata='-1'
+rm='rm'
+rmail=''
+runnm='true'
+scriptdir='/usr/bin'
+scriptdirexp='/usr/bin'
+sed='sed'
+selecttype='fd_set *'
+sendmail='sendmail'
+sh=''
+shar=''
+sharpbang='#!'
+shmattype='char *'
+shrpdir='none'
+shsharp='true'
+sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2 IOT '
+sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 6 '
+signal_t='void'
+sitearch="/usr/lib/perl5/site_perl/`machine`-openbsd"
+sitearchexp="/usr/lib/perl5/site_perl/`machine`-openbsd"
+sitelib='/usr/lib/perl5/site_perl'
+sitelibexp='/usr/lib/perl5/site_perl'
+sizetype='size_t'
+sleep=''
+smail=''
+small=''
+so='so'
+sockethdr=''
+socketlib=''
+sort='sort'
+spackage='Perl5'
+spitshell='cat'
+split=''
+ssizetype='ssize_t'
+startperl='#!/usr/bin/perl'
+startsh='#!/bin/sh'
+static_ext=' '
+stdchar='char'
+stdio_base='((fp)->_base)'
+stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)'
+stdio_cnt='((fp)->_cnt)'
+stdio_ptr='((fp)->_ptr)'
+strings='/usr/include/string.h'
+submit=''
+subversion='0'
+sysman='/usr/man/man1'
+tail=''
+tar=''
+tbl=''
+test='test'
+timeincl='/usr/include/sys/time.h '
+timetype='time_t'
+touch='touch'
+tr='tr'
+troff=''
+uidtype='uid_t'
+uname='uname'
+uniq='uniq'
+usedl='define'
+usemymalloc='n'
+usenm='true'
+useposix='true'
+usesafe='true'
+usevfork='false'
+usrinc='/usr/include'
+uuname=''
+vi=''
+voidflags='15'
+xlibpth=''
+zcat=''
+PATCHLEVEL=3
+SUBVERSION=0
+LOCAL_PATCH_COUNT=\
+CONFIG=true
+# Variables propagated from previous config.sh file.
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
diff --git a/gnu/usr.bin/perl/config_H b/gnu/usr.bin/perl/config_H
new file mode 100644
index 00000000000..da9c35b50ee
--- /dev/null
+++ b/gnu/usr.bin/perl/config_H
@@ -0,0 +1,1582 @@
+/* This file (config_H) is a sample config.h file.  If you are unable
+   to successfully run Configure, copy this file to config.h and
+   edit it to suit your system.
+*/
+/*
+ * This file was produced by running the config_h.SH script, which
+ * gets its values from config.sh, which is generally produced by
+ * running Configure.
+ *
+ * Feel free to modify any of this as the need arises.  Note, however,
+ * that running config_h.SH again will wipe out any changes you've made.
+ * For a more permanent change edit config.sh and rerun config_h.SH.
+ *
+ * $Id: config_H,v 1.1.1.1 1996/08/19 10:11:36 downsj Exp $
+ */
+
+/* Configuration time: Mon Mar 18 23:11:24 EST 1996
+ * Configured by: bailey
+ * Target system: sunos agave.humgen.upenn.edu 5.4 generic_101945-13 sun4m sparc 
+ */
+
+#ifndef _config_h_
+#define _config_h_
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double. Usual values are 2, 4 and 8.
+ */
+#define MEM_ALIGNBYTES 4	/**/
+
+/* BIN:
+ *	This symbol holds the path of the bin directory where the package will
+ *	be installed. Program must be prepared to deal with ~name substitution.
+ */
+#define BIN "/usr/local/bin"	/**/
+
+/* CAT2:
+ *	This macro catenates 2 tokens together.
+ */
+#if 42 == 1
+#define CAT2(a,b)a/**/b
+#define CAT3(a,b,c)a/**/b/**/c
+#define CAT4(a,b,c,d)a/**/b/**/c/**/d
+#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
+#define STRINGIFY(a)"a"
+		/* If you can get stringification with catify, tell me how! */
+#endif
+#if 42 == 42
+#define CAT2(a,b)a ## b
+#define CAT3(a,b,c)a ## b ## c
+#define CAT4(a,b,c,d)a ## b ## c ## d
+#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
+#define StGiFy(a)# a
+#define STRINGIFY(a)StGiFy(a)
+#define SCAT2(a,b)StGiFy(a) StGiFy(b)
+#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
+#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
+#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
+#endif
+#ifndef CAT2
+#include "Bletch: How does this C preprocessor catenate tokens?"
+#endif
+
+/* CPPSTDIN:
+ *	This symbol contains the first part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.	 Typical value of "cc -E" or "/lib/cpp", but it can also
+ *	call a wrapper. See CPPRUN.
+ */
+/* CPPMINUS:
+ *	This symbol contains the second part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.  This symbol will have the value "-" if CPPSTDIN needs a minus
+ *	to specify standard input, otherwise the value is "".
+ */
+#define CPPSTDIN "cc -E"
+#define CPPMINUS "-"
+
+/* HAS_ALARM:
+ *	This symbol, if defined, indicates that the alarm routine is
+ *	available.
+ */
+#define HAS_ALARM		/**/
+
+/* HASATTRIBUTE:
+ *	This symbol indicates the C compiler can check for function attributes,
+ *	such as printf formats. This is normally only supported by GNU cc.
+ */
+/*#define HASATTRIBUTE 	/**/
+#ifndef HASATTRIBUTE
+#define __attribute__(_arg_)
+#endif
+
+/* HAS_BCMP:
+ *	This symbol is defined if the bcmp() routine is available to
+ *	compare blocks of memory.
+ */
+/*#define HAS_BCMP	/**/
+
+/* HAS_BCOPY:
+ *	This symbol is defined if the bcopy() routine is available to
+ *	copy blocks of memory.
+ */
+/*#define HAS_BCOPY	/**/
+
+/* HAS_BZERO:
+ *	This symbol is defined if the bzero() routine is available to
+ *	set a memory block to 0.
+ */
+/*#define HAS_BZERO	/**/
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#define	CASTI32		/**/
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ *		4 = couldn't cast in argument expression list
+ */
+#define	CASTNEGFLOAT		/**/
+#define CASTFLAGS 0		/**/
+
+/* HAS_CHOWN:
+ *	This symbol, if defined, indicates that the chown routine is
+ *	available.
+ */
+#define HAS_CHOWN		/**/
+
+/* HAS_CHROOT:
+ *	This symbol, if defined, indicates that the chroot routine is
+ *	available.
+ */
+#define HAS_CHROOT		/**/
+
+/* HAS_CHSIZE:
+ *	This symbol, if defined, indicates that the chsize routine is available
+ *	to truncate files.  You might need a -lx to get this routine.
+ */
+/*#define	HAS_CHSIZE		/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+/*#define VOID_CLOSEDIR		/**/
+
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
+ */
+#define HASCONST	/**/
+#ifndef HASCONST
+#define const
+#endif
+
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
+ */
+#define HAS_CRYPT		/**/
+
+/* HAS_CUSERID:
+ *	This symbol, if defined, indicates that the cuserid routine is
+ *	available to get character login names.
+ */
+#define HAS_CUSERID		/**/
+
+/* HAS_DBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol DBL_DIG, which is the number
+ *	of significant digits in a double precision number.  If this
+ *	symbol is not defined, a guess of 15 is usually pretty good.
+ */
+#define HAS_DBL_DIG 	/* */
+
+/* HAS_DIFFTIME:
+ *	This symbol, if defined, indicates that the difftime routine is
+ *	available.
+ */
+#define HAS_DIFFTIME		/**/
+
+/* HAS_DLERROR:
+ *	This symbol, if defined, indicates that the dlerror routine is
+ *	available to return a string describing the last error that
+ *	occurred from a call to dlopen(), dlclose() or dlsym().
+ */
+#define HAS_DLERROR	/**/
+
+/* HAS_DUP2:
+ *	This symbol, if defined, indicates that the dup2 routine is
+ *	available to duplicate file descriptors.
+ */
+#define HAS_DUP2	/**/
+
+/* HAS_FCHMOD:
+ *	This symbol, if defined, indicates that the fchmod routine is available
+ *	to change mode of opened files.  If unavailable, use chmod().
+ */
+#define HAS_FCHMOD		/**/
+
+/* HAS_FCHOWN:
+ *	This symbol, if defined, indicates that the fchown routine is available
+ *	to change ownership of opened files.  If unavailable, use chown().
+ */
+#define HAS_FCHOWN		/**/
+
+/* HAS_FCNTL:
+ *	This symbol, if defined, indicates to the C program that
+ *	the fcntl() function exists.
+ */
+#define HAS_FCNTL		/**/
+
+/* HAS_FGETPOS:
+ *	This symbol, if defined, indicates that the fgetpos routine is
+ *	available to get the file position indicator, similar to ftell().
+ */
+#define HAS_FGETPOS	/**/
+
+/* FLEXFILENAMES:
+ *	This symbol, if defined, indicates that the system supports filenames
+ *	longer than 14 characters.
+ */
+#define	FLEXFILENAMES		/**/
+
+/* HAS_FLOCK:
+ *	This symbol, if defined, indicates that the flock routine is
+ *	available to do file locking.
+ */
+/*#define HAS_FLOCK		/**/
+
+/* HAS_FORK:
+ *	This symbol, if defined, indicates that the fork routine is
+ *	available.
+ */
+#define HAS_FORK		/**/
+
+/* HAS_FSETPOS:
+ *	This symbol, if defined, indicates that the fsetpos routine is
+ *	available to set the file position indicator, similar to fseek().
+ */
+#define HAS_FSETPOS	/**/
+
+/* HAS_GETGROUPS:
+ *	This symbol, if defined, indicates that the getgroups() routine is
+ *	available to get the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+#define HAS_GETGROUPS		/**/
+
+/* HAS_GETHOSTENT:
+ *	This symbol, if defined, indicates that the gethostent routine is
+ *	available to lookup host names in some data base or other.
+ */
+#define HAS_GETHOSTENT		/**/
+
+/* HAS_UNAME:
+ *	This symbol, if defined, indicates that the C program may use the
+ *	uname() routine to derive the host name.  See also HAS_GETHOSTNAME
+ *	and PHOSTNAME.
+ */
+#define HAS_UNAME		/**/
+
+/* HAS_GETLOGIN:
+ *	This symbol, if defined, indicates that the getlogin routine is
+ *	available to get the login name.
+ */
+#define HAS_GETLOGIN		/**/
+
+/* HAS_GETPGRP:
+ *	This symbol, if defined, indicates that the getpgrp routine is
+ *	available to get the current process group.
+ */
+#define HAS_GETPGRP		/**/
+
+/* HAS_GETPGRP2:
+ *	This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ *	routine is available to get the current process group.
+ */
+/*#define HAS_GETPGRP2		/**/
+
+/* HAS_GETPPID:
+ *	This symbol, if defined, indicates that the getppid routine is
+ *	available to get the parent process ID.
+ */
+#define HAS_GETPPID		/**/
+
+/* HAS_GETPRIORITY:
+ *	This symbol, if defined, indicates that the getpriority routine is
+ *	available to get a process's priority.
+ */
+/*#define HAS_GETPRIORITY		/**/
+
+/* HAS_HTONL:
+ *	This symbol, if defined, indicates that the htonl() routine (and
+ *	friends htons() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_HTONS:
+ *	This symbol, if defined, indicates that the htons() routine (and
+ *	friends htonl() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHL:
+ *	This symbol, if defined, indicates that the ntohl() routine (and
+ *	friends htonl() htons() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHS:
+ *	This symbol, if defined, indicates that the ntohs() routine (and
+ *	friends htonl() htons() ntohl()) are available to do network
+ *	order byte swapping.
+ */
+#define HAS_HTONL		/**/
+#define HAS_HTONS		/**/
+#define HAS_NTOHL		/**/
+#define HAS_NTOHS		/**/
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that isascii 
+ *	is available.
+ */
+#define HAS_ISASCII		/**/
+
+/* HAS_KILLPG:
+ *	This symbol, if defined, indicates that the killpg routine is available
+ *	to kill process groups.  If unavailable, you probably should use kill
+ *	with a negative process number.
+ */
+/*#define HAS_KILLPG	/**/
+
+/* HAS_LINK:
+ *	This symbol, if defined, indicates that the link routine is
+ *	available to create hard links.
+ */
+#define HAS_LINK	/**/
+
+/* HAS_LOCALECONV:
+ *	This symbol, if defined, indicates that the localeconv routine is
+ *	available for numeric and monetary formatting conventions.
+ */
+#define HAS_LOCALECONV	/**/
+
+/* HAS_LOCKF:
+ *	This symbol, if defined, indicates that the lockf routine is
+ *	available to do file locking.
+ */
+#define HAS_LOCKF		/**/
+
+/* HAS_LSTAT:
+ *	This symbol, if defined, indicates that the lstat routine is
+ *	available to do file stats on symbolic links.
+ */
+#define HAS_LSTAT		/**/
+
+/* HAS_MBLEN:
+ *	This symbol, if defined, indicates that the mblen routine is available
+ *	to find the number of bytes in a multibye character.
+ */
+#define HAS_MBLEN		/**/
+
+/* HAS_MBSTOWCS:
+ *	This symbol, if defined, indicates that the mbstowcs routine is
+ *	available to covert a multibyte string into a wide character string.
+ */
+#define	HAS_MBSTOWCS		/**/
+
+/* HAS_MBTOWC:
+ *	This symbol, if defined, indicates that the mbtowc routine is available
+ *	to covert a multibyte to a wide character.
+ */
+#define HAS_MBTOWC		/**/
+
+/* HAS_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	to compare blocks of memory.
+ */
+#define HAS_MEMCMP	/**/
+
+/* HAS_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy blocks of memory.
+ */
+#define HAS_MEMCPY	/**/
+
+/* HAS_MEMMOVE:
+ *	This symbol, if defined, indicates that the memmove routine is available
+ *	to copy potentially overlapping blocks of memory. This should be used
+ *	only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
+ *	own version.
+ */
+#define HAS_MEMMOVE	/**/
+
+/* HAS_MEMSET:
+ *	This symbol, if defined, indicates that the memset routine is available
+ *	to set blocks of memory.
+ */
+#define HAS_MEMSET	/**/
+
+/* HAS_MKDIR:
+ *	This symbol, if defined, indicates that the mkdir routine is available
+ *	to create directories.  Otherwise you should fork off a new process to
+ *	exec /bin/mkdir.
+ */
+#define HAS_MKDIR		/**/
+
+/* HAS_MKFIFO:
+ *	This symbol, if defined, indicates that the mkfifo routine is
+ *	available to create FIFOs. Otherwise, mknod should be able to
+ *	do it for you. However, if mkfifo is there, mknod might require
+ *	super-user privileges which mkfifo will not.
+ */
+#define HAS_MKFIFO		/**/
+
+/* HAS_MKTIME:
+ *	This symbol, if defined, indicates that the mktime routine is
+ *	available.
+ */
+#define HAS_MKTIME		/**/
+
+/* HAS_MSG:
+ *	This symbol, if defined, indicates that the entire msg*(2) library is
+ *	supported (IPC mechanism based on message queues).
+ */
+#define HAS_MSG		/**/
+
+/* HAS_NICE:
+ *	This symbol, if defined, indicates that the nice routine is
+ *	available.
+ */
+#define HAS_NICE		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+#define HAS_OPEN3		/**/
+
+/* HAS_PATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given filename.
+ */
+/* HAS_FPATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given open file descriptor.
+ */
+#define HAS_PATHCONF		/**/
+#define HAS_FPATHCONF		/**/
+
+/* HAS_PAUSE:
+ *	This symbol, if defined, indicates that the pause routine is
+ *	available to suspend a process until a signal is received.
+ */
+#define HAS_PAUSE		/**/
+
+/* HAS_PIPE:
+ *	This symbol, if defined, indicates that the pipe routine is
+ *	available to create an inter-process channel.
+ */
+#define HAS_PIPE		/**/
+
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.
+ */
+#define HAS_POLL		/**/
+
+/* HAS_READDIR:
+ *	This symbol, if defined, indicates that the readdir routine is
+ *	available to read directory entries. You may have to include
+ *	<dirent.h>. See I_DIRENT.
+ */
+#define HAS_READDIR		/**/
+
+/* HAS_SEEKDIR:
+ *	This symbol, if defined, indicates that the seekdir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_SEEKDIR		/**/
+
+/* HAS_TELLDIR:
+ *	This symbol, if defined, indicates that the telldir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_TELLDIR		/**/
+
+/* HAS_REWINDDIR:
+ *	This symbol, if defined, indicates that the rewinddir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_REWINDDIR		/**/
+
+/* HAS_READLINK:
+ *	This symbol, if defined, indicates that the readlink routine is
+ *	available to read the value of a symbolic link.
+ */
+#define HAS_READLINK		/**/
+
+/* HAS_RENAME:
+ *	This symbol, if defined, indicates that the rename routine is available
+ *	to rename files.  Otherwise you should do the unlink(), link(), unlink()
+ *	trick.
+ */
+#define HAS_RENAME	/**/
+
+/* HAS_RMDIR:
+ *	This symbol, if defined, indicates that the rmdir routine is
+ *	available to remove directories. Otherwise you should fork off a
+ *	new process to exec /bin/rmdir.
+ */
+#define HAS_RMDIR		/**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+/*#define HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+/*#define HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SELECT:
+ *	This symbol, if defined, indicates that the select routine is
+ *	available to select active file descriptors. If the timeout field
+ *	is used, <sys/time.h> may need to be included.
+ */
+#define HAS_SELECT	/**/
+
+/* HAS_SEM:
+ *	This symbol, if defined, indicates that the entire sem*(2) library is
+ *	supported.
+ */
+#define HAS_SEM		/**/
+
+/* HAS_SETEGID:
+ *	This symbol, if defined, indicates that the setegid routine is available
+ *	to change the effective gid of the current program.
+ */
+#define HAS_SETEGID		/**/
+
+/* HAS_SETEUID:
+ *	This symbol, if defined, indicates that the seteuid routine is available
+ *	to change the effective uid of the current program.
+ */
+#define HAS_SETEUID		/**/
+
+/* HAS_SETLINEBUF:
+ *	This symbol, if defined, indicates that the setlinebuf routine is
+ *	available to change stderr or stdout from block-buffered or unbuffered
+ *	to a line-buffered mode.
+ */
+/*#define HAS_SETLINEBUF		/**/
+
+/* HAS_SETLOCALE:
+ *	This symbol, if defined, indicates that the setlocale routine is
+ *	available to handle locale-specific ctype implementations.
+ */
+#define HAS_SETLOCALE	/**/
+
+/* HAS_SETPGID:
+ *	This symbol, if defined, indicates that the setpgid routine is
+ *	available to set process group ID.
+ */
+#define HAS_SETPGID	/**/
+
+/* HAS_SETPGRP:
+ *	This symbol, if defined, indicates that the setpgrp routine is
+ *	available to set the current process group.
+ */
+/* USE_BSDPGRP:
+ *	This symbol, if defined, indicates that the BSD notion of process
+ *	group is to be used. For instance, you have to say setpgrp(pid, pgrp)
+ *	instead of the USG setpgrp().
+ */
+#define HAS_SETPGRP		/**/
+/*#define USE_BSDPGRP		/**/
+
+/* HAS_SETPGRP2:
+ *	This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ *	routine is available to set the current process group.
+ */
+/*#define HAS_SETPGRP2		/**/
+
+/* HAS_SETPRIORITY:
+ *	This symbol, if defined, indicates that the setpriority routine is
+ *	available to set a process's priority.
+ */
+/*#define HAS_SETPRIORITY		/**/
+
+/* HAS_SETREGID:
+ *	This symbol, if defined, indicates that the setregid routine is
+ *	available to change the real and effective gid of the current
+ *	process.
+ */
+/* HAS_SETRESGID:
+ *	This symbol, if defined, indicates that the setresgid routine is
+ *	available to change the real, effective and saved gid of the current
+ *	process.
+ */
+/*#define HAS_SETREGID		/**/
+/*#define HAS_SETRESGID		/**/
+
+/* HAS_SETREUID:
+ *	This symbol, if defined, indicates that the setreuid routine is
+ *	available to change the real and effective uid of the current
+ *	process.
+ */
+/* HAS_SETRESUID:
+ *	This symbol, if defined, indicates that the setresuid routine is
+ *	available to change the real, effective and saved uid of the current
+ *	process.
+ */
+/*#define HAS_SETREUID		/**/
+/*#define HAS_SETRESUID		/**/
+
+/* HAS_SETRGID:
+ *	This symbol, if defined, indicates that the setrgid routine is available
+ *	to change the real gid of the current program.
+ */
+/*#define HAS_SETRGID		/**/
+
+/* HAS_SETRUID:
+ *	This symbol, if defined, indicates that the setruid routine is available
+ *	to change the real uid of the current program.
+ */
+/*#define HAS_SETRUID		/**/
+
+/* HAS_SETSID:
+ *	This symbol, if defined, indicates that the setsid routine is
+ *	available to set the process group ID.
+ */
+#define HAS_SETSID	/**/
+
+/* HAS_SHM:
+ *	This symbol, if defined, indicates that the entire shm*(2) library is
+ *	supported.
+ */
+#define HAS_SHM		/**/
+
+/* Shmat_t:
+ *	This symbol holds the return type of the shmat() system call.
+ *	Usually set to 'void *' or 'char *'.
+ */
+/* HAS_SHMAT_PROTOTYPE:
+ *	This symbol, if defined, indicates that the sys/shm.h includes
+ *	a prototype for shmat().  Otherwise, it is up to the program to
+ *	guess one.  Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
+ *	but not always right so it should be emitted by the program only
+ *	when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+#define Shmat_t void *	/**/
+#define HAS_SHMAT_PROTOTYPE	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+#define HAS_SIGACTION	/**/
+
+/* HAS_SOCKET:
+ *	This symbol, if defined, indicates that the BSD socket interface is
+ *	supported.
+ */
+/* HAS_SOCKETPAIR:
+ *	This symbol, if defined, indicates that the BSD socketpair() call is
+ *	supported.
+ */
+#define HAS_SOCKET		/**/
+#define HAS_SOCKETPAIR	/**/
+
+/* USE_STAT_BLOCKS:
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_blksize and st_blocks.
+ */
+#define USE_STAT_BLOCKS 	/**/
+
+/* USE_STDIO_PTR:
+ *	This symbol is defined if the _ptr and _cnt fields (or similar)
+ *	of the stdio FILE structure can be used to access the stdio buffer
+ *	for a file handle.  If this is defined, then the FILE_ptr(fp)
+ *	and FILE_cnt(fp) macros will also be defined and should be used
+ *	to access these fields.
+ */
+/* USE_STDIO_BASE:
+ *	This symbol is defined if the _base field (or similar) of the
+ *	stdio FILE structure can be used to access the stdio buffer for
+ *	a file handle.  If this is defined, then the FILE_base(fp) macro
+ *	will also be defined and should be used to access this field.
+ *	Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ *	to determine the number of bytes in the buffer.  USE_STDIO_BASE
+ *	will never be defined unless USE_STDIO_PTR is.
+ */
+#define USE_STDIO_PTR 	/**/
+#define USE_STDIO_BASE 	/**/
+
+/* FILE_ptr:
+ *	This macro is used to access the _ptr field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ *	This symbol is defined if the FILE_ptr macro can be used as an
+ *	lvalue.
+ */
+/* FILE_cnt:
+ *	This macro is used to access the _cnt field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ *	This symbol is defined if the FILE_cnt macro can be used as an
+ *	lvalue.
+ */
+#ifdef USE_STDIO_PTR
+#define FILE_ptr(fp)	((fp)->_ptr)
+#define STDIO_PTR_LVALUE 		/**/
+#define FILE_cnt(fp)	((fp)->_cnt)
+#define STDIO_CNT_LVALUE 		/**/
+#endif
+
+/* FILE_base:
+ *	This macro is used to access the _base field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_BASE is defined.
+ */
+/* FILE_bufsiz:
+ *	This macro is used to determine the number of bytes in the I/O
+ *	buffer pointed to by _base field (or equivalent) of the FILE
+ *	structure pointed to its argument. This macro will always be defined
+ *	if USE_STDIO_BASE is defined.
+ */
+#ifdef USE_STDIO_BASE
+#define FILE_base(fp)	((fp)->_base)
+#define FILE_bufsiz(fp)	((fp)->_cnt + (fp)->_ptr - (fp)->_base)
+#endif
+
+/* HAS_STRCHR:
+ *	This symbol is defined to indicate that the strchr()/strrchr()
+ *	functions are available for string searching. If not, try the
+ *	index()/rindex() pair.
+ */
+/* HAS_INDEX:
+ *	This symbol is defined to indicate that the index()/rindex()
+ *	functions are available for string searching.
+ */
+#define HAS_STRCHR	/**/
+/*#define HAS_INDEX	/**/
+
+/* HAS_STRCOLL:
+ *	This symbol, if defined, indicates that the strcoll routine is
+ *	available to compare strings using collating information.
+ */
+#define HAS_STRCOLL	/**/
+
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
+ */
+#define	USE_STRUCT_COPY	/**/
+
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
+ */
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#define HAS_STRERROR		/**/
+#define HAS_SYS_ERRLIST	/**/
+#define Strerror(e) strerror(e)
+
+/* HAS_STRXFRM:
+ *	This symbol, if defined, indicates that the strxfrm() routine is
+ *	available to transform strings.
+ */
+#define HAS_STRXFRM	/**/
+
+/* HAS_SYMLINK:
+ *	This symbol, if defined, indicates that the symlink routine is available
+ *	to create symbolic links.
+ */
+#define HAS_SYMLINK	/**/
+
+/* HAS_SYSCALL:
+ *	This symbol, if defined, indicates that the syscall routine is
+ *	available to call arbitrary system calls. If undefined, that's tough.
+ */
+#define HAS_SYSCALL	/**/
+
+/* HAS_SYSCONF:
+ *	This symbol, if defined, indicates that sysconf() is available
+ *	to determine system related limits and options.
+ */
+#define HAS_SYSCONF	/**/
+
+/* HAS_SYSTEM:
+ *	This symbol, if defined, indicates that the system routine is
+ *	available to issue a shell command.
+ */
+#define HAS_SYSTEM	/**/
+
+/* HAS_TCGETPGRP:
+ *	This symbol, if defined, indicates that the tcgetpgrp routine is
+ *	available to get foreground process group ID.
+ */
+#define HAS_TCGETPGRP		/**/
+
+/* HAS_TCSETPGRP:
+ *	This symbol, if defined, indicates that the tcsetpgrp routine is
+ *	available to set foreground process group ID.
+ */
+#define HAS_TCSETPGRP		/**/
+
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define Time_t time_t		/* Time type */
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES		/**/
+
+/* HAS_TRUNCATE:
+ *	This symbol, if defined, indicates that the truncate routine is
+ *	available to truncate files.
+ */
+#define HAS_TRUNCATE	/**/
+
+/* HAS_TZNAME:
+ *	This symbol, if defined, indicates that the tzname[] array is
+ *	available to access timezone names.
+ */
+#define HAS_TZNAME		/**/
+
+/* HAS_UMASK:
+ *	This symbol, if defined, indicates that the umask routine is
+ *	available to set and get the value of the file creation mask.
+ */
+#define HAS_UMASK		/**/
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+/*#define HAS_VFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile
+#endif
+
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
+ */
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
+ */
+#define HAS_VPRINTF	/**/
+/*#define USE_CHAR_VSPRINTF 	/**/
+
+/* HAS_WAIT4:
+ *	This symbol, if defined, indicates that wait4() exists.
+ */
+/*#define HAS_WAIT4	/**/
+
+/* HAS_WAITPID:
+ *	This symbol, if defined, indicates that the waitpid routine is
+ *	available to wait for child process.
+ */
+#define HAS_WAITPID	/**/
+
+/* HAS_WCSTOMBS:
+ *	This symbol, if defined, indicates that the wcstombs routine is
+ *	available to convert wide character strings to multibyte strings.
+ */
+#define HAS_WCSTOMBS	/**/
+
+/* HAS_WCTOMB:
+ *	This symbol, if defined, indicates that the wctomb routine is available
+ *	to covert a wide character to a multibyte.
+ */
+#define HAS_WCTOMB		/**/
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t		/* File position type */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel. It can be int, ushort,
+ *	uid_t, etc... It may be necessary to include <sys/types.h> to get
+ *	any typedef'ed information.
+ */
+#define Gid_t gid_t		/* Type for getgid(), etc... */
+
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups().  Usually, this is the same of gidtype, but
+ *	sometimes it isn't.  It can be int, ushort, uid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups().
+ */
+#ifdef HAS_GETGROUPS
+#define Groups_t gid_t	/* Type for 2nd arg to getgroups() */
+#endif
+
+/* DB_Prefix_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is size_t.
+ */
+#define DB_Hash_t	int		/**/
+#define DB_Prefix_t	int  	/**/
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+/* Direntry_t:
+ *	This symbol is set to 'struct direct' or 'struct dirent' depending on
+ *	whether dirent is available or not. You should use this pseudo type to
+ *	portably declare your directory entries.
+ */
+#define I_DIRENT		/**/
+/*#define DIRNAMLEN	/**/
+#define Direntry_t struct dirent
+
+/* I_DLFCN:
+ *	This symbol, if defined, indicates that <dlfcn.h> exists and should
+ *	be included.
+ */
+#define I_DLFCN		/**/
+
+/* I_FCNTL:
+ *	This manifest constant tells the C program to include <fcntl.h>.
+ */
+#define I_FCNTL	/**/
+
+/* I_FLOAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <float.h> to get definition of symbols like DBL_MAX or
+ *	DBL_MIN, i.e. machine dependent floating point values.
+ */
+#define I_FLOAT		/**/
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+#define I_GRP		/**/
+
+/* I_LIMITS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <limits.h> to get definition of symbols like WORD_BIT or
+ *	LONG_MAX, i.e. machine dependant limitations.
+ */
+#define I_LIMITS		/**/
+
+/* I_MATH:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <math.h>.
+ */
+#define I_MATH		/**/
+
+/* I_MEMORY:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <memory.h>.
+ */
+/*#define I_MEMORY		/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+#define I_NDBM	/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and 
+ *	should be included.
+ */
+/*#define I_NET_ERRNO		/**/
+
+/* I_NETINET_IN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
+ */
+#define I_NETINET_IN	/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+#define I_PWD		/**/
+/*#define PWQUOTA	/**/
+#define PWAGE	/**/
+/*#define PWCHANGE	/**/
+/*#define PWCLASS	/**/
+/*#define PWEXPIRE	/**/
+#define PWCOMMENT	/**/
+
+/* I_STDDEF:
+ *	This symbol, if defined, indicates that <stddef.h> exists and should
+ *	be included.
+ */
+#define I_STDDEF	/**/
+
+/* I_STDLIB:
+ *	This symbol, if defined, indicates that <stdlib.h> exists and should
+ *	be included.
+ */
+#define I_STDLIB		/**/
+
+/* I_STRING:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <string.h> (USG systems) instead of <strings.h> (BSD systems).
+ */
+#define I_STRING		/**/
+
+/* I_SYS_DIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/dir.h>.
+ */
+/*#define I_SYS_DIR		/**/
+
+/* I_SYS_FILE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/file.h> to get definition of R_OK and friends.
+ */
+/*#define I_SYS_FILE		/**/
+
+/* I_SYS_IOCTL:
+ *	This symbol, if defined, indicates that <sys/ioctl.h> exists and should
+ *	be included. Otherwise, include <sgtty.h> or <termio.h>.
+ */
+#define	I_SYS_IOCTL		/**/
+
+/* I_SYS_NDIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/ndir.h>.
+ */
+/*#define I_SYS_NDIR	/**/
+
+/* I_SYS_PARAM:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/param.h>.
+ */
+#define I_SYS_PARAM		/**/
+
+/* I_SYS_SELECT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/select.h> in order to get definition of struct timeval.
+ */
+#define I_SYS_SELECT	/**/
+
+/* I_SYS_TIMES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/times.h>.
+ */
+#define	I_SYS_TIMES		/**/
+
+/* I_SYS_TYPES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/types.h>.
+ */
+#define	I_SYS_TYPES		/**/
+
+/* I_SYS_UN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/un.h> to get UNIX domain socket definitions.
+ */
+#define I_SYS_UN		/**/
+
+/* I_TERMIO:
+ *	This symbol, if defined, indicates that the program should include
+ *	<termio.h> rather than <sgtty.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+/* I_TERMIOS:
+ *	This symbol, if defined, indicates that the program should include
+ *	the POSIX termios.h rather than sgtty.h or termio.h.
+ *	There are also differences in the ioctl() calls that depend on the
+ *	value of this symbol.
+ */
+/* I_SGTTY:
+ *	This symbol, if defined, indicates that the program should include
+ *	<sgtty.h> rather than <termio.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+/*#define I_TERMIO		/**/
+#define I_TERMIOS		/**/
+/*#define I_SGTTY		/**/
+
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
+ */
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+/*#define I_TIME		/**/
+#define I_SYS_TIME		/**/
+/*#define I_SYS_TIME_KERNEL		/**/
+
+/* I_UNISTD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <unistd.h>.
+ */
+#define I_UNISTD		/**/
+
+/* I_UTIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <utime.h>.
+ */
+#define I_UTIME		/**/
+
+/* I_VFORK:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include vfork.h.
+ */
+/*#define I_VFORK	/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t off_t		/* <offset> type */
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes 
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t mode_t	 /* file mode parameter for system calls */
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#define	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args
+#else
+#define	_(args) ()
+#endif
+
+/* RANDBITS:
+ *	This symbol contains the number of bits of random number the rand()
+ *	function produces.  Usual values are 15, 16, and 31.
+ */
+#define RANDBITS 15		/**/
+
+/* SCRIPTDIR:
+ *	This symbol holds the name of the directory in which the user wants
+ *	to put publicly executable scripts for the package in question.  It
+ *	is often a directory that is mounted across diverse architectures.
+ *	Programs must be prepared to deal with ~name expansion.
+ */
+#define SCRIPTDIR "/usr/local/script"	/**/
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you 
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	fd_set *	/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t	 /* length paramater for string functions */
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t ssize_t	 /* signed count of bytes */
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR unsigned char	/**/
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t uid_t		/* UID type */
+
+/* VMS:
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+/*#define VMS		/**/
+
+/* LOC_SED:
+ *	This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED 	"/bin/sed"	/**/
+
+/* ARCHLIB_EXP:
+ *	This symbol contains the ~name expanded version of ARCHLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define ARCHLIB_EXP "/usr/local/lib/perl5/i86pc-solaris/5.002"		/**/
+
+/* OSNAME:
+ *	This symbol contains the name of the operating system, as determined
+ *	by Configure.
+ */
+#define OSNAME "solaris"		/**/
+
+/* BYTEORDER:
+ *	This symbol hold the hexadecimal constant defined in byteorder,
+ *	i.e. 0x1234 or 0x4321, etc...
+ */
+#define BYTEORDER 0x1234	/* large digits for MSB */
+
+/* CSH:
+ *	This symbol, if defined, indicates that the C-shell exists.
+ *	If defined, contains the full pathname of csh.
+ */
+#define CSH "/bin/csh"		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+/*#define 	DLSYM_NEEDS_UNDERSCORE 	/* */
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that the bug that prevents
+ *	setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+/*#define DOSUID		/**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used. Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	Possible values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b))
+
+/* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ */
+/* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ */
+#define HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask)
+#define Siglongjmp(buf,retval) siglongjmp(buf,retval)
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp(buf)
+#define Siglongjmp(buf,retval) longjmp(buf,retval)
+#endif
+
+/* USE_DYNAMIC_LOADING:
+ *	This symbol, if defined, indicates that dynamic loading of
+ *	some sort is available.
+ */
+#define USE_DYNAMIC_LOADING		/**/
+
+/* I_DBM:
+ *	This symbol, if defined, indicates that <dbm.h> exists and should
+ *	be included.
+ */
+/* I_RPCSVC_DBM:
+ *	This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ *	should be included.
+ */
+/*#define I_DBM	/**/
+#define I_RPCSVC_DBM	/**/
+
+/* I_LOCALE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <locale.h>.
+ */
+#define	I_LOCALE		/**/
+
+/* I_SYS_STAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/stat.h>.
+ */
+#define	I_SYS_STAT		/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#define I_STDARG		/**/
+/*#define I_VARARGS	/**/
+
+/* INTSIZE:
+ *	This symbol contains the size of an int, so that the C preprocessor
+ *	can make decisions based on it.
+ */
+#define INTSIZE 4		/**/
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void *			/**/
+#define Free_t void			/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+#define MYMALLOC			/**/
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK O_NONBLOCK
+#define VAL_EAGAIN EAGAIN
+#define RD_NODATA -1
+#define EOF_NONBLOCK
+
+/* OLDARCHLIB_EXP:
+ *	This symbol contains the ~name expanded version of OLDARCHLIB, to be
+ *	used in programs that are not prepared to deal with ~ expansion at 
+ *	run-time.
+ */
+/*#define OLDARCHLIB_EXP ""		/**/
+
+/* PRIVLIB_EXP:
+ *	This symbol contains the ~name expanded version of PRIVLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB_EXP "/usr/local/lib/perl5"		/**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order of
+ *	signal number. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT".
+ *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ *	etc., where nn is the actual signal number (e.g. NUM37).
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_num list.
+ */
+/* SIG_NUM:
+ *	This symbol contains a list of signal numbers, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup. 
+ *	Duplicates are allowed, but are moved to the end of the list.
+ *	The signal number corresponding to sig_name[i] is sig_number[i].
+ *	if (i < NSIG) then sig_number[i] == i.  
+ *	The last element is 0, corresponding to the 0 at the end of
+ *	the sig_name list.
+ */
+#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","RTMIN","NUM37","NUM38","NUM39","NUM40","NUM41","NUM42","RTMAX","IOT","CLD","POLL",0	/**/
+#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,6,18,22,0	/**/
+
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITEARCH_EXP "/usr/local/lib/perl5/site_perl/i86pc-solaris"		/**/
+
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITELIB_EXP "/usr/local/lib/perl5/site_perl"		/**/
+
+/* STARTPERL:
+ *	This variable contains the string to put in front of a perl
+ *	script to make sure (one hopes) that it runs with perl and not
+ *	some shell.
+ */
+#define STARTPERL "#!/usr/local/bin/perl"		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */
+#define M_VOID			/* Xenix strikes again */
+#endif
+
+#endif
diff --git a/gnu/usr.bin/perl/config_h.SH b/gnu/usr.bin/perl/config_h.SH
new file mode 100644
index 00000000000..f4ecea0faa1
--- /dev/null
+++ b/gnu/usr.bin/perl/config_h.SH
@@ -0,0 +1,1597 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting config.h (with variable substitutions)"
+sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!'
+/*
+ * This file was produced by running the config_h.SH script, which
+ * gets its values from config.sh, which is generally produced by
+ * running Configure.
+ *
+ * Feel free to modify any of this as the need arises.  Note, however,
+ * that running config_h.SH again will wipe out any changes you've made.
+ * For a more permanent change edit config.sh and rerun config_h.SH.
+ *
+ * \$Id: Config_h.U,v 3.0.1.4 1995/09/25 09:10:49 ram Exp $
+ */
+
+/* Configuration time: $cf_time
+ * Configured by: $cf_by
+ * Target system: $myuname
+ */
+
+#ifndef _config_h_
+#define _config_h_
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double. Usual values are 2, 4 and 8.
+ */
+#define MEM_ALIGNBYTES $alignbytes	/**/
+
+/* BIN:
+ *	This symbol holds the path of the bin directory where the package will
+ *	be installed. Program must be prepared to deal with ~name substitution.
+ */
+#define BIN "$bin"	/**/
+
+/* CAT2:
+ *	This macro catenates 2 tokens together.
+ */
+#if $cpp_stuff == 1
+#define CAT2(a,b)a/**/b
+#define CAT3(a,b,c)a/**/b/**/c
+#define CAT4(a,b,c,d)a/**/b/**/c/**/d
+#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
+#define STRINGIFY(a)"a"
+		/* If you can get stringification with catify, tell me how! */
+#endif
+#if $cpp_stuff == 42
+#define CAT2(a,b)a ## b
+#define CAT3(a,b,c)a ## b ## c
+#define CAT4(a,b,c,d)a ## b ## c ## d
+#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
+#define StGiFy(a)# a
+#define STRINGIFY(a)StGiFy(a)
+#define SCAT2(a,b)StGiFy(a) StGiFy(b)
+#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
+#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
+#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
+#endif
+#ifndef CAT2
+#include "Bletch: How does this C preprocessor catenate tokens?"
+#endif
+
+/* CPPSTDIN:
+ *	This symbol contains the first part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.	 Typical value of "cc -E" or "/lib/cpp", but it can also
+ *	call a wrapper. See CPPRUN.
+ */
+/* CPPMINUS:
+ *	This symbol contains the second part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.  This symbol will have the value "-" if CPPSTDIN needs a minus
+ *	to specify standard input, otherwise the value is "".
+ */
+#define CPPSTDIN "$cppstdin"
+#define CPPMINUS "$cppminus"
+
+/* HAS_ALARM:
+ *	This symbol, if defined, indicates that the alarm routine is
+ *	available.
+ */
+#$d_alarm HAS_ALARM		/**/
+
+/* HASATTRIBUTE:
+ *	This symbol indicates the C compiler can check for function attributes,
+ *	such as printf formats. This is normally only supported by GNU cc.
+ */
+#$d_attribut HASATTRIBUTE 	/**/
+#ifndef HASATTRIBUTE
+#define __attribute__(_arg_)
+#endif
+
+/* HAS_BCMP:
+ *	This symbol is defined if the bcmp() routine is available to
+ *	compare blocks of memory.
+ */
+#$d_bcmp HAS_BCMP	/**/
+
+/* HAS_BCOPY:
+ *	This symbol is defined if the bcopy() routine is available to
+ *	copy blocks of memory.
+ */
+#$d_bcopy HAS_BCOPY	/**/
+
+/* HAS_BZERO:
+ *	This symbol is defined if the bzero() routine is available to
+ *	set a memory block to 0.
+ */
+#$d_bzero HAS_BZERO	/**/
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#$d_casti32	CASTI32		/**/
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ *		4 = couldn't cast in argument expression list
+ */
+#$d_castneg	CASTNEGFLOAT		/**/
+#define CASTFLAGS $castflags		/**/
+
+/* HAS_CHOWN:
+ *	This symbol, if defined, indicates that the chown routine is
+ *	available.
+ */
+#$d_chown HAS_CHOWN		/**/
+
+/* HAS_CHROOT:
+ *	This symbol, if defined, indicates that the chroot routine is
+ *	available.
+ */
+#$d_chroot HAS_CHROOT		/**/
+
+/* HAS_CHSIZE:
+ *	This symbol, if defined, indicates that the chsize routine is available
+ *	to truncate files.  You might need a -lx to get this routine.
+ */
+#$d_chsize	HAS_CHSIZE		/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+#$d_void_closedir VOID_CLOSEDIR		/**/
+
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
+ */
+#$d_const HASCONST	/**/
+#ifndef HASCONST
+#define const
+#endif
+
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
+ */
+#$d_crypt HAS_CRYPT		/**/
+
+/* HAS_CUSERID:
+ *	This symbol, if defined, indicates that the cuserid routine is
+ *	available to get character login names.
+ */
+#$d_cuserid HAS_CUSERID		/**/
+
+/* HAS_DBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol DBL_DIG, which is the number
+ *	of significant digits in a double precision number.  If this
+ *	symbol is not defined, a guess of 15 is usually pretty good.
+ */
+#$d_dbl_dig HAS_DBL_DIG 	/* */
+
+/* HAS_DIFFTIME:
+ *	This symbol, if defined, indicates that the difftime routine is
+ *	available.
+ */
+#$d_difftime HAS_DIFFTIME		/**/
+
+/* HAS_DLERROR:
+ *	This symbol, if defined, indicates that the dlerror routine is
+ *	available to return a string describing the last error that
+ *	occurred from a call to dlopen(), dlclose() or dlsym().
+ */
+#$d_dlerror HAS_DLERROR	/**/
+
+/* HAS_DUP2:
+ *	This symbol, if defined, indicates that the dup2 routine is
+ *	available to duplicate file descriptors.
+ */
+#$d_dup2 HAS_DUP2	/**/
+
+/* HAS_FCHMOD:
+ *	This symbol, if defined, indicates that the fchmod routine is available
+ *	to change mode of opened files.  If unavailable, use chmod().
+ */
+#$d_fchmod HAS_FCHMOD		/**/
+
+/* HAS_FCHOWN:
+ *	This symbol, if defined, indicates that the fchown routine is available
+ *	to change ownership of opened files.  If unavailable, use chown().
+ */
+#$d_fchown HAS_FCHOWN		/**/
+
+/* HAS_FCNTL:
+ *	This symbol, if defined, indicates to the C program that
+ *	the fcntl() function exists.
+ */
+#$d_fcntl HAS_FCNTL		/**/
+
+/* HAS_FGETPOS:
+ *	This symbol, if defined, indicates that the fgetpos routine is
+ *	available to get the file position indicator, similar to ftell().
+ */
+#$d_fgetpos HAS_FGETPOS	/**/
+
+/* FLEXFILENAMES:
+ *	This symbol, if defined, indicates that the system supports filenames
+ *	longer than 14 characters.
+ */
+#$d_flexfnam	FLEXFILENAMES		/**/
+
+/* HAS_FLOCK:
+ *	This symbol, if defined, indicates that the flock routine is
+ *	available to do file locking.
+ */
+#$d_flock HAS_FLOCK		/**/
+
+/* HAS_FORK:
+ *	This symbol, if defined, indicates that the fork routine is
+ *	available.
+ */
+#$d_fork HAS_FORK		/**/
+
+/* HAS_FSETPOS:
+ *	This symbol, if defined, indicates that the fsetpos routine is
+ *	available to set the file position indicator, similar to fseek().
+ */
+#$d_fsetpos HAS_FSETPOS	/**/
+
+/* HAS_GETGROUPS:
+ *	This symbol, if defined, indicates that the getgroups() routine is
+ *	available to get the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+#$d_getgrps HAS_GETGROUPS		/**/
+
+/* HAS_GETHOSTENT:
+ *	This symbol, if defined, indicates that the gethostent routine is
+ *	available to lookup host names in some data base or other.
+ */
+#$d_gethent HAS_GETHOSTENT		/**/
+
+/* HAS_UNAME:
+ *	This symbol, if defined, indicates that the C program may use the
+ *	uname() routine to derive the host name.  See also HAS_GETHOSTNAME
+ *	and PHOSTNAME.
+ */
+#$d_uname HAS_UNAME		/**/
+
+/* HAS_GETLOGIN:
+ *	This symbol, if defined, indicates that the getlogin routine is
+ *	available to get the login name.
+ */
+#$d_getlogin HAS_GETLOGIN		/**/
+
+/* HAS_GETPGRP:
+ *	This symbol, if defined, indicates that the getpgrp routine is
+ *	available to get the current process group.
+ */
+#$d_getpgrp HAS_GETPGRP		/**/
+
+/* HAS_GETPGRP2:
+ *	This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ *	routine is available to get the current process group.
+ */
+#$d_getpgrp2 HAS_GETPGRP2		/**/
+
+/* HAS_GETPPID:
+ *	This symbol, if defined, indicates that the getppid routine is
+ *	available to get the parent process ID.
+ */
+#$d_getppid HAS_GETPPID		/**/
+
+/* HAS_GETPRIORITY:
+ *	This symbol, if defined, indicates that the getpriority routine is
+ *	available to get a process's priority.
+ */
+#$d_getprior HAS_GETPRIORITY		/**/
+
+/* HAS_HTONL:
+ *	This symbol, if defined, indicates that the htonl() routine (and
+ *	friends htons() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_HTONS:
+ *	This symbol, if defined, indicates that the htons() routine (and
+ *	friends htonl() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHL:
+ *	This symbol, if defined, indicates that the ntohl() routine (and
+ *	friends htonl() htons() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHS:
+ *	This symbol, if defined, indicates that the ntohs() routine (and
+ *	friends htonl() htons() ntohl()) are available to do network
+ *	order byte swapping.
+ */
+#$d_htonl HAS_HTONL		/**/
+#$d_htonl HAS_HTONS		/**/
+#$d_htonl HAS_NTOHL		/**/
+#$d_htonl HAS_NTOHS		/**/
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that isascii 
+ *	is available.
+ */
+#$d_isascii HAS_ISASCII		/**/
+
+/* HAS_KILLPG:
+ *	This symbol, if defined, indicates that the killpg routine is available
+ *	to kill process groups.  If unavailable, you probably should use kill
+ *	with a negative process number.
+ */
+#$d_killpg HAS_KILLPG	/**/
+
+/* HAS_LINK:
+ *	This symbol, if defined, indicates that the link routine is
+ *	available to create hard links.
+ */
+#$d_link HAS_LINK	/**/
+
+/* HAS_LOCALECONV:
+ *	This symbol, if defined, indicates that the localeconv routine is
+ *	available for numeric and monetary formatting conventions.
+ */
+#$d_locconv HAS_LOCALECONV	/**/
+
+/* HAS_LOCKF:
+ *	This symbol, if defined, indicates that the lockf routine is
+ *	available to do file locking.
+ */
+#$d_lockf HAS_LOCKF		/**/
+
+/* HAS_LSTAT:
+ *	This symbol, if defined, indicates that the lstat routine is
+ *	available to do file stats on symbolic links.
+ */
+#$d_lstat HAS_LSTAT		/**/
+
+/* HAS_MBLEN:
+ *	This symbol, if defined, indicates that the mblen routine is available
+ *	to find the number of bytes in a multibye character.
+ */
+#$d_mblen HAS_MBLEN		/**/
+
+/* HAS_MBSTOWCS:
+ *	This symbol, if defined, indicates that the mbstowcs routine is
+ *	available to covert a multibyte string into a wide character string.
+ */
+#$d_mbstowcs	HAS_MBSTOWCS		/**/
+
+/* HAS_MBTOWC:
+ *	This symbol, if defined, indicates that the mbtowc routine is available
+ *	to covert a multibyte to a wide character.
+ */
+#$d_mbtowc HAS_MBTOWC		/**/
+
+/* HAS_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	to compare blocks of memory.
+ */
+#$d_memcmp HAS_MEMCMP	/**/
+
+/* HAS_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy blocks of memory.
+ */
+#$d_memcpy HAS_MEMCPY	/**/
+
+/* HAS_MEMMOVE:
+ *	This symbol, if defined, indicates that the memmove routine is available
+ *	to copy potentially overlapping blocks of memory. This should be used
+ *	only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
+ *	own version.
+ */
+#$d_memmove HAS_MEMMOVE	/**/
+
+/* HAS_MEMSET:
+ *	This symbol, if defined, indicates that the memset routine is available
+ *	to set blocks of memory.
+ */
+#$d_memset HAS_MEMSET	/**/
+
+/* HAS_MKDIR:
+ *	This symbol, if defined, indicates that the mkdir routine is available
+ *	to create directories.  Otherwise you should fork off a new process to
+ *	exec /bin/mkdir.
+ */
+#$d_mkdir HAS_MKDIR		/**/
+
+/* HAS_MKFIFO:
+ *	This symbol, if defined, indicates that the mkfifo routine is
+ *	available to create FIFOs. Otherwise, mknod should be able to
+ *	do it for you. However, if mkfifo is there, mknod might require
+ *	super-user privileges which mkfifo will not.
+ */
+#$d_mkfifo HAS_MKFIFO		/**/
+
+/* HAS_MKTIME:
+ *	This symbol, if defined, indicates that the mktime routine is
+ *	available.
+ */
+#$d_mktime HAS_MKTIME		/**/
+
+/* HAS_MSG:
+ *	This symbol, if defined, indicates that the entire msg*(2) library is
+ *	supported (IPC mechanism based on message queues).
+ */
+#$d_msg HAS_MSG		/**/
+
+/* HAS_NICE:
+ *	This symbol, if defined, indicates that the nice routine is
+ *	available.
+ */
+#$d_nice HAS_NICE		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+#$d_open3 HAS_OPEN3		/**/
+
+/* HAS_PATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given filename.
+ */
+/* HAS_FPATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given open file descriptor.
+ */
+#$d_pathconf HAS_PATHCONF		/**/
+#$d_fpathconf HAS_FPATHCONF		/**/
+
+/* HAS_PAUSE:
+ *	This symbol, if defined, indicates that the pause routine is
+ *	available to suspend a process until a signal is received.
+ */
+#$d_pause HAS_PAUSE		/**/
+
+/* HAS_PIPE:
+ *	This symbol, if defined, indicates that the pipe routine is
+ *	available to create an inter-process channel.
+ */
+#$d_pipe HAS_PIPE		/**/
+
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.
+ */
+#$d_poll HAS_POLL		/**/
+
+/* HAS_READDIR:
+ *	This symbol, if defined, indicates that the readdir routine is
+ *	available to read directory entries. You may have to include
+ *	<dirent.h>. See I_DIRENT.
+ */
+#$d_readdir HAS_READDIR		/**/
+
+/* HAS_SEEKDIR:
+ *	This symbol, if defined, indicates that the seekdir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#$d_seekdir HAS_SEEKDIR		/**/
+
+/* HAS_TELLDIR:
+ *	This symbol, if defined, indicates that the telldir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#$d_telldir HAS_TELLDIR		/**/
+
+/* HAS_REWINDDIR:
+ *	This symbol, if defined, indicates that the rewinddir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#$d_rewinddir HAS_REWINDDIR		/**/
+
+/* HAS_READLINK:
+ *	This symbol, if defined, indicates that the readlink routine is
+ *	available to read the value of a symbolic link.
+ */
+#$d_readlink HAS_READLINK		/**/
+
+/* HAS_RENAME:
+ *	This symbol, if defined, indicates that the rename routine is available
+ *	to rename files.  Otherwise you should do the unlink(), link(), unlink()
+ *	trick.
+ */
+#$d_rename HAS_RENAME	/**/
+
+/* HAS_RMDIR:
+ *	This symbol, if defined, indicates that the rmdir routine is
+ *	available to remove directories. Otherwise you should fork off a
+ *	new process to exec /bin/rmdir.
+ */
+#$d_rmdir HAS_RMDIR		/**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+#$d_safebcpy HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+#$d_safemcpy HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SELECT:
+ *	This symbol, if defined, indicates that the select routine is
+ *	available to select active file descriptors. If the timeout field
+ *	is used, <sys/time.h> may need to be included.
+ */
+#$d_select HAS_SELECT	/**/
+
+/* HAS_SEM:
+ *	This symbol, if defined, indicates that the entire sem*(2) library is
+ *	supported.
+ */
+#$d_sem HAS_SEM		/**/
+
+/* HAS_SETEGID:
+ *	This symbol, if defined, indicates that the setegid routine is available
+ *	to change the effective gid of the current program.
+ */
+#$d_setegid HAS_SETEGID		/**/
+
+/* HAS_SETEUID:
+ *	This symbol, if defined, indicates that the seteuid routine is available
+ *	to change the effective uid of the current program.
+ */
+#$d_seteuid HAS_SETEUID		/**/
+
+/* HAS_SETLINEBUF:
+ *	This symbol, if defined, indicates that the setlinebuf routine is
+ *	available to change stderr or stdout from block-buffered or unbuffered
+ *	to a line-buffered mode.
+ */
+#$d_setlinebuf HAS_SETLINEBUF		/**/
+
+/* HAS_SETLOCALE:
+ *	This symbol, if defined, indicates that the setlocale routine is
+ *	available to handle locale-specific ctype implementations.
+ */
+#$d_setlocale HAS_SETLOCALE	/**/
+
+/* HAS_SETPGID:
+ *	This symbol, if defined, indicates that the setpgid routine is
+ *	available to set process group ID.
+ */
+#$d_setpgid HAS_SETPGID	/**/
+
+/* HAS_SETPGRP:
+ *	This symbol, if defined, indicates that the setpgrp routine is
+ *	available to set the current process group.
+ */
+/* USE_BSDPGRP:
+ *	This symbol, if defined, indicates that the BSD notion of process
+ *	group is to be used. For instance, you have to say setpgrp(pid, pgrp)
+ *	instead of the USG setpgrp().
+ */
+#$d_setpgrp HAS_SETPGRP		/**/
+#$d_bsdpgrp USE_BSDPGRP		/**/
+
+/* HAS_SETPGRP2:
+ *	This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ *	routine is available to set the current process group.
+ */
+#$d_setpgrp2 HAS_SETPGRP2		/**/
+
+/* HAS_SETPRIORITY:
+ *	This symbol, if defined, indicates that the setpriority routine is
+ *	available to set a process's priority.
+ */
+#$d_setprior HAS_SETPRIORITY		/**/
+
+/* HAS_SETREGID:
+ *	This symbol, if defined, indicates that the setregid routine is
+ *	available to change the real and effective gid of the current
+ *	process.
+ */
+/* HAS_SETRESGID:
+ *	This symbol, if defined, indicates that the setresgid routine is
+ *	available to change the real, effective and saved gid of the current
+ *	process.
+ */
+#$d_setregid HAS_SETREGID		/**/
+#$d_setresgid HAS_SETRESGID		/**/
+
+/* HAS_SETREUID:
+ *	This symbol, if defined, indicates that the setreuid routine is
+ *	available to change the real and effective uid of the current
+ *	process.
+ */
+/* HAS_SETRESUID:
+ *	This symbol, if defined, indicates that the setresuid routine is
+ *	available to change the real, effective and saved uid of the current
+ *	process.
+ */
+#$d_setreuid HAS_SETREUID		/**/
+#$d_setresuid HAS_SETRESUID		/**/
+
+/* HAS_SETRGID:
+ *	This symbol, if defined, indicates that the setrgid routine is available
+ *	to change the real gid of the current program.
+ */
+#$d_setrgid HAS_SETRGID		/**/
+
+/* HAS_SETRUID:
+ *	This symbol, if defined, indicates that the setruid routine is available
+ *	to change the real uid of the current program.
+ */
+#$d_setruid HAS_SETRUID		/**/
+
+/* HAS_SETSID:
+ *	This symbol, if defined, indicates that the setsid routine is
+ *	available to set the process group ID.
+ */
+#$d_setsid HAS_SETSID	/**/
+
+/* HAS_SHM:
+ *	This symbol, if defined, indicates that the entire shm*(2) library is
+ *	supported.
+ */
+#$d_shm HAS_SHM		/**/
+
+/* Shmat_t:
+ *	This symbol holds the return type of the shmat() system call.
+ *	Usually set to 'void *' or 'char *'.
+ */
+/* HAS_SHMAT_PROTOTYPE:
+ *	This symbol, if defined, indicates that the sys/shm.h includes
+ *	a prototype for shmat().  Otherwise, it is up to the program to
+ *	guess one.  Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
+ *	but not always right so it should be emitted by the program only
+ *	when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+#define Shmat_t $shmattype	/**/
+#$d_shmatprototype HAS_SHMAT_PROTOTYPE	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+#$d_sigaction HAS_SIGACTION	/**/
+
+/* HAS_SOCKET:
+ *	This symbol, if defined, indicates that the BSD socket interface is
+ *	supported.
+ */
+/* HAS_SOCKETPAIR:
+ *	This symbol, if defined, indicates that the BSD socketpair() call is
+ *	supported.
+ */
+#$d_socket HAS_SOCKET		/**/
+#$d_sockpair HAS_SOCKETPAIR	/**/
+
+/* USE_STAT_BLOCKS:
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_blksize and st_blocks.
+ */
+#$d_statblks USE_STAT_BLOCKS 	/**/
+
+/* USE_STDIO_PTR:
+ *	This symbol is defined if the _ptr and _cnt fields (or similar)
+ *	of the stdio FILE structure can be used to access the stdio buffer
+ *	for a file handle.  If this is defined, then the FILE_ptr(fp)
+ *	and FILE_cnt(fp) macros will also be defined and should be used
+ *	to access these fields.
+ */
+/* USE_STDIO_BASE:
+ *	This symbol is defined if the _base field (or similar) of the
+ *	stdio FILE structure can be used to access the stdio buffer for
+ *	a file handle.  If this is defined, then the FILE_base(fp) macro
+ *	will also be defined and should be used to access this field.
+ *	Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ *	to determine the number of bytes in the buffer.  USE_STDIO_BASE
+ *	will never be defined unless USE_STDIO_PTR is.
+ */
+#$d_stdstdio USE_STDIO_PTR 	/**/
+#$d_stdiobase USE_STDIO_BASE 	/**/
+
+/* FILE_ptr:
+ *	This macro is used to access the _ptr field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ *	This symbol is defined if the FILE_ptr macro can be used as an
+ *	lvalue.
+ */
+/* FILE_cnt:
+ *	This macro is used to access the _cnt field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ *	This symbol is defined if the FILE_cnt macro can be used as an
+ *	lvalue.
+ */
+#ifdef USE_STDIO_PTR
+#define FILE_ptr(fp)	$stdio_ptr
+#$d_stdio_ptr_lval STDIO_PTR_LVALUE 		/**/
+#define FILE_cnt(fp)	$stdio_cnt
+#$d_stdio_cnt_lval STDIO_CNT_LVALUE 		/**/
+#endif
+
+/* FILE_base:
+ *	This macro is used to access the _base field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_BASE is defined.
+ */
+/* FILE_bufsiz:
+ *	This macro is used to determine the number of bytes in the I/O
+ *	buffer pointed to by _base field (or equivalent) of the FILE
+ *	structure pointed to its argument. This macro will always be defined
+ *	if USE_STDIO_BASE is defined.
+ */
+#ifdef USE_STDIO_BASE
+#define FILE_base(fp)	$stdio_base
+#define FILE_bufsiz(fp)	$stdio_bufsiz
+#endif
+
+/* HAS_STRCHR:
+ *	This symbol is defined to indicate that the strchr()/strrchr()
+ *	functions are available for string searching. If not, try the
+ *	index()/rindex() pair.
+ */
+/* HAS_INDEX:
+ *	This symbol is defined to indicate that the index()/rindex()
+ *	functions are available for string searching.
+ */
+#$d_strchr HAS_STRCHR	/**/
+#$d_index HAS_INDEX	/**/
+
+/* HAS_STRCOLL:
+ *	This symbol, if defined, indicates that the strcoll routine is
+ *	available to compare strings using collating information.
+ */
+#$d_strcoll HAS_STRCOLL	/**/
+
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
+ */
+#$d_strctcpy	USE_STRUCT_COPY	/**/
+
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
+ */
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#$d_strerror HAS_STRERROR		/**/
+#$d_syserrlst HAS_SYS_ERRLIST	/**/
+#define Strerror(e) $d_strerrm
+
+/* HAS_STRXFRM:
+ *	This symbol, if defined, indicates that the strxfrm() routine is
+ *	available to transform strings.
+ */
+#$d_strxfrm HAS_STRXFRM	/**/
+
+/* HAS_SYMLINK:
+ *	This symbol, if defined, indicates that the symlink routine is available
+ *	to create symbolic links.
+ */
+#$d_symlink HAS_SYMLINK	/**/
+
+/* HAS_SYSCALL:
+ *	This symbol, if defined, indicates that the syscall routine is
+ *	available to call arbitrary system calls. If undefined, that's tough.
+ */
+#$d_syscall HAS_SYSCALL	/**/
+
+/* HAS_SYSCONF:
+ *	This symbol, if defined, indicates that sysconf() is available
+ *	to determine system related limits and options.
+ */
+#$d_sysconf HAS_SYSCONF	/**/
+
+/* HAS_SYSTEM:
+ *	This symbol, if defined, indicates that the system routine is
+ *	available to issue a shell command.
+ */
+#$d_system HAS_SYSTEM	/**/
+
+/* HAS_TCGETPGRP:
+ *	This symbol, if defined, indicates that the tcgetpgrp routine is
+ *	available to get foreground process group ID.
+ */
+#$d_tcgetpgrp HAS_TCGETPGRP		/**/
+
+/* HAS_TCSETPGRP:
+ *	This symbol, if defined, indicates that the tcsetpgrp routine is
+ *	available to set foreground process group ID.
+ */
+#$d_tcsetpgrp HAS_TCSETPGRP		/**/
+
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define Time_t $timetype		/* Time type */
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#$d_times HAS_TIMES		/**/
+
+/* HAS_TRUNCATE:
+ *	This symbol, if defined, indicates that the truncate routine is
+ *	available to truncate files.
+ */
+#$d_truncate HAS_TRUNCATE	/**/
+
+/* HAS_TZNAME:
+ *	This symbol, if defined, indicates that the tzname[] array is
+ *	available to access timezone names.
+ */
+#$d_tzname HAS_TZNAME		/**/
+
+/* HAS_UMASK:
+ *	This symbol, if defined, indicates that the umask routine is
+ *	available to set and get the value of the file creation mask.
+ */
+#$d_umask HAS_UMASK		/**/
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+#$d_vfork HAS_VFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t $signal_t	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#$d_volatile	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile
+#endif
+
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
+ */
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
+ */
+#$d_vprintf HAS_VPRINTF	/**/
+#$d_charvspr USE_CHAR_VSPRINTF 	/**/
+
+/* HAS_WAIT4:
+ *	This symbol, if defined, indicates that wait4() exists.
+ */
+#$d_wait4 HAS_WAIT4	/**/
+
+/* HAS_WAITPID:
+ *	This symbol, if defined, indicates that the waitpid routine is
+ *	available to wait for child process.
+ */
+#$d_waitpid HAS_WAITPID	/**/
+
+/* HAS_WCSTOMBS:
+ *	This symbol, if defined, indicates that the wcstombs routine is
+ *	available to convert wide character strings to multibyte strings.
+ */
+#$d_wcstombs HAS_WCSTOMBS	/**/
+
+/* HAS_WCTOMB:
+ *	This symbol, if defined, indicates that the wctomb routine is available
+ *	to covert a wide character to a multibyte.
+ */
+#$d_wctomb HAS_WCTOMB		/**/
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t $fpostype		/* File position type */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel. It can be int, ushort,
+ *	uid_t, etc... It may be necessary to include <sys/types.h> to get
+ *	any typedef'ed information.
+ */
+#define Gid_t $gidtype		/* Type for getgid(), etc... */
+
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups().  Usually, this is the same of gidtype, but
+ *	sometimes it isn't.  It can be int, ushort, uid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups().
+ */
+#ifdef HAS_GETGROUPS
+#define Groups_t $groupstype	/* Type for 2nd arg to getgroups() */
+#endif
+
+/* DB_Prefix_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is size_t.
+ */
+#define DB_Hash_t	$db_hashtype		/**/
+#define DB_Prefix_t	$db_prefixtype  	/**/
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+/* Direntry_t:
+ *	This symbol is set to 'struct direct' or 'struct dirent' depending on
+ *	whether dirent is available or not. You should use this pseudo type to
+ *	portably declare your directory entries.
+ */
+#$i_dirent I_DIRENT		/**/
+#$d_dirnamlen DIRNAMLEN	/**/
+#define Direntry_t $direntrytype
+
+/* I_DLFCN:
+ *	This symbol, if defined, indicates that <dlfcn.h> exists and should
+ *	be included.
+ */
+#$i_dlfcn I_DLFCN		/**/
+
+/* I_FCNTL:
+ *	This manifest constant tells the C program to include <fcntl.h>.
+ */
+#$i_fcntl I_FCNTL	/**/
+
+/* I_FLOAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <float.h> to get definition of symbols like DBL_MAX or
+ *	DBL_MIN, i.e. machine dependent floating point values.
+ */
+#$i_float I_FLOAT		/**/
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+#$i_grp I_GRP		/**/
+
+/* I_LIMITS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <limits.h> to get definition of symbols like WORD_BIT or
+ *	LONG_MAX, i.e. machine dependant limitations.
+ */
+#$i_limits I_LIMITS		/**/
+
+/* I_MATH:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <math.h>.
+ */
+#$i_math I_MATH		/**/
+
+/* I_MEMORY:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <memory.h>.
+ */
+#$i_memory I_MEMORY		/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+#$i_ndbm I_NDBM	/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and 
+ *	should be included.
+ */
+#$i_neterrno I_NET_ERRNO		/**/
+
+/* I_NETINET_IN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
+ */
+#$i_niin I_NETINET_IN	/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+#$i_pwd I_PWD		/**/
+#$d_pwquota PWQUOTA	/**/
+#$d_pwage PWAGE	/**/
+#$d_pwchange PWCHANGE	/**/
+#$d_pwclass PWCLASS	/**/
+#$d_pwexpire PWEXPIRE	/**/
+#$d_pwcomment PWCOMMENT	/**/
+
+/* I_STDDEF:
+ *	This symbol, if defined, indicates that <stddef.h> exists and should
+ *	be included.
+ */
+#$i_stddef I_STDDEF	/**/
+
+/* I_STDLIB:
+ *	This symbol, if defined, indicates that <stdlib.h> exists and should
+ *	be included.
+ */
+#$i_stdlib I_STDLIB		/**/
+
+/* I_STRING:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <string.h> (USG systems) instead of <strings.h> (BSD systems).
+ */
+#$i_string I_STRING		/**/
+
+/* I_SYS_DIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/dir.h>.
+ */
+#$i_sysdir I_SYS_DIR		/**/
+
+/* I_SYS_FILE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/file.h> to get definition of R_OK and friends.
+ */
+#$i_sysfile I_SYS_FILE		/**/
+
+/* I_SYS_IOCTL:
+ *	This symbol, if defined, indicates that <sys/ioctl.h> exists and should
+ *	be included. Otherwise, include <sgtty.h> or <termio.h>.
+ */
+#$i_sysioctl	I_SYS_IOCTL		/**/
+
+/* I_SYS_NDIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/ndir.h>.
+ */
+#$i_sysndir I_SYS_NDIR	/**/
+
+/* I_SYS_PARAM:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/param.h>.
+ */
+#$i_sysparam I_SYS_PARAM		/**/
+
+/* I_SYS_SELECT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/select.h> in order to get definition of struct timeval.
+ */
+#$i_sysselct I_SYS_SELECT	/**/
+
+/* I_SYS_TIMES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/times.h>.
+ */
+#$i_systimes	I_SYS_TIMES		/**/
+
+/* I_SYS_TYPES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/types.h>.
+ */
+#$i_systypes	I_SYS_TYPES		/**/
+
+/* I_SYS_UN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/un.h> to get UNIX domain socket definitions.
+ */
+#$i_sysun I_SYS_UN		/**/
+
+/* I_TERMIO:
+ *	This symbol, if defined, indicates that the program should include
+ *	<termio.h> rather than <sgtty.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+/* I_TERMIOS:
+ *	This symbol, if defined, indicates that the program should include
+ *	the POSIX termios.h rather than sgtty.h or termio.h.
+ *	There are also differences in the ioctl() calls that depend on the
+ *	value of this symbol.
+ */
+/* I_SGTTY:
+ *	This symbol, if defined, indicates that the program should include
+ *	<sgtty.h> rather than <termio.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+#$i_termio I_TERMIO		/**/
+#$i_termios I_TERMIOS		/**/
+#$i_sgtty I_SGTTY		/**/
+
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
+ */
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+#$i_time I_TIME		/**/
+#$i_systime I_SYS_TIME		/**/
+#$i_systimek I_SYS_TIME_KERNEL		/**/
+
+/* I_UNISTD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <unistd.h>.
+ */
+#$i_unistd I_UNISTD		/**/
+
+/* I_UTIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <utime.h>.
+ */
+#$i_utime I_UTIME		/**/
+
+/* I_VFORK:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include vfork.h.
+ */
+#$i_vfork I_VFORK	/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t $lseektype		/* <offset> type */
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes 
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t $modetype	 /* file mode parameter for system calls */
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#$prototype	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args
+#else
+#define	_(args) ()
+#endif
+
+/* RANDBITS:
+ *	This symbol contains the number of bits of random number the rand()
+ *	function produces.  Usual values are 15, 16, and 31.
+ */
+#define RANDBITS $randbits		/**/
+
+/* SCRIPTDIR:
+ *	This symbol holds the name of the directory in which the user wants
+ *	to put publicly executable scripts for the package in question.  It
+ *	is often a directory that is mounted across diverse architectures.
+ *	Programs must be prepared to deal with ~name expansion.
+ */
+#define SCRIPTDIR "$scriptdir"	/**/
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you 
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	$selecttype	/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t $sizetype	 /* length paramater for string functions */
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t $ssizetype	 /* signed count of bytes */
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR $stdchar	/**/
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Uid_t $uidtype		/* UID type */
+
+/* VMS:
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It is currently only set in conjunction with the EUNICE symbol.
+ */
+#$d_eunice VMS		/**/
+
+/* LOC_SED:
+ *	This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED 	"$full_sed"	/**/
+
+/* ARCHLIB_EXP:
+ *	This symbol contains the ~name expanded version of ARCHLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#$d_archlib ARCHLIB_EXP "$archlibexp"		/**/
+
+/* OSNAME:
+ *	This symbol contains the name of the operating system, as determined
+ *	by Configure.
+ */
+#define OSNAME "$osname"		/**/
+
+/* BYTEORDER:
+ *	This symbol hold the hexadecimal constant defined in byteorder,
+ *	i.e. 0x1234 or 0x4321, etc...
+ */
+#define BYTEORDER 0x$byteorder	/* large digits for MSB */
+
+/* CSH:
+ *	This symbol, if defined, indicates that the C-shell exists.
+ *	If defined, contains the full pathname of csh.
+ */
+#$d_csh CSH "$full_csh"		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+#$d_dlsymun 	DLSYM_NEEDS_UNDERSCORE 	/* */
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that the bug that prevents
+ *	setuid scripts from being secure is not present in this kernel.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+#$d_dosuid DOSUID		/**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used. Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	Possible values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) $d_Gconvert
+
+/* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ */
+/* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ */
+#$d_sigsetjmp HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf
+#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask)
+#define Siglongjmp(buf,retval) siglongjmp(buf,retval)
+#else
+#define Sigjmp_buf jmp_buf
+#define Sigsetjmp(buf,save_mask) setjmp(buf)
+#define Siglongjmp(buf,retval) longjmp(buf,retval)
+#endif
+
+/* USE_DYNAMIC_LOADING:
+ *	This symbol, if defined, indicates that dynamic loading of
+ *	some sort is available.
+ */
+#$usedl USE_DYNAMIC_LOADING		/**/
+
+/* I_DBM:
+ *	This symbol, if defined, indicates that <dbm.h> exists and should
+ *	be included.
+ */
+/* I_RPCSVC_DBM:
+ *	This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ *	should be included.
+ */
+#$i_dbm I_DBM	/**/
+#$i_rpcsvcdbm I_RPCSVC_DBM	/**/
+
+/* I_LOCALE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <locale.h>.
+ */
+#$i_locale	I_LOCALE		/**/
+
+/* I_SYS_STAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/stat.h>.
+ */
+#$i_sysstat	I_SYS_STAT		/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#$i_stdarg I_STDARG		/**/
+#$i_varargs I_VARARGS	/**/
+
+/* INTSIZE:
+ *	This symbol contains the size of an int, so that the C preprocessor
+ *	can make decisions based on it.
+ */
+#define INTSIZE $intsize		/**/
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t $malloctype			/**/
+#define Free_t $freetype			/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+#$d_mymalloc MYMALLOC			/**/
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK $o_nonblock
+#define VAL_EAGAIN $eagain
+#define RD_NODATA $rd_nodata
+#$d_eofnblk EOF_NONBLOCK
+
+/* OLDARCHLIB_EXP:
+ *	This symbol contains the ~name expanded version of OLDARCHLIB, to be
+ *	used in programs that are not prepared to deal with ~ expansion at 
+ *	run-time.
+ */
+#$d_oldarchlib OLDARCHLIB_EXP "$oldarchlibexp"		/**/
+
+/* PRIVLIB_EXP:
+ *	This symbol contains the ~name expanded version of PRIVLIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define PRIVLIB_EXP "$privlibexp"		/**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order of
+ *	signal number. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT".
+ *	Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ *	etc., where nn is the actual signal number (e.g. NUM37).
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_num list.
+ */
+/* SIG_NUM:
+ *	This symbol contains a list of signal numbers, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup. 
+ *	Duplicates are allowed, but are moved to the end of the list.
+ *	The signal number corresponding to sig_name[i] is sig_number[i].
+ *	if (i < NSIG) then sig_number[i] == i.  
+ *	The last element is 0, corresponding to the 0 at the end of
+ *	the sig_name list.
+ */
+#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`",0	/**/
+#define SIG_NUM `echo $sig_num 0 | sed 's/ /,/g'`	/**/
+
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITEARCH_EXP "$sitearchexp"		/**/
+
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITELIB_EXP "$sitelibexp"		/**/
+
+/* STARTPERL:
+ *	This variable contains the string to put in front of a perl
+ *	script to make sure (one hopes) that it runs with perl and not
+ *	some shell.
+ */
+#define STARTPERL "$startperl"		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED $defvoidused
+#endif
+#define VOIDFLAGS $voidflags
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */
+#define M_VOID			/* Xenix strikes again */
+#endif
+
+#endif
+!GROK!THIS!
diff --git a/gnu/usr.bin/perl/configpm b/gnu/usr.bin/perl/configpm
new file mode 100644
index 00000000000..af1e716be6e
--- /dev/null
+++ b/gnu/usr.bin/perl/configpm
@@ -0,0 +1,255 @@
+#!./miniperl -w
+
+$config_pm = $ARGV[0] || 'lib/Config.pm';
+@ARGV = "./config.sh";
+
+# list names to put first (and hence lookup fastest)
+@fast = qw(archname osname osvers prefix libs libpth
+	dynamic_ext static_ext extensions dlsrc so
+	sig_name cc ccflags cppflags
+	privlibexp archlibexp installprivlib installarchlib
+	sharpbang startsh shsharp
+);
+
+# names of things which may need to have slashes changed to double-colons
+@extensions = qw(dynamic_ext static_ext extensions known_extensions);
+
+
+open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
+$myver = $];
+
+print CONFIG <<"ENDOFBEG";
+package Config;
+use Exporter ();
+\@ISA = (Exporter);
+\@EXPORT = qw(%Config);
+\@EXPORT_OK = qw(myconfig config_sh config_vars);
+
+\$] == $myver
+  or die "Perl lib version ($myver) doesn't match executable version (\$])\\n";
+
+# This file was created by configpm when Perl was built. Any changes
+# made to this file will be lost the next time perl is built.
+
+ENDOFBEG
+
+
+@fast{@fast} = @fast;
+@extensions{@extensions} = @extensions;
+@non_v=();
+@v_fast=();
+@v_others=();
+
+while (<>) {
+    next if m:^#!/bin/sh:;
+    # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
+    s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
+    unless (m/^(\w+)='(.*)'\s*$/){
+	push(@non_v, "#$_"); # not a name='value' line
+	next;
+    }
+    $name = $1;
+    if ($extensions{$name}) { s,/,::,g }
+    if (!$fast{$name}){ push(@v_others, $_); next; }
+    push(@v_fast,$_);
+}
+
+foreach(@non_v){ print CONFIG $_ }
+
+print CONFIG "\n",
+    "my \$config_sh = <<'!END!';\n",
+    join("", @v_fast, sort @v_others),
+    "!END!\n\n";
+
+# copy config summary format from the myconfig script
+
+print CONFIG "my \$summary = <<'!END!';\n";
+
+open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
+1 while( ($_=<MYCONFIG>) !~ /^Summary of/);
+do { print CONFIG $_ } until ($_ = <MYCONFIG>) =~ /^\s*$/;
+close(MYCONFIG);
+
+print CONFIG "\n!END!\n", <<'EOT';
+my $summary_expanded = 0;
+
+sub myconfig {
+	return $summary if $summary_expanded;
+	$summary =~ s/\$(\w+)/$Config{$1}/ge;
+	$summary_expanded = 1;
+	$summary;
+}
+EOT
+
+# ----
+
+print CONFIG <<'ENDOFEND';
+
+tie %Config, Config;
+sub TIEHASH { bless {} }
+sub FETCH { 
+    # check for cached value (which maybe undef so we use exists not defined)
+    return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
+ 
+    my($value); # search for the item in the big $config_sh string
+    return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
+ 
+    $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
+    $_[0]->{$_[1]} = $value; # cache it
+    return $value;
+}
+ 
+my $prevpos = 0;
+
+sub FIRSTKEY {
+    $prevpos = 0;
+    my($key) = $config_sh =~ m/^(.*?)=/;
+    $key;
+}
+
+sub NEXTKEY {
+    my $pos = index($config_sh, "\n", $prevpos) + 1;
+    my $len = index($config_sh, "=", $pos) - $pos;
+    $prevpos = $pos;
+    $len > 0 ? substr($config_sh, $pos, $len) : undef;
+}
+
+sub EXISTS { 
+     exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m; 
+}
+
+sub STORE  { die "\%Config::Config is read-only\n" }
+sub DELETE { &STORE }
+sub CLEAR  { &STORE }
+
+
+sub config_sh {
+    $config_sh
+}
+sub config_vars {
+    foreach(@_){
+	my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
+	$v='undef' unless defined $v;
+	print "$_='$v';\n";
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Config - access Perl configuration information
+
+=head1 SYNOPSIS
+
+    use Config;
+    if ($Config{'cc'} =~ /gcc/) {
+	print "built by gcc\n";
+    } 
+
+    use Config qw(myconfig config_sh config_vars);
+
+    print myconfig();
+
+    print config_sh();
+
+    config_vars(qw(osname archname));
+
+
+=head1 DESCRIPTION
+
+The Config module contains all the information that was available to
+the C<Configure> program at Perl build time (over 900 values).
+
+Shell variables from the F<config.sh> file (written by Configure) are
+stored in the readonly-variable C<%Config>, indexed by their names.
+
+Values stored in config.sh as 'undef' are returned as undefined
+values.  The perl C<exists> function can be used to check is a
+named variable exists.
+
+=over 4
+
+=item myconfig()
+
+Returns a textual summary of the major perl configuration values.
+See also C<-V> in L<perlrun/Switches>.
+
+=item config_sh()
+
+Returns the entire perl configuration information in the form of the
+original config.sh shell variable assignment script.
+
+=item config_vars(@names)
+
+Prints to STDOUT the values of the named configuration variable. Each is
+printed on a separate line in the form:
+
+  name='value';
+
+Names which are unknown are output as C<name='UNKNOWN';>.
+See also C<-V:name> in L<perlrun/Switches>.
+
+=back
+
+=head1 EXAMPLE
+
+Here's a more sophisticated example of using %Config:
+
+    use Config;
+
+    defined $Config{sig_name} || die "No sigs?";
+    foreach $name (split(' ', $Config{sig_name})) {
+	$signo{$name} = $i;
+	$signame[$i] = $name;
+	$i++;
+    }   
+
+    print "signal #17 = $signame[17]\n";
+    if ($signo{ALRM}) { 
+	print "SIGALRM is $signo{ALRM}\n";
+    }   
+
+=head1 WARNING
+
+Because this information is not stored within the perl executable
+itself it is possible (but unlikely) that the information does not
+relate to the actual perl binary which is being used to access it.
+
+The Config module is installed into the architecture and version
+specific library directory ($Config{installarchlib}) and it checks the
+perl version number when loaded.
+
+=head1 NOTE
+
+This module contains a good example of how to use tie to implement a
+cache and an example of how to make a tied variable readonly to those
+outside of it.
+
+=cut
+
+ENDOFEND
+
+close(CONFIG);
+
+# Now do some simple tests on the Config.pm file we have created
+unshift(@INC,'lib');
+require $config_pm;
+import Config;
+
+die "$0: $config_pm not valid"
+	unless $Config{'CONFIG'} eq 'true';
+
+die "$0: error processing $config_pm"
+	if defined($Config{'an impossible name'})
+	or $Config{'CONFIG'} ne 'true' # test cache
+	;
+
+die "$0: error processing $config_pm"
+	if eval '$Config{"cc"} = 1'
+	or eval 'delete $Config{"cc"}'
+	;
+
+
+exit 0;
diff --git a/gnu/usr.bin/perl/configure b/gnu/usr.bin/perl/configure
new file mode 100644
index 00000000000..7264ce76aef
--- /dev/null
+++ b/gnu/usr.bin/perl/configure
@@ -0,0 +1,112 @@
+#! /bin/sh
+#
+# $Id: configure,v 1.1.1.1 1996/08/19 10:11:33 downsj Exp $
+#
+# GNU configure-like front end to metaconfig's Configure.
+#
+# Written by Andy Dougherty <doughera@lafcol.lafayette.edu>
+# and Matthew Green <mrg@mame.mu.oz.au>.
+#
+# Reformatted and modified for inclusion in the dist-3.0 package by
+# Raphael Manfredi <ram@hptnos02.grenoble.hp.com>.
+#
+# This script belongs to the public domain and may be freely redistributed.
+#
+# The remaining of this leading shell comment may be removed if you
+# include this script in your own package.
+#
+# $Log: configure,v $
+# Revision 1.1.1.1  1996/08/19 10:11:33  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+# Revision 3.0.1.1  1995/07/25  14:16:21  ram
+# patch56: created
+#
+
+(exit $?0) || exec sh $0 $argv:q
+opts=''
+verbose=''
+create='-e'
+while test $# -gt 0; do
+	case $1 in
+    --help)
+		cat <<EOM
+Usage: configure [options]
+This is GNU configure-like front end for a metaconfig-generated Configure.
+It emulates the following GNU configure options (must be fully spelled out):
+	--help
+	--no-create
+	--prefix=PREFIX
+	--quiet
+	--silent
+	--verbose
+	--version
+
+And it honours these environment variables: CC, CFLAGS and DEFS.
+EOM
+		exit 0
+		;;
+	--no-create)
+		create='-E'
+		shift
+		;;
+	--prefix=*)
+		arg=`echo $1 | sed 's/--prefix=/-Dprefix=/'`
+		opts="$opts $arg"
+		shift
+		;;
+	--quiet|--silent)
+		exec >/dev/null 2>&1
+		shift
+		;;
+	--verbose)
+		verbose=true
+		shift
+		;;
+	--version)
+		copt="$copt -V"
+		shift
+		;;
+	--*)
+		opt=`echo $1 | sed 's/=.*//'`
+		echo "This GNU configure front end does not understand $opt"
+		exit 1
+		;;
+	*)
+		opts="$opts $1"
+		shift
+		;;
+	esac
+done
+
+case "$CC" in
+'') ;;
+*) opts="$opts -Dcc='$CC'";;
+esac
+
+# Join DEFS and CFLAGS together.
+ccflags=''
+case "$DEFS" in
+'') ;;
+*) ccflags=$DEFS;;
+esac
+case "$CFLAGS" in
+'') ;;
+*) ccflags="$ccflags $CFLAGS";;
+esac
+case "$ccflags" in
+'') ;;
+*) opts="$opts -Dccflags='$ccflags'";;
+esac
+
+# Don't use -s if they want verbose mode
+case "$verbose" in
+'') copt="$copt -ds";;
+*) copt="$copt -d";;
+esac
+
+set X sh Configure $copt $create $opts
+shift
+echo "$@"
+exec "$@"
diff --git a/gnu/usr.bin/perl/cop.h b/gnu/usr.bin/perl/cop.h
new file mode 100644
index 00000000000..b5033090d97
--- /dev/null
+++ b/gnu/usr.bin/perl/cop.h
@@ -0,0 +1,240 @@
+/*    cop.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+struct cop {
+    BASEOP
+    char *	cop_label;	/* label for this construct */
+    HV *	cop_stash;	/* package line was compiled in */
+    GV *	cop_filegv;	/* file the following line # is from */
+    U32		cop_seq;	/* parse sequence number */
+    I32		cop_arybase;	/* array base this line was compiled with */
+    line_t      cop_line;       /* line # of this command */
+};
+
+#define Nullcop Null(COP*)
+
+/*
+ * Here we have some enormously heavy (or at least ponderous) wizardry.
+ */
+
+/* subroutine context */
+struct block_sub {
+    CV *	cv;
+    GV *	gv;
+    GV *	dfoutgv;
+    AV *	savearray;
+    AV *	argarray;
+    U16		olddepth;
+    U8		hasargs;
+};
+
+#define PUSHSUB(cx)							\
+	cx->blk_sub.cv = cv;						\
+	cx->blk_sub.olddepth = CvDEPTH(cv);				\
+	cx->blk_sub.hasargs = hasargs;
+
+#define PUSHFORMAT(cx)							\
+	cx->blk_sub.cv = cv;						\
+	cx->blk_sub.gv = gv;						\
+	cx->blk_sub.hasargs = 0;					\
+	cx->blk_sub.dfoutgv = defoutgv;					\
+	(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
+
+#define POPSUB(cx)							\
+	if (cx->blk_sub.hasargs) {   /* put back old @_ */		\
+	    GvAV(defgv) = cx->blk_sub.savearray;			\
+	}								\
+	if (cx->blk_sub.cv) {						\
+	    if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) {	\
+		SvREFCNT_dec((SV*)cx->blk_sub.cv);			\
+	    }								\
+	}
+
+#define POPFORMAT(cx)							\
+	setdefout(cx->blk_sub.dfoutgv);					\
+	SvREFCNT_dec(cx->blk_sub.dfoutgv);
+
+/* eval context */
+struct block_eval {
+    I32		old_in_eval;
+    I32		old_op_type;
+    char *	old_name;
+    OP *	old_eval_root;
+    SV *	cur_text;
+};
+
+#define PUSHEVAL(cx,n,fgv)						\
+	cx->blk_eval.old_in_eval = in_eval;				\
+	cx->blk_eval.old_op_type = op->op_type;				\
+	cx->blk_eval.old_name = n;					\
+	cx->blk_eval.old_eval_root = eval_root;				\
+	cx->blk_eval.cur_text = linestr;
+
+#define POPEVAL(cx)							\
+	in_eval = cx->blk_eval.old_in_eval;				\
+	optype = cx->blk_eval.old_op_type;				\
+	eval_root = cx->blk_eval.old_eval_root;
+
+/* loop context */
+struct block_loop {
+    char *	label;
+    I32		resetsp;
+    OP *	redo_op;
+    OP *	next_op;
+    OP *	last_op;
+    SV **	itervar;
+    SV *	itersave;
+    AV *	iterary;
+    I32		iterix;
+};
+
+#define PUSHLOOP(cx, ivar, s)						\
+	cx->blk_loop.label = curcop->cop_label;				\
+	cx->blk_loop.resetsp = s - stack_base;				\
+	cx->blk_loop.redo_op = cLOOP->op_redoop;			\
+	cx->blk_loop.next_op = cLOOP->op_nextop;			\
+	cx->blk_loop.last_op = cLOOP->op_lastop;			\
+	cx->blk_loop.itervar = ivar;					\
+	if (ivar)							\
+	    cx->blk_loop.itersave = *cx->blk_loop.itervar;
+
+#define POPLOOP(cx)							\
+	newsp		= stack_base + cx->blk_loop.resetsp;
+
+/* context common to subroutines, evals and loops */
+struct block {
+    I32		blku_oldsp;	/* stack pointer to copy stuff down to */
+    COP *	blku_oldcop;	/* old curcop pointer */
+    I32		blku_oldretsp;	/* return stack index */
+    I32		blku_oldmarksp;	/* mark stack index */
+    I32		blku_oldscopesp;	/* scope stack index */
+    PMOP *	blku_oldpm;	/* values of pattern match vars */
+    U8		blku_gimme;	/* is this block running in list context? */
+
+    union {
+	struct block_sub	blku_sub;
+	struct block_eval	blku_eval;
+	struct block_loop	blku_loop;
+    } blk_u;
+};
+#define blk_oldsp	cx_u.cx_blk.blku_oldsp
+#define blk_oldcop	cx_u.cx_blk.blku_oldcop
+#define blk_oldretsp	cx_u.cx_blk.blku_oldretsp
+#define blk_oldmarksp	cx_u.cx_blk.blku_oldmarksp
+#define blk_oldscopesp	cx_u.cx_blk.blku_oldscopesp
+#define blk_oldpm	cx_u.cx_blk.blku_oldpm
+#define blk_gimme	cx_u.cx_blk.blku_gimme
+#define blk_sub		cx_u.cx_blk.blk_u.blku_sub
+#define blk_eval	cx_u.cx_blk.blk_u.blku_eval
+#define blk_loop	cx_u.cx_blk.blk_u.blku_loop
+
+/* Enter a block. */
+#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],		\
+	cx->cx_type		= t,					\
+	cx->blk_oldsp		= sp - stack_base,			\
+	cx->blk_oldcop		= curcop,				\
+	cx->blk_oldmarksp	= markstack_ptr - markstack,		\
+	cx->blk_oldscopesp	= scopestack_ix,			\
+	cx->blk_oldretsp	= retstack_ix,				\
+	cx->blk_oldpm		= curpm,				\
+	cx->blk_gimme		= gimme;				\
+	DEBUG_l( fprintf(stderr,"Entering block %ld, type %s\n",	\
+		    (long)cxstack_ix, block_type[t]); )
+
+/* Exit a block (RETURN and LAST). */
+#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],			\
+	newsp		= stack_base + cx->blk_oldsp,			\
+	curcop		= cx->blk_oldcop,				\
+	markstack_ptr	= markstack + cx->blk_oldmarksp,		\
+	scopestack_ix	= cx->blk_oldscopesp,				\
+	retstack_ix	= cx->blk_oldretsp,				\
+	pm		= cx->blk_oldpm,				\
+	gimme		= cx->blk_gimme;				\
+	DEBUG_l( fprintf(stderr,"Leaving block %ld, type %s\n",		\
+		    (long)cxstack_ix+1,block_type[cx->cx_type]); )
+
+/* Continue a block elsewhere (NEXT and REDO). */
+#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix],				\
+	stack_sp	= stack_base + cx->blk_oldsp,			\
+	markstack_ptr	= markstack + cx->blk_oldmarksp,		\
+	scopestack_ix	= cx->blk_oldscopesp,				\
+	retstack_ix	= cx->blk_oldretsp
+
+/* substitution context */
+struct subst {
+    I32		sbu_iters;
+    I32		sbu_maxiters;
+    I32		sbu_safebase;
+    I32		sbu_once;
+    I32		sbu_oldsave;
+    char *	sbu_orig;
+    SV *	sbu_dstr;
+    SV *	sbu_targ;
+    char *	sbu_s;
+    char *	sbu_m;
+    char *	sbu_strend;
+    char *	sbu_subbase;
+    REGEXP *	sbu_rx;
+};
+#define sb_iters	cx_u.cx_subst.sbu_iters
+#define sb_maxiters	cx_u.cx_subst.sbu_maxiters
+#define sb_safebase	cx_u.cx_subst.sbu_safebase
+#define sb_once		cx_u.cx_subst.sbu_once
+#define sb_oldsave	cx_u.cx_subst.sbu_oldsave
+#define sb_orig		cx_u.cx_subst.sbu_orig
+#define sb_dstr		cx_u.cx_subst.sbu_dstr
+#define sb_targ		cx_u.cx_subst.sbu_targ
+#define sb_s		cx_u.cx_subst.sbu_s
+#define sb_m		cx_u.cx_subst.sbu_m
+#define sb_strend	cx_u.cx_subst.sbu_strend
+#define sb_subbase	cx_u.cx_subst.sbu_subbase
+#define sb_rx		cx_u.cx_subst.sbu_rx
+
+#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],			\
+	cx->sb_iters		= iters,				\
+	cx->sb_maxiters		= maxiters,				\
+	cx->sb_safebase		= safebase,				\
+	cx->sb_once		= once,					\
+	cx->sb_oldsave		= oldsave,				\
+	cx->sb_orig		= orig,					\
+	cx->sb_dstr		= dstr,					\
+	cx->sb_targ		= targ,					\
+	cx->sb_s		= s,					\
+	cx->sb_m		= m,					\
+	cx->sb_strend		= strend,				\
+	cx->sb_rx		= rx,					\
+	cx->cx_type		= CXt_SUBST
+
+#define POPSUBST(cx) cxstack_ix--
+
+struct context {
+    I32		cx_type;	/* what kind of context this is */
+    union {
+	struct block	cx_blk;
+	struct subst	cx_subst;
+    } cx_u;
+};
+#define CXt_NULL	0
+#define CXt_SUB		1
+#define CXt_EVAL	2
+#define CXt_LOOP	3
+#define CXt_SUBST	4
+#define CXt_BLOCK	5
+
+#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
+
+/* "gimme" values */
+#define G_SCALAR	0
+#define G_ARRAY		1
+
+/* extra flags for perl_call_* routines */
+#define G_DISCARD	2	/* Call FREETMPS. */
+#define G_EVAL		4	/* Assume eval {} around subroutine call. */
+#define G_NOARGS	8	/* Don't construct a @_ array. */
+#define G_KEEPERR      16	/* Append errors to $@ rather than overwriting it */
diff --git a/gnu/usr.bin/perl/cv.h b/gnu/usr.bin/perl/cv.h
new file mode 100644
index 00000000000..b08cf5c1d06
--- /dev/null
+++ b/gnu/usr.bin/perl/cv.h
@@ -0,0 +1,65 @@
+/*    cv.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+struct xpvcv {
+    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*));
+    ANY		xcv_xsubany;
+    GV *	xcv_gv;
+    GV *	xcv_filegv;
+    long	xcv_depth;		/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+    U8		xcv_flags;
+};
+
+#define Nullcv Null(CV*)
+
+#define CvSTASH(sv)	((XPVCV*)SvANY(sv))->xcv_stash
+#define CvSTART(sv)	((XPVCV*)SvANY(sv))->xcv_start
+#define CvROOT(sv)	((XPVCV*)SvANY(sv))->xcv_root
+#define CvXSUB(sv)	((XPVCV*)SvANY(sv))->xcv_xsub
+#define CvXSUBANY(sv)	((XPVCV*)SvANY(sv))->xcv_xsubany
+#define CvGV(sv)	((XPVCV*)SvANY(sv))->xcv_gv
+#define CvFILEGV(sv)	((XPVCV*)SvANY(sv))->xcv_filegv
+#define CvDEPTH(sv)	((XPVCV*)SvANY(sv))->xcv_depth
+#define CvPADLIST(sv)	((XPVCV*)SvANY(sv))->xcv_padlist
+#define CvOUTSIDE(sv)	((XPVCV*)SvANY(sv))->xcv_outside
+#define CvFLAGS(sv)	((XPVCV*)SvANY(sv))->xcv_flags
+
+#define CVf_CLONE	0x01	/* anon CV uses external lexicals */
+#define CVf_CLONED	0x02	/* a clone of one of those */
+#define CVf_ANON	0x04	/* CvGV() can't be trusted */
+#define CVf_OLDSTYLE	0x08
+
+#define CvCLONE(cv)		(CvFLAGS(cv) & CVf_CLONE)
+#define CvCLONE_on(cv)		(CvFLAGS(cv) |= CVf_CLONE)
+#define CvCLONE_off(cv)		(CvFLAGS(cv) &= ~CVf_CLONE)
+
+#define CvCLONED(cv)		(CvFLAGS(cv) & CVf_CLONED)
+#define CvCLONED_on(cv)		(CvFLAGS(cv) |= CVf_CLONED)
+#define CvCLONED_off(cv)	(CvFLAGS(cv) &= ~CVf_CLONED)
+
+#define CvANON(cv)		(CvFLAGS(cv) & CVf_ANON)
+#define CvANON_on(cv)		(CvFLAGS(cv) |= CVf_ANON)
+#define CvANON_off(cv)		(CvFLAGS(cv) &= ~CVf_ANON)
+
+#define CvOLDSTYLE(cv)		(CvFLAGS(cv) & CVf_OLDSTYLE)
+#define CvOLDSTYLE_on(cv)	(CvFLAGS(cv) |= CVf_OLDSTYLE)
+#define CvOLDSTYLE_off(cv)	(CvFLAGS(cv) &= ~CVf_OLDSTYLE)
diff --git a/gnu/usr.bin/perl/deb.c b/gnu/usr.bin/perl/deb.c
new file mode 100644
index 00000000000..f518b19ad24
--- /dev/null
+++ b/gnu/usr.bin/perl/deb.c
@@ -0,0 +1,132 @@
+/*    deb.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "Didst thou think that the eyes of the White Tower were blind?  Nay, I
+ * have seen more than thou knowest, Gray Fool."  --Denethor
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef DEBUGGING
+#if !defined(I_STDARG) && !defined(I_VARARGS)
+
+/*
+ * Fallback on the old hackers way of doing varargs
+ */
+
+/*VARARGS1*/
+void
+deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
+    char *pat;
+{
+    register I32 i;
+    GV* gv = curcop->cop_filegv;
+
+    fprintf(stderr,"(%s:%ld)\t",
+	SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+	(long)curcop->cop_line);
+    for (i=0; i<dlevel; i++)
+	fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
+    fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
+}
+
+#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
+
+#  ifdef I_STDARG
+void
+deb(char *pat, ...)
+#  else
+/*VARARGS1*/
+void
+deb(pat, va_alist)
+    char *pat;
+    va_dcl
+#  endif
+{
+    va_list args;
+    register I32 i;
+    GV* gv = curcop->cop_filegv;
+
+    fprintf(stderr,"(%s:%ld)\t",
+	SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "<free>",
+	(long)curcop->cop_line);
+    for (i=0; i<dlevel; i++)
+	fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
+
+#  ifdef I_STDARG
+    va_start(args, pat);
+#  else
+    va_start(args);
+#  endif
+    (void) vfprintf(stderr,pat,args);
+    va_end( args );
+}
+#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
+
+void
+deb_growlevel()
+{
+    dlmax += 128;
+    Renew(debname, dlmax, char);
+    Renew(debdelim, dlmax, char);
+}
+
+I32
+debstackptrs()
+{
+    fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n",
+	(unsigned long)stack, (unsigned long)stack_base,
+	(long)*markstack_ptr, (long)(stack_sp-stack_base),
+	(long)(stack_max-stack_base));
+    fprintf(stderr, "%8lx %8lx %8ld %8ld %8ld\n",
+	(unsigned long)mainstack, (unsigned long)AvARRAY(stack),
+	(long)mainstack, (long)AvFILL(stack), (long)AvMAX(stack));
+    return 0;
+}
+
+I32
+debstack()
+{
+    I32 top = stack_sp - stack_base;
+    register I32 i = top - 30;
+    I32 *markscan = markstack;
+
+    if (i < 0)
+	i = 0;
+    
+    while (++markscan <= markstack_ptr)
+	if (*markscan >= i)
+	    break;
+
+    fprintf(stderr, i ? "    =>  ...  " : "    =>  ");
+    if (stack_base[0] != &sv_undef || stack_sp < stack_base)
+	fprintf(stderr, " [STACK UNDERFLOW!!!]\n");
+    do {
+	++i;
+	if (markscan <= markstack_ptr && *markscan < i) {
+	    do {
+		++markscan;
+		putc('*', stderr);
+	    }
+	    while (markscan <= markstack_ptr && *markscan < i);
+	    fprintf(stderr, "  ");
+	}
+	if (i > top)
+	    break;
+	fprintf(stderr, "%-4s  ", SvPEEK(stack_base[i]));
+    }
+    while (1);
+    fprintf(stderr, "\n");
+    return 0;
+}
+#else
+static int dummy; /* avoid totally empty deb.o file */
+#endif /* DEBUGGING */
diff --git a/gnu/usr.bin/perl/doio.c b/gnu/usr.bin/perl/doio.c
new file mode 100644
index 00000000000..f28da95521d
--- /dev/null
+++ b/gnu/usr.bin/perl/doio.c
@@ -0,0 +1,1567 @@
+/*    doio.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "Far below them they saw the white waters pour into a foaming bowl, and
+ * then swirl darkly about a deep oval basin in the rocks, until they found
+ * their way out again through a narrow gate, and flowed away, fuming and
+ * chattering, into calmer and more level reaches."
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#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
+#include <sys/shm.h>
+# ifndef HAS_SHMAT_PROTOTYPE
+    extern Shmat_t shmat _((int, char *, int));
+# endif
+#endif
+#endif
+
+#ifdef I_UTIME
+#include <utime.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
+# include <sys/socket.h>
+# include <netdb.h>
+# ifndef ENOTSOCK
+#  ifdef I_NET_ERRNO
+#   include <net/errno.h>
+#  endif
+# endif
+#endif
+
+bool
+do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
+GV *gv;
+register char *name;
+I32 len;
+int as_raw;
+int rawmode, rawperm;
+FILE *supplied_fp;
+{
+    register IO *io = GvIOn(gv);
+    FILE *saveifp = Nullfp;
+    FILE *saveofp = Nullfp;
+    char savetype = ' ';
+    int writing = 0;
+    FILE *fp;
+    int fd;
+    int result;
+
+    forkprocess = 1;		/* assume true if no fork */
+
+    if (IoIFP(io)) {
+	fd = fileno(IoIFP(io));
+	if (IoTYPE(io) == '-')
+	    result = 0;
+	else if (fd <= maxsysfd) {
+	    saveifp = IoIFP(io);
+	    saveofp = IoOFP(io);
+	    savetype = IoTYPE(io);
+	    result = 0;
+	}
+	else if (IoTYPE(io) == '|')
+	    result = my_pclose(IoIFP(io));
+	else if (IoIFP(io) != IoOFP(io)) {
+	    if (IoOFP(io)) {
+		result = fclose(IoOFP(io));
+		fclose(IoIFP(io));	/* clear stdio, fd already closed */
+	    }
+	    else
+		result = fclose(IoIFP(io));
+	}
+	else
+	    result = fclose(IoIFP(io));
+	if (result == EOF && fd > maxsysfd)
+	    fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
+	      GvENAME(gv));
+	IoOFP(io) = IoIFP(io) = Nullfp;
+    }
+
+    if (as_raw) {
+	result = rawmode & 3;
+	IoTYPE(io) = "<>++"[result];
+	writing = (result > 0);
+	fd = open(name, rawmode, rawperm);
+	if (fd == -1)
+	    fp = NULL;
+	else {
+	    fp = fdopen(fd, ((result == 0) ? "r"
+			     : (result == 1) ? "w"
+			     : "r+"));
+	    if (!fp)
+		close(fd);
+	}
+    }
+    else {
+	char *myname;
+	char mode[3];		/* stdio file mode ("r\0" or "r+\0") */
+	int dodup;
+
+	myname = savepvn(name, len);
+	SAVEFREEPV(myname);
+	name = myname;
+	while (len && isSPACE(name[len-1]))
+	    name[--len] = '\0';
+
+	mode[0] = mode[1] = mode[2] = '\0';
+	IoTYPE(io) = *name;
+	if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
+	    mode[1] = *name++;
+	    --len;
+	    writing = 1;
+	}
+
+	if (*name == '|') {
+	    /*SUPPRESS 530*/
+	    for (name++; isSPACE(*name); name++) ;
+	    if (strNE(name,"-"))
+		TAINT_ENV();
+	    TAINT_PROPER("piped open");
+	    if (dowarn && name[strlen(name)-1] == '|')
+		warn("Can't do bidirectional pipe");
+	    fp = my_popen(name,"w");
+	    writing = 1;
+	}
+	else if (*name == '>') {
+	    TAINT_PROPER("open");
+	    name++;
+	    if (*name == '>') {
+		mode[0] = IoTYPE(io) = 'a';
+		name++;
+	    }
+	    else
+		mode[0] = 'w';
+	    writing = 1;
+
+	    if (*name == '&') {
+	      duplicity:
+		dodup = 1;
+		name++;
+		if (*name == '=') {
+		    dodup = 0;
+		    name++;
+		}
+		if (!*name && supplied_fp)
+		    fp = supplied_fp;
+		else {
+		    /*SUPPRESS 530*/
+		    for (; isSPACE(*name); name++) ;
+		    if (isDIGIT(*name))
+			fd = atoi(name);
+		    else {
+			IO* thatio;
+			gv = gv_fetchpv(name,FALSE,SVt_PVIO);
+			thatio = GvIO(gv);
+			if (!thatio) {
+#ifdef EINVAL
+			    SETERRNO(EINVAL,SS$_IVCHAN);
+#endif
+			    goto say_false;
+			}
+			if (IoIFP(thatio)) {
+			    fd = fileno(IoIFP(thatio));
+			    if (IoTYPE(thatio) == 's')
+				IoTYPE(io) = 's';
+			}
+			else
+			    fd = -1;
+		    }
+		    if (dodup)
+			fd = dup(fd);
+		    if (!(fp = fdopen(fd,mode)))
+			if (dodup)
+			    close(fd);
+		}
+	    }
+	    else {
+		/*SUPPRESS 530*/
+		for (; isSPACE(*name); name++) ;
+		if (strEQ(name,"-")) {
+		    fp = stdout;
+		    IoTYPE(io) = '-';
+		}
+		else  {
+		    fp = fopen(name,mode);
+		}
+	    }
+	}
+	else if (*name == '<') {
+	    /*SUPPRESS 530*/
+	    for (name++; isSPACE(*name); name++) ;
+	    mode[0] = 'r';
+	    if (*name == '&')
+		goto duplicity;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		IoTYPE(io) = '-';
+	    }
+	    else
+		fp = fopen(name,mode);
+	}
+	else if (name[len-1] == '|') {
+	    name[--len] = '\0';
+	    while (len && isSPACE(name[len-1]))
+		name[--len] = '\0';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    if (strNE(name,"-"))
+		TAINT_ENV();
+	    TAINT_PROPER("piped open");
+	    fp = my_popen(name,"r");
+	    IoTYPE(io) = '|';
+	}
+	else {
+	    IoTYPE(io) = '<';
+	    /*SUPPRESS 530*/
+	    for (; isSPACE(*name); name++) ;
+	    if (strEQ(name,"-")) {
+		fp = stdin;
+		IoTYPE(io) = '-';
+	    }
+	    else
+		fp = fopen(name,"r");
+	}
+    }
+    if (!fp) {
+	if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
+	    warn(warn_nl, "open");
+	goto say_false;
+    }
+    if (IoTYPE(io) &&
+      IoTYPE(io) != '|' && IoTYPE(io) != '-') {
+	if (Fstat(fileno(fp),&statbuf) < 0) {
+	    (void)fclose(fp);
+	    goto say_false;
+	}
+	if (S_ISSOCK(statbuf.st_mode))
+	    IoTYPE(io) = 's';	/* in case a socket was passed in to us */
+#ifdef HAS_SOCKET
+	else if (
+#ifdef S_IFMT
+	    !(statbuf.st_mode & S_IFMT)
+#else
+	    !statbuf.st_mode
+#endif
+	) {
+	    int buflen = sizeof tokenbuf;
+	    if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
+		|| errno != ENOTSOCK)
+		IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
+				/* but some return 0 for streams too, sigh */
+	}
+#endif
+    }
+    if (saveifp) {		/* must use old fp? */
+	fd = fileno(saveifp);
+	if (saveofp) {
+	    Fflush(saveofp);		/* emulate fclose() */
+	    if (saveofp != saveifp) {	/* was a socket? */
+		fclose(saveofp);
+		if (fd > 2)
+		    Safefree(saveofp);
+	    }
+	}
+	if (fd != fileno(fp)) {
+	    int pid;
+	    SV *sv;
+
+	    dup2(fileno(fp), fd);
+	    sv = *av_fetch(fdpid,fileno(fp),TRUE);
+	    (void)SvUPGRADE(sv, SVt_IV);
+	    pid = SvIVX(sv);
+	    SvIVX(sv) = 0;
+	    sv = *av_fetch(fdpid,fd,TRUE);
+	    (void)SvUPGRADE(sv, SVt_IV);
+	    SvIVX(sv) = pid;
+	    fclose(fp);
+
+	}
+	fp = saveifp;
+	clearerr(fp);
+    }
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fd = fileno(fp);
+    fcntl(fd,F_SETFD,fd > maxsysfd);
+#endif
+    IoIFP(io) = fp;
+    if (writing) {
+	if (IoTYPE(io) == 's'
+	  || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
+	    if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
+		fclose(fp);
+		IoIFP(io) = Nullfp;
+		goto say_false;
+	    }
+	}
+	else
+	    IoOFP(io) = fp;
+    }
+    return TRUE;
+
+say_false:
+    IoIFP(io) = saveifp;
+    IoOFP(io) = saveofp;
+    IoTYPE(io) = savetype;
+    return FALSE;
+}
+
+FILE *
+nextargv(gv)
+register GV *gv;
+{
+    register SV *sv;
+#ifndef FLEXFILENAMES
+    int filedev;
+    int fileino;
+#endif
+    int fileuid;
+    int filegid;
+
+    if (!argvoutgv)
+	argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
+    if (filemode & (S_ISUID|S_ISGID)) {
+	Fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
+#ifdef HAS_FCHMOD
+	(void)fchmod(lastfd,filemode);
+#else
+	(void)chmod(oldname,filemode);
+#endif
+    }
+    filemode = 0;
+    while (av_len(GvAV(gv)) >= 0) {
+	STRLEN len;
+	sv = av_shift(GvAV(gv));
+	SAVEFREESV(sv);
+	sv_setsv(GvSV(gv),sv);
+	SvSETMAGIC(GvSV(gv));
+	oldname = SvPVx(GvSV(gv), len);
+	if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
+	    if (inplace) {
+		TAINT_PROPER("inplace open");
+		if (strEQ(oldname,"-")) {
+		    setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
+		    return IoIFP(GvIOp(gv));
+		}
+#ifndef FLEXFILENAMES
+		filedev = statbuf.st_dev;
+		fileino = statbuf.st_ino;
+#endif
+		filemode = statbuf.st_mode;
+		fileuid = statbuf.st_uid;
+		filegid = statbuf.st_gid;
+		if (!S_ISREG(filemode)) {
+		    warn("Can't do inplace edit: %s is not a regular file",
+		      oldname );
+		    do_close(gv,FALSE);
+		    continue;
+		}
+		if (*inplace) {
+#ifdef SUFFIX
+		    add_suffix(sv,inplace);
+#else
+		    sv_catpv(sv,inplace);
+#endif
+#ifndef FLEXFILENAMES
+		    if (Stat(SvPVX(sv),&statbuf) >= 0
+		      && statbuf.st_dev == filedev
+		      && statbuf.st_ino == fileino ) {
+			warn("Can't do inplace edit: %s > 14 characters",
+			  SvPVX(sv) );
+			do_close(gv,FALSE);
+			continue;
+		    }
+#endif
+#ifdef HAS_RENAME
+#ifndef DOSISH
+		    if (rename(oldname,SvPVX(sv)) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, SvPVX(sv), Strerror(errno) );
+			do_close(gv,FALSE);
+			continue;
+		    }
+#else
+		    do_close(gv,FALSE);
+		    (void)unlink(SvPVX(sv));
+		    (void)rename(oldname,SvPVX(sv));
+		    do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
+#endif /* MSDOS */
+#else
+		    (void)UNLINK(SvPVX(sv));
+		    if (link(oldname,SvPVX(sv)) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, SvPVX(sv), Strerror(errno) );
+			do_close(gv,FALSE);
+			continue;
+		    }
+		    (void)UNLINK(oldname);
+#endif
+		}
+		else {
+#ifndef DOSISH
+		    if (UNLINK(oldname) < 0) {
+			warn("Can't rename %s to %s: %s, skipping file",
+			  oldname, SvPVX(sv), Strerror(errno) );
+			do_close(gv,FALSE);
+			continue;
+		    }
+#else
+		    croak("Can't do inplace edit without backup");
+#endif
+		}
+
+		sv_setpvn(sv,">",1);
+		sv_catpv(sv,oldname);
+		SETERRNO(0,0);		/* in case sprintf set errno */
+		if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
+		    warn("Can't do inplace edit on %s: %s",
+		      oldname, Strerror(errno) );
+		    do_close(gv,FALSE);
+		    continue;
+		}
+		setdefout(argvoutgv);
+		lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
+		(void)Fstat(lastfd,&statbuf);
+#ifdef HAS_FCHMOD
+		(void)fchmod(lastfd,filemode);
+#else
+		(void)chmod(oldname,filemode);
+#endif
+		if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
+#ifdef HAS_FCHOWN
+		    (void)fchown(lastfd,fileuid,filegid);
+#else
+#ifdef HAS_CHOWN
+		    (void)chown(oldname,fileuid,filegid);
+#endif
+#endif
+		}
+	    }
+	    return IoIFP(GvIOp(gv));
+	}
+	else
+	    fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
+    }
+    if (inplace) {
+	(void)do_close(argvoutgv,FALSE);
+	setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
+    }
+    return Nullfp;
+}
+
+#ifdef HAS_PIPE
+void
+do_pipe(sv, rgv, wgv)
+SV *sv;
+GV *rgv;
+GV *wgv;
+{
+    register IO *rstio;
+    register IO *wstio;
+    int fd[2];
+
+    if (!rgv)
+	goto badexit;
+    if (!wgv)
+	goto badexit;
+
+    rstio = GvIOn(rgv);
+    wstio = GvIOn(wgv);
+
+    if (IoIFP(rstio))
+	do_close(rgv,FALSE);
+    if (IoIFP(wstio))
+	do_close(wgv,FALSE);
+
+    if (pipe(fd) < 0)
+	goto badexit;
+    IoIFP(rstio) = fdopen(fd[0], "r");
+    IoOFP(wstio) = fdopen(fd[1], "w");
+    IoIFP(wstio) = IoOFP(wstio);
+    IoTYPE(rstio) = '<';
+    IoTYPE(wstio) = '>';
+    if (!IoIFP(rstio) || !IoOFP(wstio)) {
+	if (IoIFP(rstio)) fclose(IoIFP(rstio));
+	else close(fd[0]);
+	if (IoOFP(wstio)) fclose(IoOFP(wstio));
+	else close(fd[1]);
+	goto badexit;
+    }
+
+    sv_setsv(sv,&sv_yes);
+    return;
+
+badexit:
+    sv_setsv(sv,&sv_undef);
+    return;
+}
+#endif
+
+bool
+#ifndef CAN_PROTOTYPE
+do_close(gv,explicit)
+GV *gv;
+bool explicit;
+#else
+do_close(GV *gv, bool explicit)
+#endif /* CAN_PROTOTYPE */
+{
+    bool retval;
+    IO *io;
+
+    if (!gv)
+	gv = argvgv;
+    if (!gv || SvTYPE(gv) != SVt_PVGV) {
+	SETERRNO(EBADF,SS$_IVCHAN);
+	return FALSE;
+    }
+    io = GvIO(gv);
+    if (!io) {		/* never opened */
+	if (dowarn && explicit)
+	    warn("Close on unopened file <%s>",GvENAME(gv));
+	return FALSE;
+    }
+    retval = io_close(io);
+    if (explicit) {
+	IoLINES(io) = 0;
+	IoPAGE(io) = 0;
+	IoLINES_LEFT(io) = IoPAGE_LEN(io);
+    }
+    IoTYPE(io) = ' ';
+    return retval;
+}
+
+bool
+io_close(io)
+IO* io;
+{
+    bool retval = FALSE;
+    int status;
+
+    if (IoIFP(io)) {
+	if (IoTYPE(io) == '|') {
+	    status = my_pclose(IoIFP(io));
+	    retval = (status == 0);
+	    statusvalue = FIXSTATUS(status);
+	}
+	else if (IoTYPE(io) == '-')
+	    retval = TRUE;
+	else {
+	    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {		/* a socket */
+		retval = (fclose(IoOFP(io)) != EOF);
+		fclose(IoIFP(io));	/* clear stdio, fd already closed */
+	    }
+	    else
+		retval = (fclose(IoIFP(io)) != EOF);
+	}
+	IoOFP(io) = IoIFP(io) = Nullfp;
+    }
+
+    return retval;
+}
+
+bool
+do_eof(gv)
+GV *gv;
+{
+    register IO *io;
+    int ch;
+
+    io = GvIO(gv);
+
+    if (!io)
+	return TRUE;
+
+    while (IoIFP(io)) {
+
+#ifdef USE_STDIO_PTR			/* (the code works without this) */
+	if (FILE_cnt(IoIFP(io)) > 0)	/* cheat a little, since */
+	    return FALSE;		/* this is the most usual case */
+#endif
+
+	ch = getc(IoIFP(io));
+	if (ch != EOF) {
+	    (void)ungetc(ch, IoIFP(io));
+	    return FALSE;
+	}
+#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
+	if (FILE_cnt(IoIFP(io)) < -1)
+	    FILE_cnt(IoIFP(io)) = -1;
+#endif
+	if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
+	    if (!nextargv(argvgv))	/* get another fp handy */
+		return TRUE;
+	}
+	else
+	    return TRUE;		/* normal fp, definitely end of file */
+    }
+    return TRUE;
+}
+
+long
+do_tell(gv)
+GV *gv;
+{
+    register IO *io;
+
+    if (!gv)
+	goto phooey;
+
+    io = GvIO(gv);
+    if (!io || !IoIFP(io))
+	goto phooey;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(IoIFP(io)))
+	(void)fseek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return ftell(IoIFP(io));
+
+phooey:
+    if (dowarn)
+	warn("tell() on unopened file");
+    SETERRNO(EBADF,RMS$_IFI);
+    return -1L;
+}
+
+bool
+do_seek(gv, pos, whence)
+GV *gv;
+long pos;
+int whence;
+{
+    register IO *io;
+
+    if (!gv)
+	goto nuts;
+
+    io = GvIO(gv);
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+#ifdef ULTRIX_STDIO_BOTCH
+    if (feof(IoIFP(io)))
+	(void)fseek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+#endif
+
+    return fseek(IoIFP(io), pos, whence) >= 0;
+
+nuts:
+    if (dowarn)
+	warn("seek() on unopened file");
+    SETERRNO(EBADF,RMS$_IFI);
+    return FALSE;
+}
+
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+	/* code courtesy of William Kucharski */
+#define HAS_CHSIZE
+
+I32 chsize(fd, length)
+I32 fd;			/* file descriptor */
+Off_t length;		/* length to set file to */
+{
+    extern long lseek();
+    struct flock fl;
+    struct stat filebuf;
+
+    if (Fstat(fd, &filebuf) < 0)
+	return -1;
+
+    if (filebuf.st_size < length) {
+
+	/* extend file length */
+
+	if ((lseek(fd, (length - 1), 0)) < 0)
+	    return -1;
+
+	/* write a "0" byte */
+
+	if ((write(fd, "", 1)) != 1)
+	    return -1;
+    }
+    else {
+	/* truncate length */
+
+	fl.l_whence = 0;
+	fl.l_len = 0;
+	fl.l_start = length;
+	fl.l_type = F_WRLCK;    /* write lock on file space */
+
+	/*
+	* This relies on the UNDOCUMENTED F_FREESP argument to
+	* fcntl(2), which truncates the file so that it ends at the
+	* position indicated by fl.l_start.
+	*
+	* Will minor miracles never cease?
+	*/
+
+	if (fcntl(fd, F_FREESP, &fl) < 0)
+	    return -1;
+
+    }
+
+    return 0;
+}
+#endif /* F_FREESP */
+
+I32
+looks_like_number(sv)
+SV *sv;
+{
+    register char *s;
+    register char *send;
+
+    if (!SvPOK(sv)) {
+	STRLEN len;
+	if (!SvPOKp(sv))
+	    return TRUE;
+	s = SvPV(sv, len);
+	send = s + len;
+    }
+    else {
+	s = SvPVX(sv); 
+	send = s + SvCUR(sv);
+    }
+    while (isSPACE(*s))
+	s++;
+    if (s >= send)
+	return FALSE;
+    if (*s == '+' || *s == '-')
+	s++;
+    while (isDIGIT(*s))
+	s++;
+    if (s == send)
+	return TRUE;
+    if (*s == '.') 
+	s++;
+    else if (s == SvPVX(sv))
+	return FALSE;
+    while (isDIGIT(*s))
+	s++;
+    if (s == send)
+	return TRUE;
+    if (*s == 'e' || *s == 'E') {
+	s++;
+	if (*s == '+' || *s == '-')
+	    s++;
+	while (isDIGIT(*s))
+	    s++;
+    }
+    while (isSPACE(*s))
+	s++;
+    if (s >= send)
+	return TRUE;
+    return FALSE;
+}
+
+bool
+do_print(sv,fp)
+register SV *sv;
+FILE *fp;
+{
+    register char *tmps;
+    STRLEN len;
+
+    /* assuming fp is checked earlier */
+    if (!sv)
+	return TRUE;
+    if (ofmt) {
+	if (SvGMAGICAL(sv))
+	    mg_get(sv);
+        if (SvIOK(sv) && SvIVX(sv) != 0) {
+	    fprintf(fp, ofmt, (double)SvIVX(sv));
+	    return !ferror(fp);
+	}
+	if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
+	   || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
+	    fprintf(fp, ofmt, SvNVX(sv));
+	    return !ferror(fp);
+	}
+    }
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	if (dowarn)
+	    warn(warn_uninit);
+	return TRUE;
+    case SVt_IV:
+	if (SvIOK(sv)) {
+	    if (SvGMAGICAL(sv))
+		mg_get(sv);
+	    fprintf(fp, "%ld", (long)SvIVX(sv));
+	    return !ferror(fp);
+	}
+	/* FALL THROUGH */
+    default:
+	tmps = SvPV(sv, len);
+	break;
+    }
+    if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
+	return FALSE;
+    return TRUE;
+}
+
+I32
+my_stat(ARGS)
+dARGS
+{
+    dSP;
+    IO *io;
+    GV* tmpgv;
+
+    if (op->op_flags & OPf_REF) {
+	EXTEND(sp,1);
+	tmpgv = cGVOP->op_gv;
+      do_fstat:
+	io = GvIO(tmpgv);
+	if (io && IoIFP(io)) {
+	    statgv = tmpgv;
+	    sv_setpv(statname,"");
+	    laststype = OP_STAT;
+	    return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
+	}
+	else {
+	    if (tmpgv == defgv)
+		return laststatval;
+	    if (dowarn)
+		warn("Stat on unopened file <%s>",
+		  GvENAME(tmpgv));
+	    statgv = Nullgv;
+	    sv_setpv(statname,"");
+	    return (laststatval = -1);
+	}
+    }
+    else {
+	SV* sv = POPs;
+	PUTBACK;
+	if (SvTYPE(sv) == SVt_PVGV) {
+	    tmpgv = (GV*)sv;
+	    goto do_fstat;
+	}
+	else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+	    tmpgv = (GV*)SvRV(sv);
+	    goto do_fstat;
+	}
+
+	statgv = Nullgv;
+	sv_setpv(statname,SvPV(sv, na));
+	laststype = OP_STAT;
+	laststatval = Stat(SvPV(sv, na),&statcache);
+	if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
+	    warn(warn_nl, "stat");
+	return laststatval;
+    }
+}
+
+I32
+my_lstat(ARGS)
+dARGS
+{
+    dSP;
+    SV *sv;
+    if (op->op_flags & OPf_REF) {
+	EXTEND(sp,1);
+	if (cGVOP->op_gv == defgv) {
+	    if (laststype != OP_LSTAT)
+		croak("The stat preceding -l _ wasn't an lstat");
+	    return laststatval;
+	}
+	croak("You can't use -l on a filehandle");
+    }
+
+    laststype = OP_LSTAT;
+    statgv = Nullgv;
+    sv = POPs;
+    PUTBACK;
+    sv_setpv(statname,SvPV(sv, na));
+#ifdef HAS_LSTAT
+    laststatval = lstat(SvPV(sv, na),&statcache);
+#else
+    laststatval = Stat(SvPV(sv, na),&statcache);
+#endif
+    if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
+	warn(warn_nl, "lstat");
+    return laststatval;
+}
+
+bool
+do_aexec(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+    register char **a;
+    char *tmps;
+
+    if (sp > mark) {
+	New(401,Argv, sp - mark + 1, char*);
+	a = Argv;
+	while (++mark <= sp) {
+	    if (*mark)
+		*a++ = SvPVx(*mark, na);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+	if (*Argv[0] != '/')	/* will execvp use PATH? */
+	    TAINT_ENV();		/* testing IFS here is overkill, probably */
+	if (really && *(tmps = SvPV(really, na)))
+	    execvp(tmps,Argv);
+	else
+	    execvp(Argv[0],Argv);
+	if (dowarn)
+	    warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
+    }
+    do_execfree();
+    return FALSE;
+}
+
+void
+do_execfree()
+{
+    if (Argv) {
+	Safefree(Argv);
+	Argv = Null(char **);
+    }
+    if (Cmd) {
+	Safefree(Cmd);
+	Cmd = Nullch;
+    }
+}
+
+bool
+do_exec(cmd)
+char *cmd;
+{
+    register char **a;
+    register char *s;
+    char flags[10];
+
+    while (*cmd && isSPACE(*cmd))
+	cmd++;
+
+    /* save an extra exec if possible */
+
+#ifdef CSH
+    if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
+	strcpy(flags,"-c");
+	s = cmd+cshlen+3;
+	if (*s == 'f') {
+	    s++;
+	    strcat(flags,"f");
+	}
+	if (*s == ' ')
+	    s++;
+	if (*s++ == '\'') {
+	    char *ncmd = s;
+
+	    while (*s)
+		s++;
+	    if (s[-1] == '\n')
+		*--s = '\0';
+	    if (s[-1] == '\'') {
+		*--s = '\0';
+		execl(cshname,"csh", flags,ncmd,(char*)0);
+		*s = '\'';
+		return FALSE;
+	    }
+	}
+    }
+#endif /* CSH */
+
+    /* see if there are shell metacharacters in it */
+
+    if (*cmd == '.' && isSPACE(cmd[1]))
+	goto doshell;
+
+    if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
+	goto doshell;
+
+    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
+    if (*s == '=')
+	goto doshell;
+
+    for (s = cmd; *s; s++) {
+	if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+	    if (*s == '\n' && !s[1]) {
+		*s = '\0';
+		break;
+	    }
+	  doshell:
+	    execl("/bin/sh","sh","-c",cmd,(char*)0);
+	    return FALSE;
+	}
+    }
+
+    New(402,Argv, (s - cmd) / 2 + 2, char*);
+    Cmd = savepvn(cmd, s-cmd);
+    a = Argv;
+    for (s = Cmd; *s;) {
+	while (*s && isSPACE(*s)) s++;
+	if (*s)
+	    *(a++) = s;
+	while (*s && !isSPACE(*s)) s++;
+	if (*s)
+	    *s++ = '\0';
+    }
+    *a = Nullch;
+    if (Argv[0]) {
+	execvp(Argv[0],Argv);
+	if (errno == ENOEXEC) {		/* for system V NIH syndrome */
+	    do_execfree();
+	    goto doshell;
+	}
+	if (dowarn)
+	    warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
+    }
+    do_execfree();
+    return FALSE;
+}
+
+I32
+apply(type,mark,sp)
+I32 type;
+register SV **mark;
+register SV **sp;
+{
+    register I32 val;
+    register I32 val2;
+    register I32 tot = 0;
+    char *s;
+    SV **oldmark = mark;
+
+    if (tainting) {
+	while (++mark <= sp) {
+	    MAGIC *mg;
+	    if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
+		tainted = TRUE;
+	}
+	mark = oldmark;
+    }
+    switch (type) {
+    case OP_CHMOD:
+	TAINT_PROPER("chmod");
+	if (++mark <= sp) {
+	    tot = sp - mark;
+	    val = SvIVx(*mark);
+	    while (++mark <= sp) {
+		if (chmod(SvPVx(*mark, na),val))
+		    tot--;
+	    }
+	}
+	break;
+#ifdef HAS_CHOWN
+    case OP_CHOWN:
+	TAINT_PROPER("chown");
+	if (sp - mark > 2) {
+	    val = SvIVx(*++mark);
+	    val2 = SvIVx(*++mark);
+	    tot = sp - mark;
+	    while (++mark <= sp) {
+		if (chown(SvPVx(*mark, na),val,val2))
+		    tot--;
+	    }
+	}
+	break;
+#endif
+#ifdef HAS_KILL
+    case OP_KILL:
+	TAINT_PROPER("kill");
+	s = SvPVx(*++mark, na);
+	tot = sp - mark;
+	if (isUPPER(*s)) {
+	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
+		s += 3;
+	    if (!(val = whichsig(s)))
+		croak("Unrecognized signal name \"%s\"",s);
+	}
+	else
+	    val = SvIVx(*mark);
+#ifdef VMS
+	/* kill() doesn't do process groups (job trees?) under VMS */
+	if (val < 0) val = -val;
+	if (val == SIGKILL) {
+#	    include <starlet.h>
+	    /* Use native sys$delprc() to insure that target process is
+	     * deleted; supervisor-mode images don't pay attention to
+	     * CRTL's emulation of Unix-style signals and kill()
+	     */
+	    while (++mark <= sp) {
+		I32 proc = SvIVx(*mark);
+		register unsigned long int __vmssts;
+		if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
+		    tot--;
+		    switch (__vmssts) {
+			case SS$_NONEXPR:
+			case SS$_NOSUCHNODE:
+			    SETERRNO(ESRCH,__vmssts);
+			    break;
+			case SS$_NOPRIV:
+			    SETERRNO(EPERM,__vmssts);
+			    break;
+			default:
+			    SETERRNO(EVMSERR,__vmssts);
+		    }
+		}
+	    }
+	    break;
+	}
+#endif
+	if (val < 0) {
+	    val = -val;
+	    while (++mark <= sp) {
+		I32 proc = SvIVx(*mark);
+#ifdef HAS_KILLPG
+		if (killpg(proc,val))	/* BSD */
+#else
+		if (kill(-proc,val))	/* SYSV */
+#endif
+		    tot--;
+	    }
+	}
+	else {
+	    while (++mark <= sp) {
+		if (kill(SvIVx(*mark),val))
+		    tot--;
+	    }
+	}
+	break;
+#endif
+    case OP_UNLINK:
+	TAINT_PROPER("unlink");
+	tot = sp - mark;
+	while (++mark <= sp) {
+	    s = SvPVx(*mark, na);
+	    if (euid || unsafe) {
+		if (UNLINK(s))
+		    tot--;
+	    }
+	    else {	/* don't let root wipe out directories without -U */
+#ifdef HAS_LSTAT
+		if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+#else
+		if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
+#endif
+		    tot--;
+		else {
+		    if (UNLINK(s))
+			tot--;
+		}
+	    }
+	}
+	break;
+#ifdef HAS_UTIME
+    case OP_UTIME:
+	TAINT_PROPER("utime");
+	if (sp - mark > 2) {
+#if defined(I_UTIME) || defined(VMS)
+	    struct utimbuf utbuf;
+#else
+	    struct {
+		long    actime;
+		long	modtime;
+	    } utbuf;
+#endif
+
+	    Zero(&utbuf, sizeof utbuf, char);
+	    utbuf.actime = SvIVx(*++mark);    /* time accessed */
+	    utbuf.modtime = SvIVx(*++mark);    /* time modified */
+	    tot = sp - mark;
+	    while (++mark <= sp) {
+		if (utime(SvPVx(*mark, na),&utbuf))
+		    tot--;
+	    }
+	}
+	else
+	    tot = 0;
+	break;
+#endif
+    }
+    return tot;
+}
+
+/* Do the permissions allow some operation?  Assumes statcache already set. */
+#ifndef VMS /* VMS' cando is in vms.c */
+I32
+cando(bit, effective, statbufp)
+I32 bit;
+I32 effective;
+register struct stat *statbufp;
+{
+#ifdef DOSISH
+    /* [Comments and code from Len Reed]
+     * MS-DOS "user" is similar to UNIX's "superuser," but can't write
+     * to write-protected files.  The execute permission bit is set
+     * by the Miscrosoft C library stat() function for the following:
+     *		.exe files
+     *		.com files
+     *		.bat files
+     *		directories
+     * All files and directories are readable.
+     * Directories and special files, e.g. "CON", cannot be
+     * write-protected.
+     * [Comment by Tom Dinger -- a directory can have the write-protect
+     *		bit set in the file system, but DOS permits changes to
+     *		the directory anyway.  In addition, all bets are off
+     *		here for networked software, such as Novell and
+     *		Sun's PC-NFS.]
+     */
+
+     /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
+      * too so it will actually look into the files for magic numbers
+      */
+     return (bit & statbufp->st_mode) ? TRUE : FALSE;
+
+#else /* ! MSDOS */
+    if ((effective ? euid : uid) == 0) {	/* root is special */
+	if (bit == S_IXUSR) {
+	    if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
+		return TRUE;
+	}
+	else
+	    return TRUE;		/* root reads and writes anything */
+	return FALSE;
+    }
+    if (statbufp->st_uid == (effective ? euid : uid) ) {
+	if (statbufp->st_mode & bit)
+	    return TRUE;	/* ok as "user" */
+    }
+    else if (ingroup((I32)statbufp->st_gid,effective)) {
+	if (statbufp->st_mode & bit >> 3)
+	    return TRUE;	/* ok as "group" */
+    }
+    else if (statbufp->st_mode & bit >> 6)
+	return TRUE;	/* ok as "other" */
+    return FALSE;
+#endif /* ! MSDOS */
+}
+#endif /* ! VMS */
+
+I32
+ingroup(testgid,effective)
+I32 testgid;
+I32 effective;
+{
+    if (testgid == (effective ? egid : gid))
+	return TRUE;
+#ifdef HAS_GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+    {
+	Groups_t gary[NGROUPS];
+	I32 anum;
+
+	anum = getgroups(NGROUPS,gary);
+	while (--anum >= 0)
+	    if (gary[anum] == testgid)
+		return TRUE;
+    }
+#endif
+    return FALSE;
+}
+
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+
+I32
+do_ipcget(optype, mark, sp)
+I32 optype;
+SV **mark;
+SV **sp;
+{
+    key_t key;
+    I32 n, flags;
+
+    key = (key_t)SvNVx(*++mark);
+    n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
+    flags = SvIVx(*++mark);
+    SETERRNO(0,0);
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case OP_MSGGET:
+	return msgget(key, flags);
+#endif
+#ifdef HAS_SEM
+    case OP_SEMGET:
+	return semget(key, n, flags);
+#endif
+#ifdef HAS_SHM
+    case OP_SHMGET:
+	return shmget(key, n, flags);
+#endif
+#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
+    default:
+	croak("%s not implemented", op_desc[optype]);
+#endif
+    }
+    return -1;			/* should never happen */
+}
+
+I32
+do_ipcctl(optype, mark, sp)
+I32 optype;
+SV **mark;
+SV **sp;
+{
+    SV *astr;
+    char *a;
+    I32 id, n, cmd, infosize, getinfo;
+    I32 ret = -1;
+
+    id = SvIVx(*++mark);
+    n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
+    cmd = SvIVx(*++mark);
+    astr = *++mark;
+    infosize = 0;
+    getinfo = (cmd == IPC_STAT);
+
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case OP_MSGCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct msqid_ds);
+	break;
+#endif
+#ifdef HAS_SHM
+    case OP_SHMCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct shmid_ds);
+	break;
+#endif
+#ifdef HAS_SEM
+    case OP_SEMCTL:
+	if (cmd == IPC_STAT || cmd == IPC_SET)
+	    infosize = sizeof(struct semid_ds);
+	else if (cmd == GETALL || cmd == SETALL)
+	{
+	    struct semid_ds semds;
+	    if (semctl(id, 0, IPC_STAT, &semds) == -1)
+		return -1;
+	    getinfo = (cmd == GETALL);
+	    infosize = semds.sem_nsems * sizeof(short);
+		/* "short" is technically wrong but much more portable
+		   than guessing about u_?short(_t)? */
+	}
+	break;
+#endif
+#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
+    default:
+	croak("%s not implemented", op_desc[optype]);
+#endif
+    }
+
+    if (infosize)
+    {
+	STRLEN len;
+	if (getinfo)
+	{
+	    SvPV_force(astr, len);
+	    a = SvGROW(astr, infosize+1);
+	}
+	else
+	{
+	    a = SvPV(astr, len);
+	    if (len != infosize)
+		croak("Bad arg length for %s, is %d, should be %d",
+			op_desc[optype], len, infosize);
+	}
+    }
+    else
+    {
+	I32 i = SvIV(astr);
+	a = (char *)i;		/* ouch */
+    }
+    SETERRNO(0,0);
+    switch (optype)
+    {
+#ifdef HAS_MSG
+    case OP_MSGCTL:
+	ret = msgctl(id, cmd, (struct msqid_ds *)a);
+	break;
+#endif
+#ifdef HAS_SEM
+    case OP_SEMCTL:
+	ret = semctl(id, n, cmd, (struct semid_ds *)a);
+	break;
+#endif
+#ifdef HAS_SHM
+    case OP_SHMCTL:
+	ret = shmctl(id, cmd, (struct shmid_ds *)a);
+	break;
+#endif
+    }
+    if (getinfo && ret >= 0) {
+	SvCUR_set(astr, infosize);
+	*SvEND(astr) = '\0';
+	SvSETMAGIC(astr);
+    }
+    return ret;
+}
+
+I32
+do_msgsnd(mark, sp)
+SV **mark;
+SV **sp;
+{
+#ifdef HAS_MSG
+    SV *mstr;
+    char *mbuf;
+    I32 id, msize, flags;
+    STRLEN len;
+
+    id = SvIVx(*++mark);
+    mstr = *++mark;
+    flags = SvIVx(*++mark);
+    mbuf = SvPV(mstr, len);
+    if ((msize = len - sizeof(long)) < 0)
+	croak("Arg too short for msgsnd");
+    SETERRNO(0,0);
+    return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
+#else
+    croak("msgsnd not implemented");
+#endif
+}
+
+I32
+do_msgrcv(mark, sp)
+SV **mark;
+SV **sp;
+{
+#ifdef HAS_MSG
+    SV *mstr;
+    char *mbuf;
+    long mtype;
+    I32 id, msize, flags, ret;
+    STRLEN len;
+
+    id = SvIVx(*++mark);
+    mstr = *++mark;
+    msize = SvIVx(*++mark);
+    mtype = (long)SvIVx(*++mark);
+    flags = SvIVx(*++mark);
+    if (SvTHINKFIRST(mstr)) {
+	if (SvREADONLY(mstr))
+	    croak("Can't msgrcv to readonly var");
+	if (SvROK(mstr))
+	    sv_unref(mstr);
+    }
+    SvPV_force(mstr, len);
+    mbuf = SvGROW(mstr, sizeof(long)+msize+1);
+    
+    SETERRNO(0,0);
+    ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
+    if (ret >= 0) {
+	SvCUR_set(mstr, sizeof(long)+ret);
+	*SvEND(mstr) = '\0';
+    }
+    return ret;
+#else
+    croak("msgrcv not implemented");
+#endif
+}
+
+I32
+do_semop(mark, sp)
+SV **mark;
+SV **sp;
+{
+#ifdef HAS_SEM
+    SV *opstr;
+    char *opbuf;
+    I32 id;
+    STRLEN opsize;
+
+    id = SvIVx(*++mark);
+    opstr = *++mark;
+    opbuf = SvPV(opstr, opsize);
+    if (opsize < sizeof(struct sembuf)
+	|| (opsize % sizeof(struct sembuf)) != 0) {
+	SETERRNO(EINVAL,LIB$_INVARG);
+	return -1;
+    }
+    SETERRNO(0,0);
+    return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
+#else
+    croak("semop not implemented");
+#endif
+}
+
+I32
+do_shmio(optype, mark, sp)
+I32 optype;
+SV **mark;
+SV **sp;
+{
+#ifdef HAS_SHM
+    SV *mstr;
+    char *mbuf, *shm;
+    I32 id, mpos, msize;
+    STRLEN len;
+    struct shmid_ds shmds;
+
+    id = SvIVx(*++mark);
+    mstr = *++mark;
+    mpos = SvIVx(*++mark);
+    msize = SvIVx(*++mark);
+    SETERRNO(0,0);
+    if (shmctl(id, IPC_STAT, &shmds) == -1)
+	return -1;
+    if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
+	SETERRNO(EFAULT,SS$_ACCVIO);		/* can't do as caller requested */
+	return -1;
+    }
+    shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    if (shm == (char *)-1)	/* I hate System V IPC, I really do */
+	return -1;
+    if (optype == OP_SHMREAD) {
+	SvPV_force(mstr, len);
+	mbuf = SvGROW(mstr, msize+1);
+
+	Copy(shm + mpos, mbuf, msize, char);
+	SvCUR_set(mstr, msize);
+	*SvEND(mstr) = '\0';
+	SvSETMAGIC(mstr);
+    }
+    else {
+	I32 n;
+
+	mbuf = SvPV(mstr, len);
+	if ((n = len) > msize)
+	    n = msize;
+	Copy(mbuf, shm + mpos, n, char);
+	if (n < msize)
+	    memzero(shm + mpos + n, msize - n);
+    }
+    return shmdt(shm);
+#else
+    croak("shm I/O not implemented");
+#endif
+}
+
+#endif /* SYSV IPC */
diff --git a/gnu/usr.bin/perl/doop.c b/gnu/usr.bin/perl/doop.c
new file mode 100644
index 00000000000..c906db70d11
--- /dev/null
+++ b/gnu/usr.bin/perl/doop.c
@@ -0,0 +1,684 @@
+/*    doop.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "'So that was the job I felt I had to do when I started,' thought Sam."
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
+I32
+do_trans(sv,arg)
+SV *sv;
+OP *arg;
+{
+    register short *tbl;
+    register U8 *s;
+    register U8 *send;
+    register U8 *d;
+    register I32 ch;
+    register I32 matches = 0;
+    register I32 squash = op->op_private & OPpTRANS_SQUASH;
+    STRLEN len;
+
+    if (SvREADONLY(sv))
+	croak(no_modify);
+    tbl = (short*)cPVOP->op_pv;
+    s = (U8*)SvPV(sv, len);
+    if (!len)
+	return 0;
+    if (!SvPOKp(sv))
+	s = (U8*)SvPV_force(sv, len);
+    (void)SvPOK_only(sv);
+    send = s + len;
+    if (!tbl || !s)
+	croak("panic: do_trans");
+    DEBUG_t( deb("2.TBL\n"));
+    if (!op->op_private) {
+	while (s < send) {
+	    if ((ch = tbl[*s]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	while (s < send) {
+	    if ((ch = tbl[*s]) >= 0) {
+		*d = ch;
+		if (matches++ && squash) {
+		    if (d[-1] == *d)
+			matches--;
+		    else
+			d++;
+		}
+		else
+		    d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
+	    s++;
+	}
+	matches += send - d;	/* account for disappeared chars */
+	*d = '\0';
+	SvCUR_set(sv, d - (U8*)SvPVX(sv));
+    }
+    SvSETMAGIC(sv);
+    return matches;
+}
+
+void
+do_join(sv,del,mark,sp)
+register SV *sv;
+SV *del;
+register SV **mark;
+register SV **sp;
+{
+    SV **oldmark = mark;
+    register I32 items = sp - mark;
+    register STRLEN len;
+    STRLEN delimlen;
+    register char *delim = SvPV(del, delimlen);
+    STRLEN tmplen;
+
+    mark++;
+    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
+    if (SvTYPE(sv) < SVt_PV)
+	sv_upgrade(sv, SVt_PV);
+    if (SvLEN(sv) < len + items) {	/* current length is way too short */
+	while (items-- > 0) {
+	    if (*mark) {
+		SvPV(*mark, tmplen);
+		len += tmplen;
+	    }
+	    mark++;
+	}
+	SvGROW(sv, len + 1);		/* so try to pre-extend */
+
+	mark = oldmark;
+	items = sp - mark;;
+	++mark;
+    }
+
+    if (items-- > 0) {
+	char *s;
+
+	if (*mark) {
+	    s = SvPV(*mark, tmplen);
+	    sv_setpvn(sv, s, tmplen);
+	}
+	else
+	    sv_setpv(sv, "");
+	mark++;
+    }
+    else
+	sv_setpv(sv,"");
+    len = delimlen;
+    if (len) {
+	for (; items > 0; items--,mark++) {
+	    sv_catpvn(sv,delim,len);
+	    sv_catsv(sv,*mark);
+	}
+    }
+    else {
+	for (; items > 0; items--,mark++)
+	    sv_catsv(sv,*mark);
+    }
+    SvSETMAGIC(sv);
+}
+
+void
+do_sprintf(sv,len,sarg)
+register SV *sv;
+register I32 len;
+register SV **sarg;
+{
+    register char *s;
+    register char *t;
+    register char *f;
+    bool dolong;
+#ifdef HAS_QUAD
+    bool doquad;
+#endif /* HAS_QUAD */
+    char ch;
+    register char *send;
+    register SV *arg;
+    char *xs;
+    I32 xlen;
+    I32 pre;
+    I32 post;
+    double value;
+    STRLEN arglen;
+
+    sv_setpv(sv,"");
+    len--;			/* don't count pattern string */
+    t = s = SvPV(*sarg, arglen);	/* XXX Don't know t is writeable */
+    send = s + arglen;
+    sarg++;
+    for ( ; ; len--) {
+
+	/*SUPPRESS 560*/
+	if (len <= 0 || !(arg = *sarg++))
+	    arg = &sv_no;
+
+	/*SUPPRESS 530*/
+	for ( ; t < send && *t != '%'; t++) ;
+	if (t >= send)
+	    break;		/* end of run_format string, ignore extra args */
+	f = t;
+	*buf = '\0';
+	xs = buf;
+#ifdef HAS_QUAD
+	doquad =
+#endif /* HAS_QUAD */
+	dolong = FALSE;
+	pre = post = 0;
+	for (t++; t < send; t++) {
+	    switch (*t) {
+	    default:
+		ch = *(++t);
+		*t = '\0';
+		(void)sprintf(xs,f);
+		len++, sarg--;
+		xlen = strlen(xs);
+		break;
+	    case 'n': case '*':
+		croak("Use of %c in printf format not supported", *t);
+
+	    case '0': case '1': case '2': case '3': case '4':
+	    case '5': case '6': case '7': case '8': case '9': 
+	    case '.': case '#': case '-': case '+': case ' ':
+		continue;
+	    case 'l':
+#ifdef HAS_QUAD
+		if (dolong) {
+		    dolong = FALSE;
+		    doquad = TRUE;
+		} else
+#endif
+		dolong = TRUE;
+		continue;
+	    case 'c':
+		ch = *(++t);
+		*t = '\0';
+		xlen = SvIV(arg);
+		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
+		    *xs = xlen;
+		    xs[1] = '\0';
+		    xlen = 1;
+		}
+		else {
+		    (void)sprintf(xs,f,xlen);
+		    xlen = strlen(xs);
+		}
+		break;
+	    case 'D':
+		dolong = TRUE;
+		/* FALL THROUGH */
+	    case 'd':
+		ch = *(++t);
+		*t = '\0';
+#ifdef HAS_QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(Quad_t)SvNV(arg));
+		else
+#endif
+		if (dolong)
+		    (void)sprintf(xs,f,(long)SvNV(arg));
+		else
+		    (void)sprintf(xs,f,SvIV(arg));
+		xlen = strlen(xs);
+		break;
+	    case 'X': case 'O':
+		dolong = TRUE;
+		/* FALL THROUGH */
+	    case 'x': case 'o': case 'u':
+		ch = *(++t);
+		*t = '\0';
+		value = SvNV(arg);
+#ifdef HAS_QUAD
+		if (doquad)
+		    (void)sprintf(buf,s,(unsigned Quad_t)value);
+		else
+#endif
+		if (dolong)
+		    (void)sprintf(xs,f,U_L(value));
+		else
+		    (void)sprintf(xs,f,U_I(value));
+		xlen = strlen(xs);
+		break;
+	    case 'E': case 'e': case 'f': case 'G': case 'g':
+		ch = *(++t);
+		*t = '\0';
+		(void)sprintf(xs,f,SvNV(arg));
+		xlen = strlen(xs);
+		break;
+	    case 's':
+		ch = *(++t);
+		*t = '\0';
+		xs = SvPV(arg, arglen);
+		xlen = (I32)arglen;
+		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
+		    break;		/* so handle simple cases */
+		}
+		else if (f[1] == '-') {
+		    char *mp = strchr(f, '.');
+		    I32 min = atoi(f+2);
+
+		    if (mp) {
+			I32 max = atoi(mp+1);
+
+			if (xlen > max)
+			    xlen = max;
+		    }
+		    if (xlen < min)
+			post = min - xlen;
+		    break;
+		}
+		else if (isDIGIT(f[1])) {
+		    char *mp = strchr(f, '.');
+		    I32 min = atoi(f+1);
+
+		    if (mp) {
+			I32 max = atoi(mp+1);
+
+			if (xlen > max)
+			    xlen = max;
+		    }
+		    if (xlen < min)
+			pre = min - xlen;
+		    break;
+		}
+		strcpy(tokenbuf+64,f);	/* sprintf($s,...$s...) */
+		*t = ch;
+		(void)sprintf(buf,tokenbuf+64,xs);
+		xs = buf;
+		xlen = strlen(xs);
+		break;
+	    }
+	    /* end of switch, copy results */
+	    *t = ch;
+	    if (xs == buf && xlen >= sizeof(buf)) {	/* Ooops! */
+		fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
+		my_exit(1);
+	    }
+	    SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
+	    sv_catpvn(sv, s, f - s);
+	    if (pre) {
+		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
+		SvCUR(sv) += pre;
+	    }
+	    sv_catpvn(sv, xs, xlen);
+	    if (post) {
+		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
+		SvCUR(sv) += post;
+	    }
+	    s = t;
+	    break;		/* break from for loop */
+	}
+    }
+    sv_catpvn(sv, s, t - s);
+    SvSETMAGIC(sv);
+}
+
+void
+do_vecset(sv)
+SV *sv;
+{
+    SV *targ = LvTARG(sv);
+    register I32 offset;
+    register I32 size;
+    register unsigned char *s;
+    register unsigned long lval;
+    I32 mask;
+    STRLEN targlen;
+    STRLEN len;
+
+    if (!targ)
+	return;
+    s = (unsigned char*)SvPV_force(targ, targlen);
+    lval = U_L(SvNV(sv));
+    offset = LvTARGOFF(sv);
+    size = LvTARGLEN(sv);
+    
+    len = (offset + size + 7) / 8;
+    if (len > targlen) {
+	s = (unsigned char*)SvGROW(targ, len + 1);
+	(void)memzero(s + targlen, len - targlen + 1);
+	SvCUR_set(targ, len);
+    }
+    
+    if (size < 8) {
+	mask = (1 << size) - 1;
+	size = offset & 7;
+	lval &= mask;
+	offset >>= 3;
+	s[offset] &= ~(mask << size);
+	s[offset] |= lval << size;
+    }
+    else {
+	offset >>= 3;
+	if (size == 8)
+	    s[offset] = lval & 255;
+	else if (size == 16) {
+	    s[offset] = (lval >> 8) & 255;
+	    s[offset+1] = lval & 255;
+	}
+	else if (size == 32) {
+	    s[offset] = (lval >> 24) & 255;
+	    s[offset+1] = (lval >> 16) & 255;
+	    s[offset+2] = (lval >> 8) & 255;
+	    s[offset+3] = lval & 255;
+	}
+    }
+}
+
+void
+do_chop(astr,sv)
+register SV *astr;
+register SV *sv;
+{
+    STRLEN len;
+    char *s;
+    
+    if (SvTYPE(sv) == SVt_PVAV) {
+	register I32 i;
+        I32 max;
+	AV* av = (AV*)sv;
+        max = AvFILL(av);
+        for (i = 0; i <= max; i++) {
+	    sv = (SV*)av_fetch(av, i, FALSE);
+	    if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
+		do_chop(astr, sv);
+	}
+        return;
+    }
+    if (SvTYPE(sv) == SVt_PVHV) {
+        HV* hv = (HV*)sv;
+	HE* entry;
+        (void)hv_iterinit(hv);
+        /*SUPPRESS 560*/
+        while (entry = hv_iternext(hv))
+            do_chop(astr,hv_iterval(hv,entry));
+        return;
+    }
+    s = SvPV(sv, len);
+    if (len && !SvPOK(sv))
+	s = SvPV_force(sv, len);
+    if (s && len) {
+	s += --len;
+	sv_setpvn(astr, s, 1);
+	*s = '\0';
+	SvCUR_set(sv, len);
+	SvNIOK_off(sv);
+    }
+    else
+	sv_setpvn(astr, "", 0);
+    SvSETMAGIC(sv);
+} 
+
+I32
+do_chomp(sv)
+register SV *sv;
+{
+    register I32 count;
+    STRLEN len;
+    char *s;
+
+    if (RsSNARF(rs))
+	return 0;
+    count = 0;
+    if (SvTYPE(sv) == SVt_PVAV) {
+	register I32 i;
+        I32 max;
+	AV* av = (AV*)sv;
+        max = AvFILL(av);
+        for (i = 0; i <= max; i++) {
+	    sv = (SV*)av_fetch(av, i, FALSE);
+	    if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
+		count += do_chomp(sv);
+	}
+        return count;
+    }
+    if (SvTYPE(sv) == SVt_PVHV) {
+        HV* hv = (HV*)sv;
+	HE* entry;
+        (void)hv_iterinit(hv);
+        /*SUPPRESS 560*/
+        while (entry = hv_iternext(hv))
+            count += do_chomp(hv_iterval(hv,entry));
+        return count;
+    }
+    s = SvPV(sv, len);
+    if (len && !SvPOKp(sv))
+	s = SvPV_force(sv, len);
+    if (s && len) {
+	s += --len;
+	if (RsPARA(rs)) {
+	    if (*s != '\n')
+		goto nope;
+	    ++count;
+	    while (len && s[-1] == '\n') {
+		--len;
+		--s;
+		++count;
+	    }
+	}
+	else {
+	    STRLEN rslen;
+	    char *rsptr = SvPV(rs, rslen);
+	    if (rslen == 1) {
+		if (*s != *rsptr)
+		    goto nope;
+		++count;
+	    }
+	    else {
+		if (len < rslen)
+		    goto nope;
+		len -= rslen - 1;
+		s -= rslen - 1;
+		if (bcmp(s, rsptr, rslen))
+		    goto nope;
+		count += rslen;
+	    }
+	}
+	*s = '\0';
+	SvCUR_set(sv, len);
+	SvNIOK_off(sv);
+    }
+  nope:
+    SvSETMAGIC(sv);
+    return count;
+} 
+
+void
+do_vop(optype,sv,left,right)
+I32 optype;
+SV *sv;
+SV *left;
+SV *right;
+{
+#ifdef LIBERAL
+    register long *dl;
+    register long *ll;
+    register long *rl;
+#endif
+    register char *dc;
+    STRLEN leftlen;
+    STRLEN rightlen;
+    register char *lc = SvPV(left, leftlen);
+    register char *rc = SvPV(right, rightlen);
+    register I32 len;
+    I32 lensave;
+
+    dc = SvPV_force(sv,na);
+    len = leftlen < rightlen ? leftlen : rightlen;
+    lensave = len;
+    if (SvCUR(sv) < len) {
+	dc = SvGROW(sv,len + 1);
+	(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
+    }
+    SvCUR_set(sv, len);
+    (void)SvPOK_only(sv);
+#ifdef LIBERAL
+    if (len >= sizeof(long)*4 &&
+	!((long)dc % sizeof(long)) &&
+	!((long)lc % sizeof(long)) &&
+	!((long)rc % sizeof(long)))	/* It's almost always aligned... */
+    {
+	I32 remainder = len % (sizeof(long)*4);
+	len /= (sizeof(long)*4);
+
+	dl = (long*)dc;
+	ll = (long*)lc;
+	rl = (long*)rc;
+
+	switch (optype) {
+	case OP_BIT_AND:
+	    while (len--) {
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+		*dl++ = *ll++ & *rl++;
+	    }
+	    break;
+	case OP_BIT_XOR:
+	    while (len--) {
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+		*dl++ = *ll++ ^ *rl++;
+	    }
+	    break;
+	case OP_BIT_OR:
+	    while (len--) {
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+		*dl++ = *ll++ | *rl++;
+	    }
+	}
+
+	dc = (char*)dl;
+	lc = (char*)ll;
+	rc = (char*)rl;
+
+	len = remainder;
+    }
+#endif
+    {
+	char *lsave = lc;
+	char *rsave = rc;
+	
+	switch (optype) {
+	case OP_BIT_AND:
+	    while (len--)
+		*dc++ = *lc++ & *rc++;
+	    break;
+	case OP_BIT_XOR:
+	    while (len--)
+		*dc++ = *lc++ ^ *rc++;
+	    goto mop_up;
+	case OP_BIT_OR:
+	    while (len--)
+		*dc++ = *lc++ | *rc++;
+	  mop_up:
+	    len = lensave;
+	    if (rightlen > len)
+		sv_catpvn(sv, rsave + len, rightlen - len);
+	    else if (leftlen > len)
+		sv_catpvn(sv, lsave + len, leftlen - len);
+	    else
+		*SvEND(sv) = '\0';
+	    break;
+	}
+    }
+}
+
+OP *
+do_kv(ARGS)
+dARGS
+{
+    dSP;
+    HV *hv = (HV*)POPs;
+    I32 i;
+    register HE *entry;
+    char *tmps;
+    SV *tmpstr;
+    I32 dokeys =   (op->op_type == OP_KEYS);
+    I32 dovalues = (op->op_type == OP_VALUES);
+
+    if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
+	dokeys = dovalues = TRUE;
+
+    if (!hv)
+	RETURN;
+
+    (void)hv_iterinit(hv);	/* always reset iterator regardless */
+
+    if (GIMME != G_ARRAY) {
+	dTARGET;
+
+	if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
+	    i = HvKEYS(hv);
+	else {
+	    i = 0;
+	    /*SUPPRESS 560*/
+	    while (entry = hv_iternext(hv)) {
+		i++;
+	    }
+	}
+	PUSHi( i );
+	RETURN;
+    }
+
+    /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
+    EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
+
+    PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
+    while (entry = hv_iternext(hv)) {
+	SPAGAIN;
+	if (dokeys) {
+	    tmps = hv_iterkey(entry,&i);	/* won't clobber stack_sp */
+	    if (!i)
+		tmps = "";
+	    XPUSHs(sv_2mortal(newSVpv(tmps,i)));
+	}
+	if (dovalues) {
+	    tmpstr = NEWSV(45,0);
+	    PUTBACK;
+	    sv_setsv(tmpstr,hv_iterval(hv,entry));
+	    SPAGAIN;
+	    DEBUG_H( {
+		sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
+		    HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
+		sv_setpv(tmpstr,buf);
+	    } )
+	    XPUSHs(sv_2mortal(tmpstr));
+	}
+	PUTBACK;
+    }
+    return NORMAL;
+}
+
diff --git a/gnu/usr.bin/perl/dosish.h b/gnu/usr.bin/perl/dosish.h
new file mode 100644
index 00000000000..e40e358b75a
--- /dev/null
+++ b/gnu/usr.bin/perl/dosish.h
@@ -0,0 +1,21 @@
+#define ABORT() abort();
+
+#define BIT_BUCKET "\dev\nul"
+#define PERL_SYS_INIT(c,v)
+#define PERL_SYS_TERM()
+#define dXSUB_SYS int dummy
+#define TMPPATH "plXXXXXX"
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define Stat(fname,bufptr) stat((fname),(bufptr))
+#define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
+
+#define my_getenv(var)  getenv(var)
diff --git a/gnu/usr.bin/perl/dump.c b/gnu/usr.bin/perl/dump.c
new file mode 100644
index 00000000000..19300e1fa86
--- /dev/null
+++ b/gnu/usr.bin/perl/dump.c
@@ -0,0 +1,392 @@
+/*    dump.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and
+ * it has not been hard for me to read your mind and memory.'"
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifndef DEBUGGING
+void
+dump_all()
+{
+}
+#else  /* Rest of file is for DEBUGGING */
+
+static void dump();
+
+void
+dump_all()
+{
+#ifdef HAS_SETLINEBUF
+    setlinebuf(stderr);
+#else
+    setvbuf(stderr, Nullch, _IOLBF, 0);
+#endif
+    if (main_root)
+	dump_op(main_root);
+    dump_packsubs(defstash);
+}
+
+void
+dump_packsubs(stash)
+HV* stash;
+{
+    I32	i;
+    HE	*entry;
+
+    if (!HvARRAY(stash))
+	return;
+    for (i = 0; i <= (I32) HvMAX(stash); i++) {
+	for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
+	    GV *gv = (GV*)entry->hent_val;
+	    HV *hv;
+	    if (GvCV(gv))
+		dump_sub(gv);
+	    if (GvFORM(gv))
+		dump_form(gv);
+	    if (entry->hent_key[entry->hent_klen-1] == ':' &&
+	      (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash)
+		dump_packsubs(hv);		/* nested package */
+	}
+    }
+}
+
+void
+dump_sub(gv)
+GV* gv;
+{
+    SV *sv = sv_newmortal();
+
+    gv_fullname(sv,gv);
+    dump("\nSUB %s = ", SvPVX(sv));
+    if (CvXSUB(GvCV(gv)))
+	dump("(xsub 0x%x %d)\n",
+	    (long)CvXSUB(GvCV(gv)),
+	    CvXSUBANY(GvCV(gv)).any_i32);
+    else if (CvROOT(GvCV(gv)))
+	dump_op(CvROOT(GvCV(gv)));
+    else
+	dump("<undef>\n");
+}
+
+void
+dump_form(gv)
+GV* gv;
+{
+    SV *sv = sv_newmortal();
+
+    gv_fullname(sv,gv);
+    dump("\nFORMAT %s = ", SvPVX(sv));
+    if (CvROOT(GvFORM(gv)))
+	dump_op(CvROOT(GvFORM(gv)));
+    else
+	dump("<undef>\n");
+}
+
+void
+dump_eval()
+{
+    dump_op(eval_root);
+}
+
+void
+dump_op(op)
+register OP *op;
+{
+    SV *tmpsv;
+
+    dump("{\n");
+    if (op->op_seq)
+	fprintf(stderr, "%-4d", op->op_seq);
+    else
+	fprintf(stderr, "    ");
+    dump("TYPE = %s  ===> ", op_name[op->op_type]);
+    if (op->op_next) {
+	if (op->op_seq)
+	    fprintf(stderr, "%d\n", op->op_next->op_seq);
+	else
+	    fprintf(stderr, "(%d)\n", op->op_next->op_seq);
+    }
+    else
+	fprintf(stderr, "DONE\n");
+    dumplvl++;
+    if (op->op_targ) {
+	if (op->op_type == OP_NULL)
+	    dump("  (was %s)\n", op_name[op->op_targ]);
+	else
+	    dump("TARG = %d\n", op->op_targ);
+    }
+#ifdef DUMPADDR
+    dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
+#endif
+    if (op->op_flags) {
+	*buf = '\0';
+	if (op->op_flags & OPf_KNOW) {
+	    if (op->op_flags & OPf_LIST)
+		(void)strcat(buf,"LIST,");
+	    else
+		(void)strcat(buf,"SCALAR,");
+	}
+	else
+	    (void)strcat(buf,"UNKNOWN,");
+	if (op->op_flags & OPf_KIDS)
+	    (void)strcat(buf,"KIDS,");
+	if (op->op_flags & OPf_PARENS)
+	    (void)strcat(buf,"PARENS,");
+	if (op->op_flags & OPf_STACKED)
+	    (void)strcat(buf,"STACKED,");
+	if (op->op_flags & OPf_REF)
+	    (void)strcat(buf,"REF,");
+	if (op->op_flags & OPf_MOD)
+	    (void)strcat(buf,"MOD,");
+	if (op->op_flags & OPf_SPECIAL)
+	    (void)strcat(buf,"SPECIAL,");
+	if (*buf)
+	    buf[strlen(buf)-1] = '\0';
+	dump("FLAGS = (%s)\n",buf);
+    }
+    if (op->op_private) {
+	*buf = '\0';
+	if (op->op_type == OP_AASSIGN) {
+	    if (op->op_private & OPpASSIGN_COMMON)
+		(void)strcat(buf,"COMMON,");
+	}
+	else if (op->op_type == OP_SASSIGN) {
+	    if (op->op_private & OPpASSIGN_BACKWARDS)
+		(void)strcat(buf,"BACKWARDS,");
+	}
+	else if (op->op_type == OP_TRANS) {
+	    if (op->op_private & OPpTRANS_SQUASH)
+		(void)strcat(buf,"SQUASH,");
+	    if (op->op_private & OPpTRANS_DELETE)
+		(void)strcat(buf,"DELETE,");
+	    if (op->op_private & OPpTRANS_COMPLEMENT)
+		(void)strcat(buf,"COMPLEMENT,");
+	}
+	else if (op->op_type == OP_REPEAT) {
+	    if (op->op_private & OPpREPEAT_DOLIST)
+		(void)strcat(buf,"DOLIST,");
+	}
+	else if (op->op_type == OP_ENTERSUB ||
+		 op->op_type == OP_RV2SV ||
+		 op->op_type == OP_RV2AV ||
+		 op->op_type == OP_RV2HV ||
+		 op->op_type == OP_RV2GV ||
+		 op->op_type == OP_AELEM ||
+		 op->op_type == OP_HELEM )
+	{
+	    if (op->op_private & OPpENTERSUB_AMPER)
+		(void)strcat(buf,"AMPER,");
+	    if (op->op_private & OPpENTERSUB_DB)
+		(void)strcat(buf,"DB,");
+	    if (op->op_private & OPpDEREF_AV)
+		(void)strcat(buf,"AV,");
+	    if (op->op_private & OPpDEREF_HV)
+		(void)strcat(buf,"HV,");
+	    if (op->op_private & HINT_STRICT_REFS)
+		(void)strcat(buf,"STRICT_REFS,");
+	}
+	else if (op->op_type == OP_CONST) {
+	    if (op->op_private & OPpCONST_BARE)
+		(void)strcat(buf,"BARE,");
+	}
+	else if (op->op_type == OP_FLIP) {
+	    if (op->op_private & OPpFLIP_LINENUM)
+		(void)strcat(buf,"LINENUM,");
+	}
+	else if (op->op_type == OP_FLOP) {
+	    if (op->op_private & OPpFLIP_LINENUM)
+		(void)strcat(buf,"LINENUM,");
+	}
+	if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO)
+	    (void)strcat(buf,"INTRO,");
+	if (*buf) {
+	    buf[strlen(buf)-1] = '\0';
+	    dump("PRIVATE = (%s)\n",buf);
+	}
+    }
+
+    switch (op->op_type) {
+    case OP_GVSV:
+    case OP_GV:
+	if (cGVOP->op_gv) {
+	    ENTER;
+	    tmpsv = NEWSV(0,0);
+	    SAVEFREESV(tmpsv);
+	    gv_fullname(tmpsv,cGVOP->op_gv);
+	    dump("GV = %s\n", SvPV(tmpsv, na));
+	    LEAVE;
+	}
+	else
+	    dump("GV = NULL\n");
+	break;
+    case OP_CONST:
+	dump("SV = %s\n", SvPEEK(cSVOP->op_sv));
+	break;
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+	if (cCOP->cop_line)
+	    dump("LINE = %d\n",cCOP->cop_line);
+	if (cCOP->cop_label)
+	    dump("LABEL = \"%s\"\n",cCOP->cop_label);
+	break;
+    case OP_ENTERLOOP:
+	dump("REDO ===> ");
+	if (cLOOP->op_redoop)
+	    fprintf(stderr, "%d\n", cLOOP->op_redoop->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	dump("NEXT ===> ");
+	if (cLOOP->op_nextop)
+	    fprintf(stderr, "%d\n", cLOOP->op_nextop->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	dump("LAST ===> ");
+	if (cLOOP->op_lastop)
+	    fprintf(stderr, "%d\n", cLOOP->op_lastop->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	break;
+    case OP_COND_EXPR:
+	dump("TRUE ===> ");
+	if (cCONDOP->op_true)
+	    fprintf(stderr, "%d\n", cCONDOP->op_true->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	dump("FALSE ===> ");
+	if (cCONDOP->op_false)
+	    fprintf(stderr, "%d\n", cCONDOP->op_false->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	break;
+    case OP_MAPWHILE:
+    case OP_GREPWHILE:
+    case OP_OR:
+    case OP_AND:
+	dump("OTHER ===> ");
+	if (cLOGOP->op_other)
+	    fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq);
+	else
+	    fprintf(stderr, "DONE\n");
+	break;
+    case OP_PUSHRE:
+    case OP_MATCH:
+    case OP_SUBST:
+	dump_pm((PMOP*)op);
+	break;
+    default:
+	break;
+    }
+    if (op->op_flags & OPf_KIDS) {
+	OP *kid;
+	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+	    dump_op(kid);
+    }
+    dumplvl--;
+    dump("}\n");
+}
+
+void
+dump_gv(gv)
+register GV *gv;
+{
+    SV *sv;
+
+    if (!gv) {
+	fprintf(stderr,"{}\n");
+	return;
+    }
+    sv = sv_newmortal();
+    dumplvl++;
+    fprintf(stderr,"{\n");
+    gv_fullname(sv,gv);
+    dump("GV_NAME = %s", SvPVX(sv));
+    if (gv != GvEGV(gv)) {
+	gv_efullname(sv,GvEGV(gv));
+	dump("-> %s", SvPVX(sv));
+    }
+    dump("\n");
+    dumplvl--;
+    dump("}\n");
+}
+
+void
+dump_pm(pm)
+register PMOP *pm;
+{
+    char ch;
+
+    if (!pm) {
+	dump("{}\n");
+	return;
+    }
+    dump("{\n");
+    dumplvl++;
+    if (pm->op_pmflags & PMf_ONCE)
+	ch = '?';
+    else
+	ch = '/';
+    if (pm->op_pmregexp)
+	dump("PMf_PRE %c%s%c\n",ch,pm->op_pmregexp->precomp,ch);
+    if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+	dump("PMf_REPL = ");
+	dump_op(pm->op_pmreplroot);
+    }
+    if (pm->op_pmshort) {
+	dump("PMf_SHORT = %s\n",SvPEEK(pm->op_pmshort));
+    }
+    if (pm->op_pmflags) {
+	*buf = '\0';
+	if (pm->op_pmflags & PMf_USED)
+	    (void)strcat(buf,"USED,");
+	if (pm->op_pmflags & PMf_ONCE)
+	    (void)strcat(buf,"ONCE,");
+	if (pm->op_pmflags & PMf_SCANFIRST)
+	    (void)strcat(buf,"SCANFIRST,");
+	if (pm->op_pmflags & PMf_ALL)
+	    (void)strcat(buf,"ALL,");
+	if (pm->op_pmflags & PMf_SKIPWHITE)
+	    (void)strcat(buf,"SKIPWHITE,");
+	if (pm->op_pmflags & PMf_FOLD)
+	    (void)strcat(buf,"FOLD,");
+	if (pm->op_pmflags & PMf_CONST)
+	    (void)strcat(buf,"CONST,");
+	if (pm->op_pmflags & PMf_KEEP)
+	    (void)strcat(buf,"KEEP,");
+	if (pm->op_pmflags & PMf_GLOBAL)
+	    (void)strcat(buf,"GLOBAL,");
+	if (pm->op_pmflags & PMf_RUNTIME)
+	    (void)strcat(buf,"RUNTIME,");
+	if (pm->op_pmflags & PMf_EVAL)
+	    (void)strcat(buf,"EVAL,");
+	if (*buf)
+	    buf[strlen(buf)-1] = '\0';
+	dump("PMFLAGS = (%s)\n",buf);
+    }
+
+    dumplvl--;
+    dump("}\n");
+}
+
+/* VARARGS1 */
+static void dump(arg1,arg2,arg3,arg4,arg5)
+char *arg1;
+long arg2, arg3, arg4, arg5;
+{
+    I32 i;
+
+    for (i = dumplvl*4; i; i--)
+	(void)putc(' ',stderr);
+    fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
+}
+#endif
diff --git a/gnu/usr.bin/perl/eg/ADB b/gnu/usr.bin/perl/eg/ADB
new file mode 100644
index 00000000000..ee214f3d893
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/ADB
@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+# $RCSfile: ADB,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:52 $
+
+# This script is only useful when used in your crash directory.
+
+$num = shift;
+exec 'adb', '-k', "vmunix.$num", "vmcore.$num";
diff --git a/gnu/usr.bin/perl/eg/README b/gnu/usr.bin/perl/eg/README
new file mode 100644
index 00000000000..87cfc334f14
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/README
@@ -0,0 +1,22 @@
+Although supplied with the perl package, the perl scripts in this eg
+directory and its subdirectories are placed in the public domain, and
+you may do anything with them that you wish.
+
+This stuff is supplied on an as-is basis--little attempt has been made to make
+any of it portable.  It's mostly here to give you an idea of what perl code
+looks like, and what tricks and idioms are used.
+
+System administrators responsible for many computers will enjoy the items
+down in the g directory very much.  The scan directory contains the beginnings
+of a system to check on and report various kinds of anomalies.
+
+If you machine doesn't support #!, the first thing you'll want to do is
+replace the #! with a couple of lines that look like this:
+
+	eval "exec /usr/bin/perl -S $0 $*"
+		if $running_under_some_shell;
+
+being sure to include any flags that were on the #! line.  A supplied script
+called "nih" will translate perl scripts in place for you:
+
+	nih g/g??
diff --git a/gnu/usr.bin/perl/eg/changes b/gnu/usr.bin/perl/eg/changes
new file mode 100644
index 00000000000..6a8868fbe4d
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/changes
@@ -0,0 +1,34 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: changes,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:52 $
+
+($dir, $days) = @ARGV;
+$dir = '/' if $dir eq '';
+$days = '14' if $days eq '';
+
+# Masscomps do things differently from Suns
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, "find $dir -mtime -$days -print |") ||
+	die "changes: can't run find";
+#else
+open(Find, "find $dir \\( -fstype nfs -prune \\) -o -mtime -$days -ls |") ||
+	die "changes: can't run find";
+#endif
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -ild $_`;
+    $_ = $x;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#else
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split(' ');
+#endif
+
+    printf("%10s%3s %-8s %-8s%9s %3s %2s %s\n",
+	    $perm,$links,$owner,$group,$size,$month,$day,$name);
+}
+
diff --git a/gnu/usr.bin/perl/eg/client b/gnu/usr.bin/perl/eg/client
new file mode 100644
index 00000000000..5900c90d095
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/client
@@ -0,0 +1,34 @@
+#!./perl
+
+$pat = 'S n C4 x8';
+$inet = 2;
+$echo = 7;
+$smtp = 25;
+$nntp = 119;
+$test = 2345;
+
+$SIG{'INT'} = 'dokill';
+
+$this = pack($pat,$inet,0,   128,149,13,43);
+$that = pack($pat,$inet,$test,127,0,0,1);
+
+if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
+if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
+if (connect(S,$that)) { print "connect ok\n"; } else { die $!; }
+
+select(S); $| = 1; select(stdout);
+
+if ($child = fork) {
+    while (<STDIN>) {
+	print S;
+    }
+    sleep 3;
+    do dokill();
+}
+else {
+    while (<S>) {
+	print;
+    }
+}
+
+sub dokill { kill 9,$child if $child; }
diff --git a/gnu/usr.bin/perl/eg/down b/gnu/usr.bin/perl/eg/down
new file mode 100644
index 00000000000..bbb0d062cbd
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/down
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+$| = 1;
+if ($#ARGV >= 0) {
+    $cmd = join(' ',@ARGV);
+}
+else {
+    print "Command: ";
+    $cmd = <stdin>;
+    chop($cmd);
+    while ($cmd =~ s/\\$//) {
+	print "+ ";
+	$cmd .= <stdin>;
+	chop($cmd);
+    }
+}
+$cwd = `pwd`; chop($cwd);
+
+open(FIND,'find . -type d -print|') || die "Can't run find";
+
+while (<FIND>) {
+    chop;
+    unless (chdir $_) {
+	print stderr "Can't cd to $_\n";
+	next;
+    }
+    print "\t--> ",$_,"\n";
+    system $cmd;
+    chdir $cwd;
+}
diff --git a/gnu/usr.bin/perl/eg/dus b/gnu/usr.bin/perl/eg/dus
new file mode 100644
index 00000000000..5f18a2fb990
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/dus
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+# $RCSfile: dus,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This script does a du -s on any directories in the current directory that
+# are not mount points for another filesystem.
+
+($mydev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('.');
+
+open(ls,'ls -F1|');
+
+while (<ls>) {
+    chop;
+    next unless s|/$||;
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat($_);
+    next unless $dev == $mydev;
+    push(@ary,$_);
+}
+
+exec 'du', '-s', @ary;
diff --git a/gnu/usr.bin/perl/eg/findcp b/gnu/usr.bin/perl/eg/findcp
new file mode 100644
index 00000000000..345a0064456
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findcp
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+# $RCSfile: findcp,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This is a wrapper around the find command that pretends find has a switch
+# of the form -cp host:destination.  It presumes your find implements -ls.
+# It uses tar to do the actual copy.  If your tar knows about the I switch
+# you may prefer to use findtar, since this one has to do the tar in batches.
+
+sub copy {
+    `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`;
+}
+
+$sourcedir = $ARGV[0];
+if ($sourcedir =~ /^\//) {
+    $ARGV[0] = '.';
+    unless (chdir($sourcedir)) { die "Can't find directory $sourcedir: $!"; }
+}
+
+$args = join(' ',@ARGV);
+if ($args =~ s/-cp *([^ ]+)/-ls/) {
+    $dest = $1;
+    if ($dest =~ /(.*):(.*)/) {
+	$desthost = $1;
+	$destdir = $2;
+    }
+    else {
+	die "Malformed destination--should be host:directory";
+    }
+}
+else {
+    die("No destination specified");
+}
+
+open(find,"find $args |") || die "Can't run find for you: $!";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { next;}
+    chop($filename = $x[10]);
+    if (length($list) > 5000) {
+	do copy();
+	$list = '';
+    }
+    else {
+	$list .= ' ';
+    }
+    $list .= $filename;
+}
+
+if ($list) {
+    do copy();
+}
diff --git a/gnu/usr.bin/perl/eg/findtar b/gnu/usr.bin/perl/eg/findtar
new file mode 100644
index 00000000000..9a5185a8e25
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/findtar
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+# $RCSfile: findtar,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+
+# findtar takes find-style arguments and spits out a tarfile on stdout.
+# It won't work unless your find supports -ls and your tar the I flag.
+
+$args = join(' ',@ARGV);
+open(find,"/usr/bin/find $args -ls |") || die "Can't run find for you.";
+
+open(tar,"| /bin/tar cIf - -") || die "Can't run tar for you: $!";
+
+while (<find>) {
+    @x = split(' ');
+    if ($x[2] =~ /^d/) { print tar '-d ';}
+    print tar $x[10],"\n";
+}
diff --git a/gnu/usr.bin/perl/eg/g/gcp b/gnu/usr.bin/perl/eg/g/gcp
new file mode 100644
index 00000000000..9c4c72ed7d3
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp
@@ -0,0 +1,114 @@
+#!/usr/bin/perl
+
+# $RCSfile: gcp,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Here is a script to do global rcps.  See man page.
+
+$#ARGV >= 1 || die "Not enough arguments.\n";
+
+if ($ARGV[0] eq '-r') {
+    $rcp = 'rcp -r';
+    shift;
+} else {
+    $rcp = 'rcp';
+}
+$args = $rcp;
+$dest = $ARGV[$#ARGV];
+
+$SIG{'QUIT'} = 'CLEANUP';
+$SIG{'INT'} = 'CONT';
+
+while ($arg = shift) {
+    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
+	if ($systype && $systype ne $1) {
+	    die "Can't mix system type specifers ($systype vs $1).\n";
+	}
+	$#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
+	$systype = $1;
+	$args .= " $arg";
+    } else {
+	if ($#ARGV >= 0) {
+	    if ($arg =~ /^[\/~]/) {
+		$arg =~ /^(.*)\// && ($dir = $1);
+	    } else {
+		if (!$pwd) {
+		    chop($pwd = `pwd`);
+		}
+		$dir = $pwd;
+	    }
+	}
+	if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
+	    $args .= " $dest$olddir; $rcp";
+	}
+	$olddir = $dir;
+	$args .= " $arg";
+    }
+}
+
+die "No system type specified.\n" unless $systype;
+
+$args =~ s/:$/:$olddir/;
+
+chop($thishost = `hostname`);
+
+$one_of_these = ":$systype:";
+if ($systype =~ s/\+/[+]/g) {
+    $one_of_these =~ s/\+/:/g;
+}
+$one_of_these =~ s/-/:-/g;
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {
+    s/[ \t]*\n//;
+    if (!$_ || /^#/) {
+	next line;
+    }
+    if (/^([a-zA-Z_0-9]+)=(.+)/) {
+	$name = $1; $repl = $2;
+	$repl =~ s/\+/:/g;
+	$repl =~ s/-/:-/g;
+	$one_of_these =~ s/:$name:/:$repl:/;
+	$repl =~ s/:/:-/g;
+	$one_of_these =~ s/:-$name:/:-$repl:/g;
+	next line;
+    }
+    @gh = split(' ');
+    $host = $gh[0];
+  next line if $host eq $thishost;	# should handle aliases too
+    $wanted = 0;
+    foreach $class (@gh) {
+	$wanted++ if index($one_of_these,":$class:") >= 0;
+	$wanted = -9999 if index($one_of_these,":-$class:") >= 0;
+    }
+    if ($wanted > 0) {
+	($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
+	print "$cmd\n";
+	$result = `$cmd 2>&1`;
+	$remainder .= "$host+" if
+	    $result =~ /Connection timed out|Permission denied/;
+	print $result;
+    }
+}
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+sub CLEANUP {
+    exit;
+}
+
+sub CONT {
+    print "Continuing...\n";	# Just ignore the signal that kills rcp
+    $remainder .= "$host+";
+}
diff --git a/gnu/usr.bin/perl/eg/g/gcp.man b/gnu/usr.bin/perl/eg/g/gcp.man
new file mode 100644
index 00000000000..28b6de80ac7
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gcp.man
@@ -0,0 +1,77 @@
+.\" $RCSfile: gcp.man,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:55 $
+.TH GCP 1C "13 May 1988"
+.SH NAME
+gcp \- global file copy
+.SH SYNOPSIS
+.B gcp
+file1 file2
+.br
+.B gcp
+[
+.B \-r
+] file ... directory
+.SH DESCRIPTION
+.I gcp
+works just like rcp(1C) except that you may specify a set of hosts to copy files
+from or to.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+	gcp /etc/motd sun:
+
+to copy your /etc/motd file to /etc/motd on all the Suns.
+If, on the other hand, you say
+
+	gcp /a/foo /b/bar sun:/tmp
+
+then your files will be copied to /tmp on all the Suns.
+The general rule is that if you don't specify the destination directory,
+files go to the same directory they are in currently.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+	gcp /a/foo /b/bar 750+mc:
+
+which will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
+/b/bar to /b/bar on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+	pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+	manny	sun3 pep
+.br
+	moe		sun3 pep
+.br
+	jack		sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+	foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+	foo=abc+def
+.br
+	bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+.PP
+Interrupting with a SIGINT will cause the rcp to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rcp(1C)
+.SH BUGS
+All the bugs of rcp, since it calls rcp.
diff --git a/gnu/usr.bin/perl/eg/g/ged b/gnu/usr.bin/perl/eg/g/ged
new file mode 100644
index 00000000000..e85ae1c0007
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/ged
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $RCSfile: ged,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Does inplace edits on a set of files on a set of machines.
+#
+# Typical invokation:
+#
+#	ged vax+sun /etc/passwd
+#	s/Freddy/Freddie/;
+#	^D
+#
+
+$class = shift;
+$files = join(' ',@ARGV);
+
+die "Usage: ged class files <perlcmds\n" unless $files;
+
+exec "gsh", $class, "-d", "perl -pi.bak - $files";
+
+die "Couldn't execute gsh for some reason, stopped";
diff --git a/gnu/usr.bin/perl/eg/g/ghosts b/gnu/usr.bin/perl/eg/g/ghosts
new file mode 100644
index 00000000000..96ec771c4a7
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/ghosts
@@ -0,0 +1,33 @@
+# This first section gives alternate sets defined in terms of the sets given
+# by the second section.  The order is important--all references must be
+# forward references.
+
+Nnd=sun-nd
+all=sun+mc+vax
+baseline=sun+mc
+sun=sun2+sun3
+vax=750+8600
+pep=manny+moe+jack
+
+# This second section defines the basic sets.  Each host should have a line
+# that specifies which sets it is a member of.  Extra sets should be separated
+# by white space.  (The first section isn't strictly necessary, since all sets
+# could be defined in the second section, but then it wouldn't be so readable.)
+
+basvax	8600	src
+cdb0	sun3		sys
+cdb1	sun3		sys
+cdb2	sun3		sys
+chief	sun3	src
+tis0	sun3
+manny	sun3		sys
+moe	sun3		sys
+jack	sun3		sys
+disney	sun3		sys
+huey	sun3		nd
+dewey	sun3		nd
+louie	sun3		nd
+bizet	sun2	src	sys
+gif0	mc	src
+mc0	mc
+dtv0	mc
diff --git a/gnu/usr.bin/perl/eg/g/gsh b/gnu/usr.bin/perl/eg/g/gsh
new file mode 100644
index 00000000000..e07a4ce6169
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh
@@ -0,0 +1,117 @@
+#! /usr/bin/perl
+
+# $RCSfile: gsh,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:55 $
+
+# Do rsh globally--see man page
+
+$SIG{'QUIT'} = 'quit';			# install signal handler for SIGQUIT
+
+sub getswitches {
+    while ($ARGV[0] =~ /^-/) {		# parse switches
+	$ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
+	$ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
+	$ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
+				next);
+	last;
+    }
+}
+
+do getswitches();			# get any switches before class
+$systype = shift;			# get name representing set of hosts
+do getswitches();			# same switches allowed after class
+
+if ($dodist) {				# distribute input over all rshes?
+    `cat >/tmp/gsh$$`;			#  get input into a handy place
+    $dist = " </tmp/gsh$$";		#  each rsh takes input from there
+}
+
+$cmd = join(' ',@ARGV);			# remaining args constitute the command
+$cmd =~ s/'/'"'"'/g;			# quote any embedded single quotes
+
+$one_of_these = ":$systype:";		# prepare to expand "macros"
+$one_of_these =~ s/\+/:/g;		# we hope to end up with list of
+$one_of_these =~ s/-/:-/g;		#  colon separated attributes
+
+@ARGV = ();
+push(@ARGV,'.grem') if -f '.grem';
+push(@ARGV,'.ghosts') if -f '.ghosts';
+push(@ARGV,'/etc/ghosts');
+
+$remainder = '';
+
+line: while (<>) {		# for each line of ghosts
+
+    s/[ \t]*\n//;			# trim trailing whitespace
+    if (!$_ || /^#/) {			# skip blank line or comment
+	next line;
+    }
+
+    if (/^(\w+)=(.+)/) {		# a macro line?
+	$name = $1; $repl = $2;
+	$repl =~ s/\+/:/g;
+	$repl =~ s/-/:-/g;
+	$one_of_these =~ s/:$name:/:$repl:/;	# do expansion in "wanted" list
+	$repl =~ s/:/:-/g;
+	$one_of_these =~ s/:-$name:/:-$repl:/;
+	next line;
+    }
+
+    # we have a normal line
+
+    @attr = split(' ');			# a list of attributes to match against
+					#   which we put into an array
+    $host = $attr[0];			# the first attribute is the host name
+    if ($showhost) {
+	$showhost = "$host:\t";
+    }
+
+    $wanted = 0;
+    foreach $attr (@attr) {		# iterate over attribute array
+	$wanted++ if index($one_of_these,":$attr:") >= 0;
+	$wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
+    }
+    if ($wanted > 0) {
+	print "rsh $host$l$n '$cmd'\n" unless $silent;
+	$SIG{'INT'} = 'DEFAULT';
+	if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) {	# start an rsh
+	    $SIG{'INT'} = 'cont';
+	    for ($iter=0; <PIPE>; $iter++) {
+		unless ($iter) {
+		    $remainder .= "$host+"
+			if /Connection timed out|Permission denied/;
+		}
+		print $showhost,$_;
+	    }
+	    close(PIPE);
+	} else {
+	    print "(Can't execute rsh: $!)\n";
+	    $SIG{'INT'} = 'cont';
+	}
+    }
+}
+
+unlink "/tmp/gsh$$" if $dodist;
+
+if ($remainder) {
+    chop($remainder);
+    open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
+    print grem 'rem=', $remainder, "\n";
+    close(grem);
+    print 'rem=', $remainder, "\n";
+}
+
+# here are a couple of subroutines that serve as signal handlers
+
+sub cont {
+    print "\rContinuing...\n";
+    $remainder .= "$host+";
+}
+
+sub quit {
+    $| = 1;
+    print "\r";
+    $SIG{'INT'} = '';
+    kill 2, $$;
+}
diff --git a/gnu/usr.bin/perl/eg/g/gsh.man b/gnu/usr.bin/perl/eg/g/gsh.man
new file mode 100644
index 00000000000..f80c17f2510
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/g/gsh.man
@@ -0,0 +1,80 @@
+.\" $RCSfile: gsh.man,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:55 $
+.TH GSH 8 "13 May 1988"
+.SH NAME
+gsh \- global shell
+.SH SYNOPSIS
+.B gsh
+[options]
+.I host
+[options] 
+.I command
+.SH DESCRIPTION
+.I gsh
+works just like rsh(1C) except that you may specify a set of hosts to execute
+the command on.
+The host sets are defined in the file /etc/ghosts.
+(An individual host name can be used as a set containing one member.)
+You can give a command like
+
+	gsh sun /etc/mungmotd
+
+to run /etc/mungmotd on all your Suns.
+.P
+You may specify the union of two or more sets by using + as follows:
+
+	gsh 750+mc /etc/mungmotd
+
+which will run mungmotd on all 750's and Masscomps.
+.P
+Commonly used sets should be defined in /etc/ghosts.
+For example, you could add a line that says
+
+	pep=manny+moe+jack
+
+Another way to do that would be to add the word "pep" after each of the host
+entries:
+
+	manny	sun3 pep
+.br
+	moe		sun3 pep
+.br
+	jack		sun3 pep
+
+Hosts and sets of host can also be excluded:
+
+	foo=sun-sun2
+
+Any host so excluded will never be included, even if a subsequent set on the
+line includes it:
+
+	foo=abc+def
+	bar=xyz-abc+foo
+
+comes out to xyz+def.
+
+You can define private host sets by creating .ghosts in your current directory
+with entries just like /etc/ghosts.
+Also, if there is a file .grem, it defines "rem" to be the remaining hosts
+from the last gsh or gcp that didn't succeed everywhere.
+
+Options include all those defined by rsh, as well as
+
+.IP "\-d" 8
+Causes gsh to collect input till end of file, and then distribute that input
+to each invokation of rsh.
+.IP "\-h" 8
+Rather than print out the command followed by the output, merely prepends the
+host name to each line of output.
+.IP "\-s" 8
+Do work silently.
+.PP
+Interrupting with a SIGINT will cause the rsh to the current host to be skipped
+and execution resumed with the next host.
+To stop completely, send a SIGQUIT.
+.SH SEE ALSO
+rsh(1C)
+.SH BUGS
+All the bugs of rsh, since it calls rsh.
+
+Also, will not properly return data from the remote execution that contains
+null characters.
diff --git a/gnu/usr.bin/perl/eg/muck b/gnu/usr.bin/perl/eg/muck
new file mode 100644
index 00000000000..873539b10c6
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/muck
@@ -0,0 +1,141 @@
+#!../perl
+
+$M = '-M';
+$M = '-m' if -d '/usr/uts' && -f '/etc/master';
+
+do 'getopt.pl';
+do Getopt('f');
+
+if ($opt_f) {
+    $makefile = $opt_f;
+}
+elsif (-f 'makefile') {
+    $makefile = 'makefile';
+}
+elsif (-f 'Makefile') {
+    $makefile = 'Makefile';
+}
+else {
+    die "No makefile\n";
+}
+
+$MF = 'mf00';
+
+while(($key,$val) = each(ENV)) {
+    $mac{$key} = $val;
+}
+
+do scan($makefile);
+
+$co = $action{'.c.o'};
+$co = ' ' unless $co;
+
+$missing = "Missing dependencies:\n";
+foreach $key (sort keys(o)) {
+    if ($oc{$key}) {
+	$src = $oc{$key};
+	$action = $action{$key};
+    }
+    else {
+	$action = '';
+    }
+    if (!$action) {
+	if ($co && ($c = $key) =~ s/\.o$/.c/ && -f $c) {
+	    $src = $c;
+	    $action = $co;
+	}
+	else {
+	    print "No source found for $key $c\n";
+	    next;
+	}
+    }
+    $I = '';
+    $D = '';
+    $I .= $1 while $action =~ s/(-I\S+\s*)//;
+    $D .= $1 . ' ' while $action =~ s/(-D\w+)//;
+    if ($opt_v) {
+	$cmd = "Checking $key: cc $M $D $I $src";
+	$cmd =~ s/\s\s+/ /g;
+	print stderr $cmd,"\n";
+    }
+    open(CPP,"cc $M $D $I $src|") || die "Can't run C preprocessor: $!";
+    while (<CPP>) {
+	($name,$dep) = split;
+	$dep =~ s|^\./||;
+	(print $missing,"$key: $dep\n"),($missing='')
+	    unless ($dep{"$key: $dep"} += 2) > 2;
+    }
+}
+
+$extra = "\nExtraneous dependencies:\n";
+foreach $key (sort keys(dep)) {
+    if ($key =~ /\.o: .*\.h$/ && $dep{$key} == 1) {
+	print $extra,$key,"\n";
+	$extra = '';
+    }
+}
+
+sub scan {
+    local($makefile) = @_;
+    local($MF) = $MF;
+    print stderr "Analyzing $makefile.\n" if $opt_v;
+    $MF++;
+    open($MF,$makefile) || die "Can't open $makefile: $!";
+    while (<$MF>) {
+	chop;
+	chop($_ = $_ . <$MF>) while s/\\$//;
+	next if /^#/;
+	next if /^$/;
+	s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+	s/\$\((\w+)\)/$mac{$1}/eg;
+	$mac{$1} = $2, next if /^(\w+)\s*=\s*(.*)/;
+	if (/^include\s+(.*)/) {
+	    do scan($1);
+	    print stderr "Continuing $makefile.\n" if $opt_v;
+	    next;
+	}
+	if (/^([^:]+):\s*(.*)/) {
+	    $left = $1;
+	    $right = $2;
+	    if ($right =~ /^([^;]*);(.*)/) {
+		$right = $1;
+		$action = $2;
+	    }
+	    else {
+		$action = '';
+	    }
+	    while (<$MF>) {
+		last unless /^\t/;
+		chop;
+		chop($_ = $_ . <$MF>) while s/\\$//;
+		next if /^#/;
+		last if /^$/;
+		s/\$\((\w+):([^=)]*)=([^)]*)\)/do subst("$1","$2","$3")/eg;
+		s/\$\((\w+)\)/$mac{$1}/eg;
+		$action .= $_;
+	    }
+	    foreach $targ (split(' ',$left)) {
+		$targ =~ s|^\./||;
+		foreach $src (split(' ',$right)) {
+		    $src =~ s|^\./||;
+		    $deplist{$targ} .= ' ' . $src;
+		    $dep{"$targ: $src"} = 1;
+		    $o{$src} = 1 if $src =~ /\.o$/;
+		    $oc{$targ} = $src if $targ =~ /\.o$/ && $src =~ /\.[yc]$/;
+		}
+		$action{$targ} .= $action;
+	    }
+	    redo if $_;
+	}
+    }
+    close($MF);
+}
+
+sub subst {
+    local($foo,$from,$to) = @_;
+    $foo = $mac{$foo};
+    $from =~ s/\./[.]/;
+    y/a/a/;
+    $foo =~ s/\b$from\b/$to/g;
+    $foo;
+}
diff --git a/gnu/usr.bin/perl/eg/muck.man b/gnu/usr.bin/perl/eg/muck.man
new file mode 100644
index 00000000000..38f2b9388c2
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/muck.man
@@ -0,0 +1,21 @@
+.\" $RCSfile: muck.man,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+.TH MUCK 1 "10 Jan 1989"
+.SH NAME
+muck \- make usage checker
+.SH SYNOPSIS
+.B muck
+[options]
+.SH DESCRIPTION
+.I muck
+looks at your current makefile and complains if you've left out any dependencies
+between .o and .h files.
+It also complains about extraneous dependencies.
+.PP
+You can use the -f FILENAME option to specify an alternate name for your
+makefile.
+The -v option is a little more verbose about what muck is mucking around
+with at the moment.
+.SH SEE ALSO
+make(1)
+.SH BUGS
+Only knows about .h, .c and .o files.
diff --git a/gnu/usr.bin/perl/eg/myrup b/gnu/usr.bin/perl/eg/myrup
new file mode 100644
index 00000000000..3aa24901b72
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/myrup
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+# $RCSfile: myrup,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This was a customization of ruptime requested by someone here who wanted
+# to be able to find the least loaded machine easily.  It uses the
+# /etc/ghosts file that's defined for gsh and gcp to prune down the
+# number of entries to those hosts we have administrative control over.
+
+print "node    load (u)\n------- --------\n";
+
+open(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts: $!";
+line: while (<ghosts>) {
+    next line if /^#/;
+    next line if /^$/;
+    next line if /=/;
+    ($host) = split;
+    $wanted{$host} = 1;
+}
+
+open(ruptime,'ruptime|') || die "Can't run ruptime: $!";
+open(sort,'|sort +1n');
+
+while (<ruptime>) {
+    ($host,$upness,$foo,$users,$foo,$foo,$load) = split(/[\s,]+/);
+    if ($wanted{$host} && $upness eq 'up') {
+	printf sort "%s\t%s (%d)\n", $host, $load, $users;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/nih b/gnu/usr.bin/perl/eg/nih
new file mode 100644
index 00000000000..e145c05906c
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/nih
@@ -0,0 +1,10 @@
+eval "exec /usr/bin/perl -Spi.bak $0 $*"
+	if $running_under_some_shell;
+
+# $RCSfile: nih,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+
+# This script makes #! scripts directly executable on machines that don't
+# support #!.  It edits in place any scripts mentioned on the command line.
+
+s|^#!(.*)|#!$1\neval "exec $1 -S \$0 \$*"\n\tif \$running_under_some_shell;|
+	if $. == 1;
diff --git a/gnu/usr.bin/perl/eg/relink b/gnu/usr.bin/perl/eg/relink
new file mode 100644
index 00000000000..cb48fb886fd
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/relink
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $RCSfile: relink,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:53 $
+#
+# $Log: relink,v $
+# Revision 1.1.1.1  1996/08/19 10:11:53  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+
+($op = shift) || die "Usage: relink perlexpr [filenames]\n";
+if (!@ARGV) {
+    @ARGV = <STDIN>;
+    chop(@ARGV);
+}
+for (@ARGV) {
+    next unless -l;		# symbolic link?
+    $name = $_;
+    $_ = readlink($_);
+    $was = $_;
+    eval $op;
+    die $@ if $@;
+    if ($was ne $_) {
+	unlink($name);
+	symlink($_, $name);
+    }
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RELINK 1 "July 30, 1990"
+.AT 3
+.SH LINK
+relink \- relinks multiple symbolic links
+.SH SYNOPSIS
+.B relink perlexpr [symlinknames]
+.SH DESCRIPTION
+.I Relink
+relinks the symbolic links given according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the names specified.
+For each symbolic link named on the command line, the Perl expression
+will be executed on the contents of the symbolic link with that name.
+If a given symbolic link's contents is not modified by the expression,
+it will not be changed.
+If a name given on the command line is not a symbolic link, it will be ignored.
+If no names are given on the command line, names will be read
+via standard input.
+.PP
+For example, to relink all symbolic links in the current directory
+pointing to somewhere in X11R3 so that they point to X11R4, you might say
+.nf
+
+	relink 's/X11R3/X11R4/' *
+
+.fi
+To change all occurences of links in the system from /usr/spool to /var/spool,
+you'd say
+.nf
+
+	find / -type l -print | relink 's#/usr/spool#/var/spool#'
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+ln(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.ex
diff --git a/gnu/usr.bin/perl/eg/rename b/gnu/usr.bin/perl/eg/rename
new file mode 100644
index 00000000000..aa1a65bf960
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rename
@@ -0,0 +1,78 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $RCSfile: rename,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:54 $
+#
+# $Log: rename,v $
+# Revision 1.1.1.1  1996/08/19 10:11:54  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+
+($op = shift) || die "Usage: rename perlexpr [filenames]\n";
+if (!@ARGV) {
+    @ARGV = <STDIN>;
+    chop(@ARGV);
+}
+for (@ARGV) {
+    $was = $_;
+    eval $op;
+    die $@ if $@;
+    rename($was,$_) unless $was eq $_;
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+.TH RENAME 1 "July 30, 1990"
+.AT 3
+.SH NAME
+rename \- renames multiple files
+.SH SYNOPSIS
+.B rename perlexpr [files]
+.SH DESCRIPTION
+.I Rename
+renames the filenames supplied according to the rule specified as the
+first argument.
+The argument is a Perl expression which is expected to modify the $_
+string in Perl for at least some of the filenames specified.
+If a given filename is not modified by the expression, it will not be
+renamed.
+If no filenames are given on the command line, filenames will be read
+via standard input.
+.PP
+For example, to rename all files matching *.bak to strip the extension,
+you might say
+.nf
+
+	rename 's/\e.bak$//' *.bak
+
+.fi
+To translate uppercase names to lower, you'd use
+.nf
+
+	rename 'y/A-Z/a-z/' *
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+mv(1)
+.br
+perl(1)
+.SH DIAGNOSTICS
+If you give an invalid Perl expression you'll get a syntax error.
+.SH BUGS
+.I Rename
+does not check for the existence of target filenames, so use with care.
+.ex
diff --git a/gnu/usr.bin/perl/eg/rmfrom b/gnu/usr.bin/perl/eg/rmfrom
new file mode 100644
index 00000000000..502e96251b1
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/rmfrom
@@ -0,0 +1,7 @@
+#!/usr/bin/perl -n
+
+# $RCSfile: rmfrom,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:54 $
+
+# A handy (but dangerous) script to put after a find ... -print.
+
+chop; unlink;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_df b/gnu/usr.bin/perl/eg/scan/scan_df
new file mode 100644
index 00000000000..0e77db85936
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_df
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_df,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This report points out filesystems that are in danger of overflowing.
+
+(chdir '/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+`df >newdf`;
+open(Df, 'olddf');
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused{$fs} = $used;
+}
+
+open(Df, 'newdf') || die "scan_df: can't open newdf";
+
+while (<Df>) {
+    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
+    next if $fs =~ /:/;
+    next if $fs eq '';
+    $oldused = $oldused{$fs};
+    next if ($oldused == $used && $capacity < 99);	# inactive filesystem
+    if ($capacity >= 90) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+	$_ = substr($_,0,13) . '        ' . substr($_,13,1000);
+	$kbytes /= 2;		# translate blocks to K
+	$used /= 2;
+	$oldused /= 2;
+	$avail /= 2;
+#endif
+	$diff = int($used - $oldused);
+	if ($avail < $diff * 2) {	# mark specially if in danger
+	    $mounted_on .= ' *';
+	}
+	next if $diff < 50 && $mounted_on eq '/';
+	$fs =~ s|/dev/||;
+	if ($diff >= 0) {
+	    $diff = '(+' . $diff . ')';
+	}
+	else {
+	    $diff = '(' . $diff . ')';
+	}
+	printf "%-8s%8d%8d %-8s%8d%7s    %s\n",
+	    $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
+    }
+}
+
+rename('newdf','olddf');
diff --git a/gnu/usr.bin/perl/eg/scan/scan_last b/gnu/usr.bin/perl/eg/scan/scan_last
new file mode 100644
index 00000000000..43c319ae042
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_last
@@ -0,0 +1,57 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_last,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This reports who was logged on at weird hours
+
+($dy, $mo, $lastdt) = split(/ +/,`date`);
+
+open(Last, 'exec last 2>&1 |') || die "scan_last: can't run last";
+
+while (<Last>) {
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $_ = substr($_,0,19) . substr($_,23,100);
+#endif
+    next if /^$/;
+    (print),next if m|^/|;
+    $login  = substr($_,0,8);
+    $tty    = substr($_,10,7);
+    $from   = substr($_,19,15);
+    $day    = substr($_,36,3);
+    $mo     = substr($_,40,3);
+    $dt     = substr($_,44,2);
+    $hr     = substr($_,47,2);
+    $min    = substr($_,50,2);
+    $dash   = substr($_,53,1);
+    $tohr   = substr($_,55,2);
+    $tomin  = substr($_,58,2);
+    $durhr  = substr($_,63,2);
+    $durmin = substr($_,66,2);
+    
+    next unless $hr;
+    next if $login eq 'reboot  ';
+    next if $login eq 'shutdown';
+
+    if ($dt != $lastdt) {
+	if ($lastdt < $dt) {
+	    $seen += $dt - $lastdt;
+	}
+	else {
+	    $seen++;
+	}
+	$lastdt = $dt;
+    }
+
+    $inat = $hr + $min / 60;
+    if ($tohr =~ /^[a-z]/) {
+	$outat = 12;		# something innocuous
+    } else {
+	$outat = $tohr + $tomin / 60;
+    }
+
+  last if $seen + ($inat < 8) > 1;
+
+    if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) {
+	print;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/scan/scan_messages b/gnu/usr.bin/perl/eg/scan/scan_messages
new file mode 100644
index 00000000000..14147e83b07
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_messages
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_messages,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This prints out extraordinary console messages.  You'll need to customize.
+
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+
+$maxpos = `cat oldmsgs 2>&1`;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Msgs, '/dev/null') || die "scan_messages: can't open messages";
+#else
+open(Msgs, '/usr/adm/messages') || die "scan_messages: can't open messages";
+#endif
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Msgs);
+
+if ($size < $maxpos) {		# Did somebody truncate messages file?
+    $maxpos = 0;
+}
+
+seek(Msgs,$maxpos,0);		# Start where we left off last time.
+
+while (<Msgs>) {
+    s/\[(\d+)\]/#/ && s/$1/#/g;
+#ifdef vax
+    $_ =~ s/[A-Z][a-z][a-z] +\w+ +[0-9:]+ +\w+ +//;
+    next if /root@.*:/;
+    next if /^vmunix: 4.3 BSD UNIX/;
+    next if /^vmunix: Copyright/;
+    next if /^vmunix: avail mem =/;
+    next if /^vmunix: SBIA0 at /;
+    next if /^vmunix: disk ra81 is/;
+    next if /^vmunix: dmf. at uba/;
+    next if /^vmunix: dmf.:.*asynch/;
+    next if /^vmunix: ex. at uba/;
+    next if /^vmunix: ex.: HW/;
+    next if /^vmunix: il. at uba/;
+    next if /^vmunix: il.: hardware/;
+    next if /^vmunix: ra. at uba/;
+    next if /^vmunix: ra.: media/;
+    next if /^vmunix: real mem/;
+    next if /^vmunix: syncing disks/;
+    next if /^vmunix: tms/;
+    next if /^vmunix: tmscp. at uba/;
+    next if /^vmunix: uba. at /;
+    next if /^vmunix: uda. at /;
+    next if /^vmunix: uda.: unit . ONLIN/;
+    next if /^vmunix: .*buffers containing/;
+    next if /^syslogd: .*newslog/;
+#endif
+    next if /unknown service/;
+    next if /^\.\.\.$/;
+    if (/^[A-Z][a-z][a-z] [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]/) {
+	$pfx = '';
+	next;
+    }
+    next if /^[ \t]*$/;
+    next if /^[ 0-9]*done$/;
+    if (/^A/) {
+	next if /^Accounting [sr]/;
+    }
+    elsif (/^C/) {
+	next if /^Called from/;
+	next if /^Copyright/;
+    }
+    elsif (/^E/) {
+	next if /^End traceback/;
+	next if /^Ethernet address =/;
+    }
+    elsif (/^K/) {
+	next if /^KERNEL MODE/;
+    }
+    elsif (/^R/) {
+	next if /^Rebooting Unix/;
+    }
+    elsif (/^S/) {
+	next if /^Sun UNIX 4\.2 Release/;
+    }
+    elsif (/^W/) {
+	next if /^WARNING: clock gained/;
+    }
+    elsif (/^a/) {
+	next if /^arg /;
+	next if /^avail mem =/;
+    }
+    elsif (/^b/) {
+	next if /^bwtwo[0-9] at /;
+    }
+    elsif (/^c/) {
+	next if /^cgone[0-9] at /;
+	next if /^cdp[0-9] at /;
+	next if /^csr /;
+    }
+    elsif (/^d/) {
+	next if /^dcpa: init/;
+	next if /^done$/;
+	next if /^dts/;
+	next if /^dump i\/o error/;
+	next if /^dumping to dev/;
+	next if /^dump succeeded/;
+	$pfx = '*' if /^dev = /;
+    }
+    elsif (/^e/) {
+	next if /^end \*\*/;
+	next if /^error in copy/;
+    }
+    elsif (/^f/) {
+	next if /^found /;
+    }
+    elsif (/^i/) {
+	next if /^ib[0-9] at /;
+	next if /^ie[0-9] at /;
+    }
+    elsif (/^l/) {
+	next if /^le[0-9] at /;
+    }
+    elsif (/^m/) {
+	next if /^mem = /;
+	next if /^mt[0-9] at /;
+	next if /^mti[0-9] at /;
+	$pfx = '*' if /^mode = /;
+    }
+    elsif (/^n/) {
+	next if /^not found /;
+    }
+    elsif (/^p/) {
+	next if /^page map /;
+	next if /^pi[0-9] at /;
+	$pfx = '*' if /^panic/;
+    }
+    elsif (/^q/) {
+	next if /^qqq /;
+    }
+    elsif (/^r/) {
+	next if /^read  /;
+	next if /^revarp: Requesting/;
+	next if /^root [od]/;
+    }
+    elsif (/^s/) {
+	next if /^sc[0-9] at /;
+	next if /^sd[0-9] at /;
+	next if /^sd[0-9]: </;
+	next if /^si[0-9] at /;
+	next if /^si_getstatus/;
+	next if /^sk[0-9] at /;
+	next if /^skioctl/;
+	next if /^skopen/;
+	next if /^skprobe/;
+	next if /^skread/;
+	next if /^skwrite/;
+	next if /^sky[0-9] at /;
+	next if /^st[0-9] at /;
+	next if /^st0:.*load/;
+	next if /^stat1 = /;
+	next if /^syncing disks/;
+	next if /^syslogd: going down on signal 15/;
+    }
+    elsif (/^t/) {
+	next if /^timeout [0-9]/;
+	next if /^tm[0-9] at /;
+	next if /^tod[0-9] at /;
+	next if /^tv [0-9]/;
+	$pfx = '*' if /^trap address/;
+    }
+    elsif (/^u/) {
+	next if /^unit nsk/;
+	next if /^use one of/;
+	$pfx = '' if /^using/;
+	next if /^using [0-9]+ buffers/;
+    }
+    elsif (/^x/) {
+	next if /^xy[0-9] at /;
+	next if /^write [0-9]/;
+	next if /^xy[0-9]: </;
+	next if /^xyc[0-9] at /;
+    }
+    elsif (/^y/) {
+	next if /^yyy [0-9]/;
+    }
+    elsif (/^z/) {
+	next if /^zs[0-9] at /;
+    }
+    $pfx = '*' if /^[a-z]+:$/;
+    s/pid [0-9]+: //;
+    if (/last message repeated ([0-9]+) time/) {
+	$seen{$last} += $1;
+	next;
+    }
+    s/^/$pfx/ if $pfx;
+    unless ($seen{$_}++) {
+	push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Msgs);
+
+open(tmp,'|sort >oldmsgs.tmp') || die "Can't create tmp file: $!\n";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldmsgs.tmp') || die "Can't reopen tmp file: $!\n";
+while (<tmp>) {
+    if (/^nd:/) {
+	next if $seen{$_} < 20;
+    }
+    if (/NFS/) {
+	next if $seen{$_} < 20;
+    }
+    if (/no carrier/) {
+	next if $seen{$_} < 20;
+    }
+    if (/silo overflow/) {
+	next if $seen{$_} < 20;
+    }
+    print $seen{$_},":\t",$_;
+}
+
+print `rm -f oldmsgs.tmp 2>&1; echo $max > oldmsgs 2>&1`;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_passwd b/gnu/usr.bin/perl/eg/scan/scan_passwd
new file mode 100644
index 00000000000..d4a90445eb5
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_passwd
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+# $RCSfile: scan_passwd,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This scans passwd file for security holes.
+
+open(Pass,'/etc/passwd') || die "Can't open passwd file: $!\n";
+# $dotriv = (`date` =~ /^Mon/);
+$dotriv = 1;
+
+while (<Pass>) {
+    ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/);
+    if ($shell eq '') {
+	print "Short: $_";
+    }
+    next if /^[+]/;
+    if ($pass eq '') {
+	if (index(":sync:lpq:+:", ":$login:") < 0) {
+	    print "No pass: $login\t$gcos\n";
+	}
+    }
+    elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) {
+	print "Trivial: $login\t$gcos\n";
+    }
+    if ($uid == 0) {
+	if ($login !~ /^.?root$/ && $pass ne '*') {
+	    print "Extra root: $_";
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/scan/scan_ps b/gnu/usr.bin/perl/eg/scan/scan_ps
new file mode 100644
index 00000000000..6d2fa2e4d0e
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_ps
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_ps,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:56 $
+
+# This looks for looping processes.
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Ps, '/bin/ps -el|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /rwhod/;
+    print if index(' T', substr($_,62,1)) < 0;
+}
+#else
+open(Ps, '/bin/ps auxww|') || die "scan_ps: can't run ps";
+
+while (<Ps>) {
+    next if /dataserver/;
+    next if /nfsd/;
+    next if /update/;
+    next if /ypserv/;
+    next if /rwhod/;
+    next if /routed/;
+    next if /pagedaemon/;
+#ifdef vax
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$start,$time) = split;
+#else
+    ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$time) = split;
+#endif
+    print if length($time) > 4;
+}
+#endif
diff --git a/gnu/usr.bin/perl/eg/scan/scan_sudo b/gnu/usr.bin/perl/eg/scan/scan_sudo
new file mode 100644
index 00000000000..8f86e9b3637
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_sudo
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_sudo,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:57 $
+
+# Analyze the sudo log.
+
+chdir('/usr/adm/private/memories') || die "Can't cd to memories: $!\n";
+
+if (open(Oldsudo,'oldsudo')) {
+    $maxpos = <Oldsudo>;
+    close Oldsudo;
+}
+else {
+    $maxpos = 0;
+    `echo 0 >oldsudo`;
+}
+
+unless (open(Sudo, '/usr/adm/sudo.log')) {
+    print "Somebody removed sudo.log!!!\n" if $maxpos;
+    exit 0;
+}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat(Sudo);
+
+if ($size < $maxpos) {
+    $maxpos = 0;
+    print "Somebody reset sudo.log!!!\n";
+}
+
+seek(Sudo,$maxpos,0);
+
+while (<Sudo>) {
+    s/^.* :[ \t]+//;
+    s/ipcrm.*/ipcrm/;
+    s/kill.*/kill/;
+    unless ($seen{$_}++) {
+	push(@seen,$_);
+    }
+    $last = $_;
+}
+$max = tell(Sudo);
+
+open(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file: $!\n";
+while ($_ = pop(@seen)) {
+    print tmp $_;
+}
+close(tmp);
+open(tmp,'oldsudo.tmp') || die "Can't reopen tmp file: $!\n";
+while (<tmp>) {
+    print $seen{$_},":\t",$_;
+}
+
+print `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`;
diff --git a/gnu/usr.bin/perl/eg/scan/scan_suid b/gnu/usr.bin/perl/eg/scan/scan_suid
new file mode 100644
index 00000000000..51f886f52f0
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scan_suid
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -P
+
+# $RCSfile: scan_suid,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:57 $
+
+# Look for new setuid root files.
+
+chdir '/usr/adm/private/memories' || die "Can't cd to memories: $!\n";
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat('oldsuid');
+if ($nlink) {
+    $lasttime = $mtime;
+    $tmp = $ctime - $atime;
+    if ($tmp <= 0 || $tmp >= 10) {
+	print "WARNING: somebody has read oldsuid!\n";
+    }
+    $tmp = $ctime - $mtime;
+    if ($tmp <= 0 || $tmp >= 10) {
+	print "WARNING: somebody has modified oldsuid!!!\n";
+    }
+} else {
+    $lasttime = time - 60 * 60 * 24;	# one day ago
+}
+$thistime = time;
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+open(Find, 'find / -perm -04000 -print |') ||
+	die "scan_find: can't run find";
+#else
+open(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
+	die "scan_find: can't run find";
+#endif
+
+open(suid, '>newsuid.tmp');
+
+while (<Find>) {
+
+#if defined(mc300) || defined(mc500) || defined(mc700)
+    $x = `/bin/ls -il $_`;
+    $_ = $x;
+    s/^ *//;
+    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#else
+    s/^ *//;
+    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
+      = split;
+#endif
+
+    if ($perm =~ /[sS]/ && $owner eq 'root') {
+	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+	   $blksize,$blocks) = stat($name);
+	$foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
+		$perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
+	print suid $foo;
+	if ($ctime > $lasttime) {
+	    if ($ctime > $thistime) {
+		print "Future file: $foo";
+	    }
+	    else {
+		$ct .= $foo;
+	    }
+	}
+    }
+}
+close(suid);
+
+print `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
+$foo = `/bin/diff oldsuid newsuid 2>&1`;
+print "Differences in suid info:\n",$foo if $foo;
+print `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
+print `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
+print `rm -f newsuid.tmp 2>&1`;
+
+@ct = split(/\n/,$ct);
+$ct = '';
+$* = 1;
+while ($#ct >= 0) {
+    $tmp = shift(@ct);
+    unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
+}
+
+print "Inode changed since last time:\n",$ct if $ct;
+
diff --git a/gnu/usr.bin/perl/eg/scan/scanner b/gnu/usr.bin/perl/eg/scan/scanner
new file mode 100644
index 00000000000..dbc8057791d
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/scan/scanner
@@ -0,0 +1,87 @@
+#!/usr/bin/perl
+
+# $RCSfile: scanner,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:57 $
+
+# This runs all the scan_* routines on all the machines in /etc/ghosts.
+# We run this every morning at about 6 am:
+
+#	!/bin/sh
+#	cd /usr/adm/private
+#	decrypt scanner | perl >scan.out 2>&1
+#	mail admin <scan.out
+
+# Note that the scan_* files should be encrypted with the key "-inquire", and
+# scanner should be encrypted somehow so that people can't find that key.
+# I leave it up to you to figure out how to unencrypt it before executing.
+
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
+
+$| = 1;		# command buffering on stdout
+
+print "Subject: bizarre happenings\n\n";
+
+(chdir '/usr/adm/private') || die "Can't cd to /usr/adm/private: $!\n";
+
+if ($#ARGV >= 0) {
+    @scanlist = @ARGV;
+} else {
+    @scanlist = split(/[ \t\n]+/,`echo scan_*`);
+}
+
+scan: while ($scan = shift(@scanlist)) {
+    print "\n********** $scan **********\n";
+    $showhost++;
+
+    $systype = 'all';
+
+    open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
+
+    $one_of_these = ":$systype:";
+    if ($systype =~ s/\+/[+]/g) {
+	$one_of_these =~ s/\+/:/g;
+    }
+
+    line: while (<ghosts>) {
+	s/[ \t]*\n//;
+	if (!$_ || /^#/) {
+	    next line;
+	}
+	if (/^([a-zA-Z_0-9]+)=(.+)/) {
+	    $name = $1; $repl = $2;
+	    $repl =~ s/\+/:/g;
+	    $one_of_these =~ s/:$name:/:$repl:/;
+	    next line;
+	}
+	@gh = split;
+	$host = $gh[0];
+	if ($showhost) { $showhost = "$host:\t"; }
+	class: while ($class = pop(gh)) {
+	    if (index($one_of_these,":$class:") >=0) {
+		$iter = 0;
+		`exec crypt -inquire <$scan >.x 2>/dev/null`;
+		unless (open(scan,'.x')) {
+		    print "Can't run $scan: $!\n";
+		    next scan;
+		}
+		$cmd = <scan>;
+		unless ($cmd =~ s/#!(.*)\n/$1/) {
+		    $cmd = '/usr/bin/perl';
+		}
+		close(scan);
+		if (open(PIPE,"exec rsh $host '$cmd' <.x|")) {
+		    sleep(5);
+		    unlink '.x';
+		    while (<PIPE>) {
+			last if $iter++ > 1000;		# must be looping
+			next if /^[0-9.]+u [0-9.]+s/;
+			print $showhost,$_;
+		    }
+		    close(PIPE);
+		} else {
+		    print "(Can't execute rsh: $!)\n";
+		}
+		last class;
+	    }
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/server b/gnu/usr.bin/perl/eg/server
new file mode 100644
index 00000000000..49a140a4c2c
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/server
@@ -0,0 +1,27 @@
+#!./perl
+
+$pat = 'S n C4 x8';
+$inet = 2;
+$echo = 7;
+$smtp = 25;
+$nntp = 119;
+
+$this = pack($pat,$inet,2345, 0,0,0,0);
+select(NS); $| = 1; select(stdout);
+
+if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
+if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
+if (listen(S,5)) { print "listen ok\n"; } else { die $!; }
+for (;;) {
+    print "Listening again\n";
+    if ($addr = accept(NS,S)) { print "accept ok\n"; } else { die $!; }
+
+    @ary = unpack($pat,$addr);
+    $, = ' ';
+    print @ary; print "\n";
+
+    while (<NS>) {
+	print;
+	print NS;
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/shmkill b/gnu/usr.bin/perl/eg/shmkill
new file mode 100644
index 00000000000..a82622ca691
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/shmkill
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+# $RCSfile: shmkill,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:54 $
+
+# A script to call from crontab periodically when people are leaving shared
+# memory sitting around unattached.
+
+open(ipcs,'ipcs -m -o|') || die "Can't run ipcs: $!";
+
+while (<ipcs>) {
+    $tmp = index($_,'NATTCH');
+    $pos = $tmp if $tmp >= 0;
+    if (/^m/) {
+	($m,$id,$key,$mode,$owner,$group,$attach) = split;
+	if ($attach != substr($_,$pos,6)) {
+	    die "Different ipcs format--can't parse!\n";
+	}
+	if ($attach == 0) {
+	    push(@goners,'-m',$id);
+	}
+    }
+}
+
+exec 'ipcrm', @goners if $#goners >= 0;
diff --git a/gnu/usr.bin/perl/eg/sysvipc/README b/gnu/usr.bin/perl/eg/sysvipc/README
new file mode 100644
index 00000000000..54094f1d85b
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/README
@@ -0,0 +1,9 @@
+FYEnjoyment, here are the test scripts I used while implementing SysV
+IPC in Perl.  Each of them must be run with the parameter "s" for
+"send" or "r" for "receive"; in each case, the receiver is the server
+and the sender is the client.
+
+-- 
+Chip Salzenberg at ComDev/TCT     <chip@tct.uucp>, <uunet!ateng!tct!chip>
+
+
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcmsg b/gnu/usr.bin/perl/eg/sysvipc/ipcmsg
new file mode 100644
index 00000000000..317e027ea75
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcmsg
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$id = msgget(0x1234, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get message queue: $!\n" unless defined($id);
+print "message queue id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (msgsnd($id, pack("LA*", $., $_), 0)) {
+			die "Can't send message: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (msgrcv($id, $_, 512, 0, 0)) {
+			die "Can't receive message: $!\n";
+		}
+		($type, $message) = unpack("La*", $_);
+		printf "[%d] %s\n", $type, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = msgctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove message queue: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcsem b/gnu/usr.bin/perl/eg/sysvipc/ipcsem
new file mode 100644
index 00000000000..d72a2dd77c9
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcsem
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/msg.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcmsg {r|s}\n" unless $mode =~ /^[rs]$/;
+$signal = ($mode eq "s");
+
+$id = semget(0x1234, 1, ($signal ? 0 : &IPC_CREAT) | 0644);
+die "Can't get semaphore: $!\n" unless defined($id);
+print "semaphore id: $id\n";
+
+if ($signal) {
+	while (<STDIN>) {
+		print "Signalling\n";
+		unless (semop($id, 0, pack("sss", 0, 1, 0))) {
+			die "Can't signal semaphore: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		unless (semop($id, 0, pack("sss", 0, -1, 0))) {
+			die "Can't wait for semaphore: $!\n";
+		}
+		print "Unblocked\n";
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$signal) {
+		$x = semctl($id, 0, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove semaphore: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/sysvipc/ipcshm b/gnu/usr.bin/perl/eg/sysvipc/ipcshm
new file mode 100644
index 00000000000..d40e46b9450
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/sysvipc/ipcshm
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	if 0;
+
+require 'sys/ipc.ph';
+require 'sys/shm.ph';
+
+$| = 1;
+
+$mode = shift;
+die "usage: ipcshm {r|s}\n" unless $mode =~ /^[rs]$/;
+$send = ($mode eq "s");
+
+$SIZE = 32;
+$id = shmget(0x1234, $SIZE, ($send ? 0 : &IPC_CREAT) | 0644);
+die "Can't get shared memory: $!\n" unless defined($id);
+print "shared memory id: $id\n";
+
+if ($send) {
+	while (<STDIN>) {
+		chop;
+		unless (shmwrite($id, pack("La*", length($_), $_), 0, $SIZE)) {
+			die "Can't write to shared memory: $!\n";
+		}
+	}
+}
+else {
+	$SIG{'INT'} = $SIG{'QUIT'} = "leave";
+	for (;;) {
+		$_ = <STDIN>;
+		unless (shmread($id, $_, 0, $SIZE)) {
+			die "Can't read shared memory: $!\n";
+		}
+		$len = unpack("L", $_);
+		$message = substr($_, length(pack("L",0)), $len);
+		printf "[%d] %s\n", $len, $message;
+	}
+}
+
+&leave;
+
+sub leave {
+	if (!$send) {
+		$x = shmctl($id, &IPC_RMID, 0);
+		if (!defined($x) || $x < 0) {
+			die "Can't remove shared memory: $!\n";
+		}
+	}
+	exit;
+}
diff --git a/gnu/usr.bin/perl/eg/travesty b/gnu/usr.bin/perl/eg/travesty
new file mode 100644
index 00000000000..7e6f983c7ce
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/travesty
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+while (<>) {
+    next if /^\./;
+    next if /^From / .. /^$/;
+    next if /^Path: / .. /^$/;
+    s/^\W+//;
+    push(@ary,split(' '));
+    while ($#ary > 1) {
+	$a = $p;
+	$p = $n;
+	$w = shift(@ary);
+	$n = $num{$w};
+	if ($n eq '') {
+	    push(@word,$w);
+	    $n = pack('S',$#word);
+	    $num{$w} = $n;
+	}
+	$lookup{$a . $p} .= $n;
+    }
+}
+
+for (;;) {
+    $n = $lookup{$a . $p};
+    ($foo,$n) = each(lookup) if $n eq '';
+    $n = substr($n,int(rand(length($n))) & 0177776,2);
+    $a = $p;
+    $p = $n;
+    ($w) = unpack('S',$n);
+    $w = $word[$w];
+    $col += length($w) + 1;
+    if ($col >= 65) {
+	$col = 0;
+	print "\n";
+    }
+    else {
+	print ' ';
+    }
+    print $w;
+    if ($w =~ /\.$/) {
+	if (rand() < .1) {
+	    print "\n";
+	    $col = 80;
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/eg/unuc b/gnu/usr.bin/perl/eg/unuc
new file mode 100644
index 00000000000..ae5c65285db
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/unuc
@@ -0,0 +1,186 @@
+#!/usr/bin/perl
+
+print STDERR "Loading proper nouns...\n";
+open(DICT,"/usr/dict/words") || die "Can't find /usr/dict/words: $!\n";
+while (<DICT>) {
+    if (/^[A-Z]/) {
+	chop;
+	($lower = $_) =~ y/A-Z/a-z/;
+	$proper{$lower} = $_;
+    }
+}
+close DICT;
+print STDERR "Loading exceptions...\n";
+
+$prog = <<'EOT';
+while (<>) {
+    next if /[a-z]/;
+    y/A-Z/a-z/;
+    s/(\w+)/$proper{$1} ? $proper{$1} : $1/eg;
+    s/^(\s*)([a-z])/$1 . (($tmp = $2) =~ y:a-z:A-Z:,$tmp)/e;
+    s/([-.?!]["']?(\n\s*|  \s*)["']?)([a-z])/$1 . (($tmp = $3) =~ y:a-z:A-Z:,$tmp)/eg;
+    s/\b([b-df-hj-np-tv-xz]+)\b/(($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
+    s/([a-z])'([SDT])\b/$1 . "'" . (($tmp = $2) =~ y:A-Z:a-z:,$tmp)/eg;
+EOT
+while (<DATA>) {
+    chop;
+    next if /^$/;
+    next if /^#/;
+    if (! /;$/) {
+	$foo = $_;
+	$foo =~ y/A-Z/a-z/;
+	print STDERR "Dup $_\n" if $proper{$foo};
+	$foo =~ s/([^\w ])/\\$1/g;
+	$foo =~ s/ /(\\s+)/g;
+	$foo = "\\b" . $foo if $foo =~ /^\w/;	# XXX till patch 9
+	$foo .= "\\b" if $foo =~ /\w$/;
+	$i = 0;
+	($bar = $_) =~ s/ /'$' . ++$i/eg;
+	$_ = "s/$foo/$bar/gi;";
+    }
+    $prog .= '    ' . $_ . "\n";
+}
+$prog .= "}\ncontinue {\n    print;\n}\n";
+
+$/ = '';
+#print $prog;
+eval $prog; die $@ if $@;
+__END__
+A.M.
+Air Force
+Air Force Base
+Air Force Station
+American
+Apr.
+Ariane
+Aug.
+August
+Bureau of Labor Statistics
+CIT
+Caltech
+Cape Canaveral
+Challenger
+China
+Corporation
+Crippen
+Daily News in Brief
+Daniel Quayle
+Dec.
+Discovery
+Edwards
+Endeavour
+Feb.
+Ford Aerospace
+Fri.
+General Dynamics
+George Bush
+Headline News
+HOTOL
+I
+II
+III
+IV
+IX
+Institute of Technology
+JPL
+Jan.
+Jul.
+Jun.
+Kennedy Space Center
+LDEF
+Long Duration Exposure Facility
+Long March
+Mar.
+March
+Martin
+Martin Marietta
+Mercury
+Mon.
+in May
+s/\bmay (\d)/May $1/g;
+s/\boffice of (\w)/'Office of ' . (($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg;
+National Science Foundation
+NASA Select
+New Mexico
+Nov.
+OMB
+Oct.
+Office of Management and Budget
+President
+President Bush
+Richard Truly
+Rocketdyne
+Russian
+Russians
+Sat.
+Sep.
+Soviet
+Soviet Union
+Soviets
+Space Shuttle
+Sun.
+Thu.
+Tue.
+U.S.
+Union of Soviet Socialist Republics
+United States
+VI
+VII
+VIII
+Vice President
+Vice President Quayle
+Wed.
+White Sands
+Kaman Aerospace
+Aerospace Daily
+Aviation Week
+Space Technology
+Washington Post
+Los Angeles Times
+New York Times
+Aerospace Industries Association
+president of
+Johnson Space Center
+Space Services
+Inc.
+Co.
+Hughes Aircraft
+Company
+Orbital Sciences
+Swedish Space
+Arnauld
+Nicogosian
+Magellan
+Galileo
+Mir
+Jet Propulsion Laboratory
+University
+Department of Defense
+Orbital Science
+OMS
+United Press International
+United Press
+UPI
+Associated Press
+AP
+Cable News Network
+Cape York
+Zenit
+SYNCOM
+Eastern
+Western
+Test Range
+Jcsat
+Japanese Satellite Communications
+Defence Ministry
+Defense Ministry
+Skynet
+Fixed Service Structure
+Launch Processing System
+Asiasat
+Launch Control Center
+Earth
+CNES
+Glavkosmos
+Pacific
+Atlantic
diff --git a/gnu/usr.bin/perl/eg/uudecode b/gnu/usr.bin/perl/eg/uudecode
new file mode 100644
index 00000000000..3b3cb60a234
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/uudecode
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+while (<>) {
+    next unless ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
+    open(OUT,"> $file") || die "Can't create $file: $!\n";
+    while (<>) {
+	    last if /^end/;
+	    next if /[a-z]/;
+	    next unless int((((ord() - 32) & 077) + 2) / 3) ==
+		    int(length() / 4);
+	    print OUT unpack("u", $_);
+    }
+    chmod oct($mode), $file;
+    eof() && die "Missing end: $file may be truncated.\n";
+}
+
diff --git a/gnu/usr.bin/perl/eg/van/empty b/gnu/usr.bin/perl/eg/van/empty
new file mode 100644
index 00000000000..05415209ecc
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/empty
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+
+# $RCSfile: empty,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:58 $
+
+# This script empties a trashcan.
+
+$recursive = shift if $ARGV[0] eq '-r';
+
+@ARGV = '.' if $#ARGV < 0;
+
+chop($pwd = `pwd`);
+
+dir: foreach $dir (@ARGV) {
+    unless (chdir $dir) {
+	print stderr "Can't find directory $dir: $!\n";
+	next dir;
+    }
+    if ($recursive) {
+	do cmd('find . -name .deleted -exec /bin/rm -rf {} ;');
+    }
+    else {
+	if (-d '.deleted') {
+	    do cmd('rm -rf .deleted');
+	}
+	else {
+	    if ($dir eq '.' && $pwd =~ m|/\.deleted$|) {
+		chdir '..';
+		do cmd('rm -rf .deleted');
+	    }
+	    else {
+		print stderr "No trashcan found in directory $dir\n";
+	    }
+	}
+    }
+}
+continue {
+    chdir $pwd;
+}
+
+# force direct execution with no shell
+
+sub cmd {
+    system split(' ',join(' ',@_));
+}
+
diff --git a/gnu/usr.bin/perl/eg/van/unvanish b/gnu/usr.bin/perl/eg/van/unvanish
new file mode 100644
index 00000000000..f87c79432e3
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/unvanish
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+# $RCSfile: unvanish,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:58 $
+
+sub it {
+    if ($olddir ne '.') {
+	chop($pwd = `pwd`) if $pwd eq '';
+	(chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    unless ($olddir eq '.deleted') {
+	if (-d '.deleted') {
+	    chdir '.deleted' || die "Directory .deleted is not accesible";
+	}
+	else {
+	    chop($pwd = `pwd`) if $pwd eq '';
+	    die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/;
+	}
+    }
+    print `mv $startfiles$filelist..$force`;
+    if ($olddir ne '.') {
+	(chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
+    }
+}
+
+if ($#ARGV < 0) {
+    open(lastcmd,'.deleted/.lastcmd') || 
+	open(lastcmd,'.lastcmd') || 
+	    die "No previous vanish in this dir";
+    $ARGV = <lastcmd>;
+    close(lastcmd);
+    @ARGV = split(/[\n ]+/,$ARGV);
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+	$startfiles = '- ';
+	last;
+    }
+}
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+	$dir = $1;
+    }
+    else {
+	$dir = '.';
+    }
+
+    if ($dir ne $olddir) {
+	do it() if $olddir;
+	$olddir = $dir;
+    }
+
+    if ($interactive) {
+	print "unvanish: restore $dir/$file? ";
+	next unless <stdin> =~ /^y/i;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+
+}
+
+do it() if $olddir;
diff --git a/gnu/usr.bin/perl/eg/van/vanexp b/gnu/usr.bin/perl/eg/van/vanexp
new file mode 100644
index 00000000000..6d6a5466d9f
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanexp
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+# $RCSfile: vanexp,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:58 $
+
+# This is for running from a find at night to expire old .deleteds
+
+$can = $ARGV[0];
+
+exit 1 unless $can =~ /.deleted$/;
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($can);
+
+exit 0 unless $size;
+
+if (time - $mtime > 2 * 24 * 60 * 60) {
+    `/bin/rm -rf $can`;
+}
+else {
+    `find $can -ctime +2 -exec rm -f {} \;`;
+}
diff --git a/gnu/usr.bin/perl/eg/van/vanish b/gnu/usr.bin/perl/eg/van/vanish
new file mode 100644
index 00000000000..cf764ca0d1e
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/van/vanish
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+# $RCSfile: vanish,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:11:58 $
+
+sub it {
+    if ($olddir ne '.') {
+	chop($pwd = `pwd`) if $pwd eq '';
+	(chdir $olddir) || die "Directory $olddir is not accesible";
+    }
+    if (!-d .deleted) {
+	print `mkdir .deleted; chmod 775 .deleted`;
+	die "You can't remove files from $olddir" if $?;
+    }
+    $filelist =~ s/ $//;
+    $filelist =~ s/#/\\#/g;
+    if ($filelist !~ /^[ \t]*$/) {
+	open(lastcmd,'>.deleted/.lastcmd');
+	print lastcmd $filelist,"\n";
+	close(lastcmd);
+	print `/bin/mv $startfiles$filelist .deleted$force`;
+    }
+    if ($olddir ne '.') {
+	(chdir $pwd) || die "Can't get back to original directory $pwd: $!\n";
+    }
+}
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+    /^-f/ && ($force = ' >/dev/null 2>&1');
+    /^-i/ && ($interactive = 1);
+    if (/^-+$/) {
+	$startfiles = '- ';
+	last;
+    }
+}
+
+chop($pwd = `pwd`);
+
+while ($file = shift) {
+    if ($file =~ s|^(.*)/||) {
+	$dir = $1;
+    }
+    else {
+	$dir = '.';
+    }
+
+    if ($interactive) {
+	print "vanish: remove $dir/$file? ";
+	next unless <stdin> =~ /^y/i;
+    }
+
+    if ($file eq '.deleted') {
+	print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n";
+	next;
+    }
+
+    if ($dir ne $olddir) {
+	do it() if $olddir;
+	$olddir = $dir;
+    }
+
+    $filelist .= $file; $filelist .= ' ';
+}
+
+do it() if $olddir;
diff --git a/gnu/usr.bin/perl/eg/who b/gnu/usr.bin/perl/eg/who
new file mode 100644
index 00000000000..ac15246c9fa
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/who
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+# This assumes your /etc/utmp file looks like ours
+open(UTMP,'/etc/utmp');
+@mo = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
+while (read(UTMP,$utmp,36)) {
+    ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
+    if ($name) {
+	$host = "($host)" if ord($host);
+	($sec,$min,$hour,$mday,$mon) = localtime($time);
+	printf "%-9s%-8s%s %2d %02d:%02d   %s\n",
+	  $name,$line,$mo[$mon],$mday,$hour,$min,$host;
+    }
+}   
diff --git a/gnu/usr.bin/perl/eg/wrapsuid b/gnu/usr.bin/perl/eg/wrapsuid
new file mode 100644
index 00000000000..22eee552865
--- /dev/null
+++ b/gnu/usr.bin/perl/eg/wrapsuid
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+'di';
+'ig00';
+#
+# $Header: /home/cvs/src/gnu/usr.bin/perl/eg/Attic/wrapsuid,v 1.1.1.1 1996/08/19 10:11:54 downsj Exp $
+#
+# $Log: wrapsuid,v $
+# Revision 1.1.1.1  1996/08/19 10:11:54  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+# Revision 1.1  90/08/11  13:51:29  lwall
+# Initial revision
+# 
+
+$xdev = '-xdev' unless -d '/dev/iop';
+
+if ($#ARGV >= 0) {
+    @list = @ARGV;
+    foreach $name (@ARGV) {
+	die "You must use absolute pathnames.\n" unless $name =~ m|^/|;
+    }
+}
+else {
+    open(DF,"/etc/mount|") || die "Can't run /etc/mount";
+
+    while (<DF>) {
+	chop;
+	$_ .= <DF> if length($_) < 50;
+	@ary = split;
+	push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|);
+    }
+}
+$fslist = join(' ',@list);
+
+die "Can't find local filesystems" unless $fslist;
+
+open(FIND,
+  "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|");
+
+while (<FIND>) {
+    chop;
+    next unless -T;
+    print "Fixing ", $_, "\n";
+    ($dir,$file) = m|(.*)/(.*)|;
+    chdir $dir || die "Can't chdir to $dir";
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat($file);
+       die "Can't stat $_" unless $ino;
+    chmod $mode & 01777, $file;		# wipe out set[ug]id bits
+    rename($file,".$file");
+    open(C,">.tmp$$.c") || die "Can't write C program for $_";
+    $real = "$dir/.$file";
+    print C '
+main(argc,argv)
+int argc;
+char **argv;
+{
+    execv("' . $real . '",argv);
+}
+';
+    close C;
+    system '/bin/cc', ".tmp$$.c", '-o', $file;
+    die "Can't compile new $_" if $?;
+    chmod $mode, $file;
+    chown $uid, $gid, $file;
+    unlink ".tmp$$.c";
+    chdir '/';
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00;			# finish .ig
+ 
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH SUIDSCRIPT 1 "July 30, 1990"
+.AT 3
+.SH NAME
+wrapsuid \- puts a compiled C wrapper around a setuid or setgid script
+.SH SYNOPSIS
+.B wrapsuid [dirlist]
+.SH DESCRIPTION
+.I Wrapsuid
+creates a small C program to execute a script with setuid or setgid privileges
+without having to set the setuid or setgid bit on the script, which is
+a security problem on many machines.
+Specify the list of directories or files that you wish to process.
+The names must be absolute pathnames.
+With no arguments it will attempt to process all the local directories
+for this machine.
+The scripts to be processed must have the setuid or setgid bit set.
+The wrapsuid program will delete the bits and set them on the wrapper.
+.PP
+Non-superusers may only process their own files.
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+None.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+.SH DIAGNOSTICS
+.SH BUGS
+.ex
diff --git a/gnu/usr.bin/perl/emacs/cperl-mode.el b/gnu/usr.bin/perl/emacs/cperl-mode.el
new file mode 100644
index 00000000000..5917d22e840
--- /dev/null
+++ b/gnu/usr.bin/perl/emacs/cperl-mode.el
@@ -0,0 +1,2883 @@
+;;; This code started from the following message of long time ago (IZ):
+
+;;; From: olson@mcs.anl.gov (Bob Olson)
+;;; Newsgroups: comp.lang.perl
+;;; Subject: cperl-mode: Another perl mode for Gnuemacs
+;;; Date: 14 Aug 91 15:20:01 GMT
+
+;; Perl code editing commands for Emacs
+;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+
+;; This file is not (yet) part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
+;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
+
+;; $Id: cperl-mode.el,v 1.20 1996/02/09 03:40:01 ilya Exp ilya $
+
+;;; To use this mode put the following into your .emacs file:
+
+;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
+
+;;; You can either fine-tune the bells and whistles of this mode or
+;;; bulk enable them by putting
+
+;; (setq cperl-hairy t)
+
+;;; in your .emacs file. (Emacs rulers do not consider it politically
+;;; correct to make whistles enabled by default.)
+
+;;; Additional useful commands to put into your .emacs file:
+
+;; (setq auto-mode-alist
+;;       (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+;; (setq interpreter-mode-alist (append interpreter-mode-alist
+;; 				        '(("miniperl" . perl-mode))))
+
+;;; The mode information (on C-h m) provides customization help.
+;;; If you use font-lock feature of this mode, it is advisable to use
+;;; eather lazy-lock-mode or fast-lock-mode (available on ELisp
+;;; archive in files lazy-lock.el and fast-lock.el). I prefer lazy-lock.
+
+;;; Faces used now: three faces for first-class and second-class keywords
+;;; and control flow words, one for each: comments, string, labels,
+;;; functions definitions and packages, arrays, hashes, and variable
+;;; definitions. If you do not see all these faces, your font-lock does
+;;; not define them, so you need to define them manually. Maybe you have 
+;;; an obsolete font-lock from 19.28 or earlier. Upgrade.
+
+;;; If you have grayscale monitor, and do not have the variable
+;;; font-lock-display-type bound to 'grayscale, insert 
+
+;;; (setq font-lock-display-type 'grayscale)
+
+;;; to your .emacs file.
+
+;;;; This mode supports font-lock, imenu and mode-compile. In the
+;;;; hairy version font-lock is on, but you should activate imenu
+;;;; yourself (note that mode-compile is not standard yet). Well, you
+;;;; can use imenu from keyboard anyway (M-x imenu), but it is better
+;;;; to bind it like that:
+
+;; (define-key global-map [M-S-down-mouse-3] 'imenu)
+
+;;; In fact the version of font-lock that this version supports can be
+;;; much newer than the version you actually have. This means that a
+;;; lot of faces can be set up, but are not visible on your screen
+;;; since the coloring rules for this faces are not defined.
+
+;;; Updates: ========================================
+
+;;; Made less hairy by default: parentheses not electric, 
+;;; linefeed not magic. Bug with abbrev-mode corrected.
+
+;;;; After 1.4:
+;;;  Better indentation:
+;;;  subs inside braces should work now, 
+;;;  Toplevel braces obey customization.
+;;;  indent-for-comment knows about bad cases, cperl-indent-for-comment
+;;;  moves cursor to a correct place.
+;;;  cperl-indent-exp written from the scratch! Slow... (quadratic!) :-( 
+;;;        (50 secs on DB::DB (sub of 430 lines), 486/66)
+;;;  Minor documentation fixes.
+;;;  Imenu understands packages as prefixes (including nested).
+;;;  Hairy options can be switched off one-by-one by setting to null.
+;;;  Names of functions and variables changed to conform to `cperl-' style.
+
+;;;; After 1.5:
+;;;  Some bugs with indentation of labels (and embedded subs) corrected.
+;;;  `cperl-indent-region' done (slow :-()).
+;;;  `cperl-fill-paragraph' done.
+;;;  Better package support for `imenu'.
+;;;  Progress indicator for indentation (with `imenu' loaded).
+;;;  `Cperl-set' was busted, now setting the individual hairy option 
+;;;     should be better.
+
+;;;; After 1.6:
+;;; `cperl-set-style' done.
+;;; `cperl-check-syntax' done.
+;;; Menu done.
+;;; New config variables `cperl-close-paren-offset' and `cperl-comment-column'.
+;;; Bugs with `cperl-auto-newline' corrected.
+;;; `cperl-electric-lbrace' can work with `cperl-auto-newline' in situation 
+;;; like $hash{.
+
+;;;; 1.7 XEmacs (arius@informatik.uni-erlangen.de):
+;;; - use `next-command-event', if `next-command-events' does not exist
+;;; - use `find-face' as def. of `is-face'
+;;; - corrected def. of `x-color-defined-p'
+;;; - added const defs for font-lock-comment-face,
+;;;   font-lock-keyword-face and font-lock-function-name-face
+;;; - added def. of font-lock-variable-name-face
+;;; - added (require 'easymenu) inside an `eval-when-compile'
+;;; - replaced 4-argument `substitute-key-definition' with ordinary
+;;;   `define-key's
+;;; - replaced `mark-active' in menu definition by `cperl-use-region-p'.
+;;; Todo (at least):
+;;; - use emacs-vers.el (http://www.cs.utah.edu/~eeide/emacs/emacs-vers.el.gz)
+;;;   for portable code?
+;;; - should `cperl-mode' do a 
+;;;	(if (featurep 'easymenu) (easy-menu-add cperl-menu))
+;;;   or should this be left to the user's `cperl-mode-hook'?
+
+;;; Some bugs introduced by the above fix corrected (IZ ;-).
+;;; Some bugs under XEmacs introduced by the correction corrected.
+
+;;; Some more can remain since there are two many different variants. 
+;;; Please feedback!
+
+;;; We do not support fontification of arrays and hashes under 
+;;; obsolete font-lock any more. Upgrade.
+
+;;;; after 1.8 Minor bug with parentheses.
+;;;; after 1.9 Improvements from Joe Marzot.
+;;;; after 1.10
+;;;  Does not need easymenu to compile under XEmacs.
+;;;  `vc-insert-headers' should work better.
+;;;  Should work with 19.29 and 19.12.
+;;;  Small improvements to fontification.
+;;;  Expansion of keywords does not depend on C-? being backspace.
+
+;;; after 1.10+
+;;; 19.29 and 19.12 supported.
+;;; `cperl-font-lock-enhanced' deprecated. Use font-lock-extra.el.
+;;; Support for font-lock-extra.el.
+
+;;;; After 1.11:
+;;; Tools submenu.
+;;; Support for perl5-info.
+;;; `imenu-go-find-at-position' in Tools requires imenu-go.el (see hints above)
+;;; Imenu entries do not work with stock imenu.el. Patch sent to maintainers.
+;;; Fontifies `require a if b;', __DATA__.
+;;; Arglist for auto-fill-mode was incorrect.
+
+;;;; After 1.12:
+;;; `cperl-lineup-step' and `cperl-lineup' added: lineup constructions 
+;;; vertically.
+;;; `cperl-do-auto-fill' updated for 19.29 style.
+;;; `cperl-info-on-command' now has a default.
+;;; Workaround for broken C-h on XEmacs.
+;;; VC strings escaped.
+;;; C-h f now may prompt for function name instead of going on,
+;;; controlled by `cperl-info-on-command-no-prompt'.
+
+;;;; After 1.13:
+;;; Msb buffer list includes perl files
+;;; Indent-for-comment uses indent-to
+;;; Can write tag files using etags.
+
+;;;; After 1.14:
+;;; Recognizes (tries to ;-) {...} which are not blocks during indentation.
+;;; `cperl-close-paren-offset' affects ?\] too (and ?\} if not block)
+;;; Bug with auto-filling comments started with "##" corrected.
+
+;;;; Very slow now: on DB::DB 0.91, 486/66:
+
+;;;Function Name                             Call Count  Elapsed Time  Average Time
+;;;========================================  ==========  ============  ============
+;;;cperl-block-p                             469         3.7799999999  0.0080597014
+;;;cperl-get-state                           505         163.39000000  0.3235445544
+;;;cperl-comment-indent                      12          0.0299999999  0.0024999999
+;;;cperl-backward-to-noncomment              939         4.4599999999  0.0047497337
+;;;cperl-calculate-indent                    505         172.22000000  0.3410297029
+;;;cperl-indent-line                         505         172.88000000  0.3423366336
+;;;cperl-use-region-p                        40          0.0299999999  0.0007499999
+;;;cperl-indent-exp                          1           177.97000000  177.97000000
+;;;cperl-to-comment-or-eol                   1453        3.9800000000  0.0027391603
+;;;cperl-backward-to-start-of-continued-exp  9           0.0300000000  0.0033333333
+;;;cperl-indent-region                       1           177.94000000  177.94000000
+
+;;;; After 1.15:
+;;; Takes into account white space after opening parentheses during indent.
+;;; May highlight pods and here-documents: see `cperl-pod-here-scan',
+;;; `cperl-pod-here-fontify', `cperl-pod-face'. Does not use this info
+;;; for indentation so far.
+;;; Fontification updated to 19.30 style. 
+;;; The change 19.29->30 did not add all the required functionality,
+;;;     but broke "font-lock-extra.el". Get "choose-color.el" from
+;;;       ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
+
+;;;; After 1.16:
+;;;       else # comment
+;;;    recognized as a start of a block.
+;;;  Two different font-lock-levels provided.
+;;;  `cperl-pod-head-face' introduced. Used for highlighting.
+;;;  `imenu' marks pods, +Packages moved to the head. 
+
+;;;; After 1.17:
+;;;  Scan for pods highlights here-docs too.
+;;;  Note that the tag of here-doc may be rehighlighted later by lazy-lock.
+;;;  Only one here-doc-tag per line is supported, and one in comment
+;;;  or a string may break fontification.
+;;;  POD headers were supposed to fill one line only.
+
+;;;; After 1.18:
+;;;  `font-lock-keywords' were set in 19.30 style _always_. Current scheme 
+;;;    may  break under XEmacs.
+;;;  `cperl-calculate-indent' dis suppose that `parse-start' was defined.
+;;;  `fontified' tag is added to fontified text as well as `lazy-lock' (for
+;;;    compatibility with older lazy-lock.el) (older one overfontifies
+;;;    something nevertheless :-().
+;;;  Will not indent something inside pod and here-documents.
+;;;  Fontifies the package name after import/no/bootstrap.
+;;;  Added new entry to menu with meta-info about the mode.
+
+;;;; After 1.19:
+;;;  Prefontification works much better with 19.29. Should be checked
+;;;   with 19.30 as well.
+;;;  Some misprints in docs corrected.
+;;;  Now $a{-text} and -text => "blah" are fontified as strings too.
+;;;  Now the pod search is much stricter, so it can help you to find
+;;;    pod sections which are broken because of whitespace before =blah
+;;;    - just observe the fontification.
+
+(defvar cperl-extra-newline-before-brace nil
+  "*Non-nil means that if, elsif, while, until, else, for, foreach
+and do constructs look like:
+
+	if ()
+	{
+	}
+
+instead of:
+
+	if () {
+	}
+")
+
+(defvar cperl-indent-level 2
+  "*Indentation of CPerl statements with respect to containing block.")
+(defvar cperl-lineup-step nil
+  "*`cperl-lineup' will always lineup at multiple of this number.
+If `nil', the value of `cperl-indent-level' will be used.")
+(defvar cperl-brace-imaginary-offset 0
+  "*Imagined indentation of a Perl open brace that actually follows a statement.
+An open brace following other text is treated as if it were this far
+to the right of the start of its line.")
+(defvar cperl-brace-offset 0
+  "*Extra indentation for braces, compared with other text in same context.")
+(defvar cperl-label-offset -2
+  "*Offset of CPerl label lines relative to usual indentation.")
+(defvar cperl-min-label-indent 1
+  "*Minimal offset of CPerl label lines.")
+(defvar cperl-continued-statement-offset 2
+  "*Extra indent for lines not starting new statements.")
+(defvar cperl-continued-brace-offset 0
+  "*Extra indent for substatements that start with open-braces.
+This is in addition to cperl-continued-statement-offset.")
+(defvar cperl-close-paren-offset -1
+  "*Extra indent for substatements that start with close-parenthesis.")
+
+(defvar cperl-auto-newline nil
+  "*Non-nil means automatically newline before and after braces,
+and after colons and semicolons, inserted in CPerl code.")
+
+(defvar cperl-tab-always-indent t
+  "*Non-nil means TAB in CPerl mode should always reindent the current line,
+regardless of where in the line point is when the TAB command is used.")
+
+(defvar cperl-font-lock nil
+  "*Non-nil (and non-null) means CPerl buffers will use font-lock-mode.
+Can be overwritten by `cperl-hairy' if nil.")
+
+(defvar cperl-electric-lbrace-space nil
+  "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '.
+Can be overwritten by `cperl-hairy' if nil.")
+
+(defvar cperl-electric-parens ""
+  "*List of parentheses that should be electric in CPerl, or null.
+Can be overwritten by `cperl-hairy' to \"({[<\" if not 'null.")
+
+(defvar cperl-electric-linefeed nil
+  "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
+In any case these two mean plain and hairy linefeeds together.
+Can be overwritten by `cperl-hairy' if nil.")
+
+(defvar cperl-electric-keywords nil
+  "*Not-nil (and non-null) means keywords are electric in CPerl.
+Can be overwritten by `cperl-hairy' if nil.")
+
+(defvar cperl-hairy nil
+  "*Not-nil means all the bells and whistles are enabled in CPerl.")
+
+(defvar cperl-comment-column 32
+  "*Column to put comments in CPerl (use \\[cperl-indent]' to lineup with code).")
+
+(defvar cperl-vc-header-alist '((SCCS "$sccs = '%W\%' ;")
+				(RCS "$rcs = ' $Id\$ ' ;"))
+  "*What to use as `vc-header-alist' in CPerl.")
+
+(defvar cperl-info-on-command-no-prompt nil
+  "*Not-nil (and non-null) means not to prompt on C-h f.
+The opposite behaviour is always available if prefixed with C-c.
+Can be overwritten by `cperl-hairy' if nil.")
+
+(defvar cperl-pod-face 'font-lock-comment-face
+  "*The result of evaluation of this expression is used for pod highlighting.")
+
+(defvar cperl-pod-head-face 'font-lock-variable-name-face
+  "*The result of evaluation of this expression is used for pod highlighting.
+Font for POD headers.")
+
+(defvar cperl-here-face 'font-lock-string-face
+  "*The result of evaluation of this expression is used for here-docs highlighting.")
+
+(defvar cperl-pod-here-fontify '(featurep 'font-lock)
+  "*Not-nil after evaluation means to highlight pod and here-docs sections.")
+
+(defvar cperl-pod-here-scan t
+  "*Not-nil means look for pod and here-docs sections during startup.
+You can always make lookup from menu or using \\[cperl-find-pods-heres].")
+
+
+
+;;; Short extra-docs.
+
+(defvar cperl-tips 'please-ignore-this-line
+  "Get newest version of this package from
+  ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs
+and/or
+  ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
+
+Get support packages font-lock-extra.el, imenu-go.el from the same place.
+\(Look for other files there too... ;-) Get a patch for imenu.el in 19.29.
+Note that for 19.30 you should use choose-color.el *instead* of 
+font-lock-extra.el (and you will not get smart highlighting in C :-().
+
+Note that to enable Compile choices in the menu you need to install
+mode-compile.el.
+
+Get perl5-info from 
+  http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
+\(may be quite obsolete, but still useful).
+
+If you use imenu-go, run imenu on perl5-info buffer (you can do it from
+CPerl menu).
+
+Before reporting (non-)problems look in the problem section on what I
+know about them.")
+
+(defvar cperl-problems 'please-ignore-this-line
+"Emacs has a _very_ restricted syntax parsing engine. 
+
+It may be corrected on the level of C ocde, please look in the
+`non-problems' section if you want to volonteer.
+
+CPerl mode tries to corrects some Emacs misunderstandings, however,
+for effeciency reasons the degree of correction is different for
+different operations. The partially corrected problems are: POD
+sections, here-documents, regexps. The operations are: highlighting,
+indentation, electric keywords, electric braces. 
+
+This may be confusing, since the regexp s#//#/#\; may be highlighted
+as a comment, but it will recognized as a regexp by the indentation
+code. Or the opposite case, when a pod section is highlighted, but
+breaks the indentation of the following code.
+
+The main trick (to make $ a \"backslash\") makes constructions like
+${aaa} look like unbalanced braces. The only trick I can think out is
+to insert it as $ {aaa} (legal in perl5, not in perl4). 
+
+Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
+as /($|\\s)/. Note that such a transpositinon is not always possible
+:-(.  " )
+
+(defvar cperl-non-problems 'please-ignore-this-line
+"As you know from `problems' section, Perl syntax too hard for CPerl.
+
+Most the time, if you write your own code, you may find an equivalent
+\(and almost as readable) expression.
+
+Try to help it: add comments with embedded quotes to fix CPerl
+misunderstandings about the end of quotation:
+
+$a='500$';      # ';
+
+You won't need it too often. The reason: $ \"quotes\" the following
+character (this saves a life a lot of times in CPerl), thus due to
+Emacs parsing rules it does not consider tick after the dollar as a
+closing one, but as a usual character.
+
+Now the indentation code is pretty wise. The only drawback is that it
+relies on Emacs parsing to find matching parentheses. And Emacs
+*cannot* match parentheses in Perl 100% correctly. So
+	1 if s#//#/#;
+will not break indentation, but
+	1 if ( s#//#/# );
+will.
+
+If you still get wrong indentation in situation that you think the
+code should be able to parse, try:
+
+a) Check what Emacs thinks about balance of your parentheses.
+b) Supply the code to me (IZ).
+
+Pods are treated _very_ rudimentally. Here-documents are not treated
+at all (except highlighting and inhibiting indentation). (This may
+change some time. RMS approved making syntax lookup recognize text
+attributes, but volonteers are needed to change Emacs C code.)
+
+To speed up coloring the following compromises exist:
+   a) sub in $mypackage::sub may be highlighted.
+   b) -z in [a-z] may be highlighted.
+   c) if your regexp contains a keyword (like \"s\"), it may be highlighted.
+")
+
+
+
+;;; Portability stuff:
+
+(defsubst cperl-xemacs-p ()
+  (string-match "XEmacs\\|Lucid" emacs-version))
+
+(defvar del-back-ch (car (append (where-is-internal 'delete-backward-char)
+				 (where-is-internal 'backward-delete-char-untabify)))
+  "Character generated by key bound to delete-backward-char.")
+
+(and (vectorp del-back-ch) (= (length del-back-ch) 1) 
+     (setq del-back-ch (aref del-back-ch 0)))
+
+(if (cperl-xemacs-p)
+    ;; "Active regions" are on: use region only if active
+    ;; "Active regions" are off: use region unconditionally
+    (defun cperl-use-region-p ()
+      (if zmacs-regions (mark) t))
+  (defun cperl-use-region-p ()
+    (if transient-mark-mode mark-active t)))
+
+(defsubst cperl-enable-font-lock ()
+  (or (cperl-xemacs-p) window-system))
+
+(if (boundp 'unread-command-events)
+    (if (cperl-xemacs-p)
+	(defun cperl-putback-char (c)	; XEmacs >= 19.12
+	  (setq unread-command-events (list (character-to-event c))))
+      (defun cperl-putback-char (c)	; Emacs 19
+	(setq unread-command-events (list c))))
+  (defun cperl-putback-char (c)		; XEmacs <= 19.11
+    (setq unread-command-event (character-to-event c))))
+
+(or (fboundp 'uncomment-region)
+    (defun uncomment-region (beg end)
+      (interactive "r")
+      (comment-region beg end -1)))
+
+(defvar cperl-do-not-fontify
+  (if (string< emacs-version "19.30")
+      'fontified
+    'lazy-lock)
+  "Text property which inhibits refontification.")
+
+
+;;; Probably it is too late to set these guys already, but it can help later:
+
+(setq auto-mode-alist
+      (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+(and (boundp 'interpreter-mode-alist)
+     (setq interpreter-mode-alist (append interpreter-mode-alist
+					  '(("miniperl" . perl-mode)))))
+(if (fboundp 'eval-when-compile)
+    (eval-when-compile
+      (condition-case nil
+	  (require 'imenu)
+	(error nil))
+      (condition-case nil
+	  (require 'easymenu)
+	(error nil))
+      ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
+      ;; macros instead of defsubsts don't work on Emacs, so we do the
+      ;; expansion manually. Any other suggestions?
+      (if (or (string-match "XEmacs\\|Lucid" emacs-version)
+	      window-system)
+	  (require 'font-lock))
+      (require 'cl)
+      ))
+
+(defvar cperl-mode-abbrev-table nil
+  "Abbrev table in use in Cperl-mode buffers.")
+
+(add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))
+
+(defvar cperl-mode-map () "Keymap used in CPerl mode.")
+
+(if cperl-mode-map nil
+  (setq cperl-mode-map (make-sparse-keymap))
+  (define-key cperl-mode-map "{" 'cperl-electric-lbrace)
+  (define-key cperl-mode-map "[" 'cperl-electric-paren)
+  (define-key cperl-mode-map "(" 'cperl-electric-paren)
+  (define-key cperl-mode-map "<" 'cperl-electric-paren)
+  (define-key cperl-mode-map "}" 'cperl-electric-brace)
+  (define-key cperl-mode-map ";" 'cperl-electric-semi)
+  (define-key cperl-mode-map ":" 'cperl-electric-terminator)
+  (define-key cperl-mode-map "\C-j" 'newline-and-indent)
+  (define-key cperl-mode-map "\C-c\C-j" 'cperl-linefeed)
+  (define-key cperl-mode-map "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+  ;;(define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
+  ;;(define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
+  (define-key cperl-mode-map "\177" 'backward-delete-char-untabify)
+  (define-key cperl-mode-map "\t" 'cperl-indent-command)
+  (if (cperl-xemacs-p)
+      ;; don't clobber the backspace binding:
+      (define-key cperl-mode-map [(control h) f] 'cperl-info-on-command)
+    (define-key cperl-mode-map "\C-hf" 'cperl-info-on-command))
+  (if (cperl-xemacs-p)
+      ;; don't clobber the backspace binding:
+      (define-key cperl-mode-map [(control c) (control h) f]
+	'cperl-info-on-current-command)
+    (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-current-command))
+  (if (and (cperl-xemacs-p) 
+	   (<= emacs-minor-version 11) (<= emacs-major-version 19))
+      (progn
+	;; substitute-key-definition is usefulness-deenhanced...
+	(define-key cperl-mode-map "\M-q" 'cperl-fill-paragraph)
+	(define-key cperl-mode-map "\e;" 'cperl-indent-for-comment)
+	(define-key cperl-mode-map "\e\C-\\" 'cperl-indent-region))
+    (substitute-key-definition
+     'indent-sexp 'cperl-indent-exp
+     cperl-mode-map global-map)
+    (substitute-key-definition
+     'fill-paragraph 'cperl-fill-paragraph
+     cperl-mode-map global-map)
+    (substitute-key-definition
+     'indent-region 'cperl-indent-region
+     cperl-mode-map global-map)
+    (substitute-key-definition
+     'indent-for-comment 'cperl-indent-for-comment
+     cperl-mode-map global-map)))
+
+(condition-case nil
+    (progn
+      (require 'easymenu)
+      (easy-menu-define cperl-menu cperl-mode-map "Menu for CPerl mode"
+         '("Perl"
+	   ["Beginning of function" beginning-of-defun t]
+	   ["End of function" end-of-defun t]
+	   ["Mark function" mark-defun t]
+	   ["Indent expression" cperl-indent-exp t]
+	   ["Fill paragraph/comment" cperl-fill-paragraph t]
+	   ["Line up a construction" cperl-lineup (cperl-use-region-p)]
+	   "----"
+	   ["Indent region" cperl-indent-region (cperl-use-region-p)]
+	   ["Comment region" comment-region (cperl-use-region-p)]
+	   ["Uncomment region" uncomment-region (cperl-use-region-p)]
+	   "----"
+	   ["Run" mode-compile (fboundp 'mode-compile)]
+	   ["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
+					  (get-buffer "*compilation*"))]
+	   ["Next error" next-error (get-buffer "*compilation*")]
+	   ["Check syntax" cperl-check-syntax (fboundp 'mode-compile)]
+	   "----"
+	   ["Debugger" perldb t]
+	   "----"
+	   ("Tools"
+	    ["Imenu" imenu (fboundp 'imenu)]
+	    ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
+	    ("Tags"
+	     ["Create tags for current file" cperl-etags t]
+	     ["Add tags for current file" (cperl-etags t) t]
+	     ["Create tags for Perl files in directory" (cperl-etags nil t) t]
+	     ["Add tags for Perl files in directory" (cperl-etags t t) t]
+	     ["Create tags for Perl files in (sub)directories" 
+	      (cperl-etags nil 'recursive) t]
+	     ["Add tags for Perl files in (sub)directories"
+	      (cperl-etags t 'recursive) t])
+	    ["Recalculate PODs" cperl-find-pods-heres t]
+	    ["Define word at point" imenu-go-find-at-position 
+	     (fboundp 'imenu-go-find-at-position)]
+	    ["Help on function" cperl-info-on-command t]
+	    ["Help on function at point" cperl-info-on-current-command t])
+	   ("Indent styles..."
+	    ["GNU" (cperl-set-style "GNU") t]
+	    ["C++" (cperl-set-style "C++") t]
+	    ["FSF" (cperl-set-style "FSF") t]
+	    ["BSD" (cperl-set-style "BSD") t]
+	    ["Whitesmith" (cperl-set-style "Whitesmith") t])
+	   ("Micro-docs"
+	    ["Tips" (describe-variable 'cperl-tips) t]
+	    ["Problems" (describe-variable 'cperl-problems) t]
+	    ["Non-problems" (describe-variable 'cperl-non-problems) t]))))
+  (error nil))
+
+(autoload 'c-macro-expand "cmacexp"
+  "Display the result of expanding all C macros occurring in the region.
+The expansion is entirely correct because it uses the C preprocessor."
+  t)
+
+(defvar cperl-mode-syntax-table nil
+  "Syntax table in use in Cperl-mode buffers.")
+
+(if cperl-mode-syntax-table
+    ()
+  (setq cperl-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
+  (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?* "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?- "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?= "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?% "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?< "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?> "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?& "." cperl-mode-syntax-table)
+  (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
+  (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
+  (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
+  (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
+  (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
+  (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)
+  (modify-syntax-entry ?| "." cperl-mode-syntax-table))
+
+
+
+;; Make customization possible "in reverse"
+;;(defun cperl-set (symbol to)
+;;  (or (eq (symbol-value symbol) 'null) (set symbol to)))
+(defsubst cperl-val (symbol &optional default hairy)
+  (cond
+   ((eq (symbol-value symbol) 'null) default)
+   (cperl-hairy (or hairy t))
+   (t (symbol-value symbol))))
+
+;; provide an alias for working with emacs 19.  the perl-mode that comes
+;; with it is really bad, and this lets us seamlessly replace it.
+(fset 'perl-mode 'cperl-mode)
+(defun cperl-mode ()
+  "Major mode for editing Perl code.
+Expression and list commands understand all C brackets.
+Tab indents for Perl code.
+Paragraphs are separated by blank lines only.
+Delete converts tabs to spaces as it moves back.
+
+Various characters in Perl almost always come in pairs: {}, (), [],
+sometimes <>. When the user types the first, she gets the second as
+well, with optional special formatting done on {}.  (Disabled by
+default.)  You can always quote (with \\[quoted-insert]) the left
+\"paren\" to avoid the expansion. The processing of < is special,
+since most the time you mean \"less\". Cperl mode tries to guess
+whether you want to type pair <>, and inserts is if it
+appropriate. You can set `cperl-electric-parens' to the string that
+contains the parenths from the above list you want to be electrical.
+
+CPerl mode provides expansion of the Perl control constructs:
+   if, else, elsif, unless, while, until, for, and foreach.
+=========(Disabled by default, see `cperl-electric-keywords'.)
+The user types the keyword immediately followed by a space, which causes
+the construct to be expanded, and the user is positioned where she is most
+likely to want to be.
+eg. when the user types a space following \"if\" the following appears in
+the buffer:
+            if () {     or   if ()
+            }                 {
+                              }
+and the cursor is between the parentheses.  The user can then type some
+boolean expression within the parens.  Having done that, typing
+\\[cperl-linefeed] places you, appropriately indented on a new line
+between the braces. If CPerl decides that you want to insert
+\"English\" style construct like
+            bite if angry;
+it will not do any expansion. See also help on variable 
+`cperl-extra-newline-before-brace'.
+
+\\[cperl-linefeed] is a convinience replacement for typing carriage
+return. It places you in the next line with proper indentation, or if
+you type it inside the inline block of control construct, like
+            foreach (@lines) {print; print}
+and you are on a boundary of a statement inside braces, it will
+transform the construct into a multiline and will place you into an
+apporpriately indented blank line. If you need a usual 
+`newline-and-indent' behaviour, it is on \\[newline-and-indent], 
+see documentation on `cperl-electric-linefeed'.
+
+\\{cperl-mode-map}
+
+Setting the variable `cperl-font-lock' to t switches on
+font-lock-mode, `cperl-electric-lbrace-space' to t switches on
+electric space between $ and {, `cperl-electric-parens' is the string
+that contains parentheses that should be electric in CPerl, setting
+`cperl-electric-keywords' enables electric expansion of control
+structures in CPerl. `cperl-electric-linefeed' governs which one of
+two linefeed behavior is preferable. You can enable all these options
+simultaneously (recommended mode of use) by setting `cperl-hairy' to
+t. In this case you can switch separate options off by setting them 
+to `null'.
+
+If your site has perl5 documentation in info format, you can use commands
+\\[cperl-info-on-current-command] and \\[cperl-info-on-command] to access it.
+These keys run commands `cperl-info-on-current-command' and
+`cperl-info-on-command', which one is which is controlled by variable
+`cperl-info-on-command-no-prompt' (in turn affected by `cperl-hairy').
+
+Variables `cperl-pod-here-scan', `cperl-pod-here-fontify',
+`cperl-pod-face', `cperl-pod-head-face' control processing of pod and
+here-docs sections. In a future version results of scan may be used
+for indentation too, currently they are used for highlighting only.
+
+Variables controlling indentation style:
+ `cperl-tab-always-indent'
+    Non-nil means TAB in CPerl mode should always reindent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ `cperl-auto-newline'
+    Non-nil means automatically newline before and after braces,
+    and after colons and semicolons, inserted in Perl code.
+ `cperl-indent-level'
+    Indentation of Perl statements within surrounding block.
+    The surrounding block's indentation is the indentation
+    of the line on which the open-brace appears.
+ `cperl-continued-statement-offset'
+    Extra indentation given to a substatement, such as the
+    then-clause of an if, or body of a while, or just a statement continuation.
+ `cperl-continued-brace-offset'
+    Extra indentation given to a brace that starts a substatement.
+    This is in addition to `cperl-continued-statement-offset'.
+ `cperl-brace-offset'
+    Extra indentation for line if it starts with an open brace.
+ `cperl-brace-imaginary-offset'
+    An open brace following other text is treated as if it the line started
+    this far to the right of the actual line indentation.
+ `cperl-label-offset'
+    Extra indentation for line that is a label.
+ `cperl-min-label-indent'
+    Minimal indentation for line that is a label.
+
+Settings for K&R and BSD indentation styles are
+  `cperl-indent-level'                5    8
+  `cperl-continued-statement-offset'  5    8
+  `cperl-brace-offset'               -5   -8
+  `cperl-label-offset'               -5   -8
+
+If `cperl-indent-level' is 0, the statement after opening brace in column 0 is indented on `cperl-brace-offset'+`cperl-continued-statement-offset'.
+
+Turning on CPerl mode calls the hooks in the variable `cperl-mode-hook'
+with no args."
+  (interactive)
+  (kill-all-local-variables)
+  ;;(if cperl-hairy
+  ;;    (progn
+  ;;	(cperl-set 'cperl-font-lock cperl-hairy)
+  ;;	(cperl-set 'cperl-electric-lbrace-space cperl-hairy)
+  ;;	(cperl-set 'cperl-electric-parens "{[(<")
+  ;;	(cperl-set 'cperl-electric-keywords cperl-hairy)
+  ;;	(cperl-set 'cperl-electric-linefeed cperl-hairy)))
+  (use-local-map cperl-mode-map)
+  (if (cperl-val 'cperl-electric-linefeed)
+      (progn
+	(local-set-key "\C-J" 'cperl-linefeed)
+	(local-set-key "\C-C\C-J" 'newline-and-indent)))
+  (if (cperl-val 'cperl-info-on-command-no-prompt)
+      (progn
+	(if (cperl-xemacs-p)
+	    ;; don't clobber the backspace binding:
+	    (local-set-key [(control h) f] 'cperl-info-on-current-command)
+	  (local-set-key "\C-hf" 'cperl-info-on-current-command))
+	(if (cperl-xemacs-p)
+	    ;; don't clobber the backspace binding:
+	    (local-set-key [(control c) (control h) f]
+			   'cperl-info-on-command)
+	  (local-set-key "\C-c\C-hf" 'cperl-info-on-command))))
+  (setq major-mode 'perl-mode)
+  (setq mode-name "CPerl")
+  (if (not cperl-mode-abbrev-table)
+      (let ((prev-a-c abbrevs-changed))
+	(define-abbrev-table 'cperl-mode-abbrev-table '(
+		("if" "if" cperl-electric-keyword 0)
+		("elsif" "elsif" cperl-electric-keyword 0)
+		("while" "while" cperl-electric-keyword 0)
+		("until" "until" cperl-electric-keyword 0)
+		("unless" "unless" cperl-electric-keyword 0)
+		("else" "else" cperl-electric-else 0)
+		("for" "for" cperl-electric-keyword 0)
+		("foreach" "foreach" cperl-electric-keyword 0)
+		("do" "do" cperl-electric-keyword 0)))
+	(setq abbrevs-changed prev-a-c)))
+  (setq local-abbrev-table cperl-mode-abbrev-table)
+  (abbrev-mode (if (cperl-val 'cperl-electric-keywords) 1 0))
+  (set-syntax-table cperl-mode-syntax-table)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'cperl-indent-line)
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t)
+  (make-local-variable 'comment-start)
+  (setq comment-start "# ")
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+  (make-local-variable 'comment-column)
+  (setq comment-column cperl-comment-column)
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "#+ *")
+  (make-local-variable 'defun-prompt-regexp)
+  (setq defun-prompt-regexp "[ \t]*sub\\s +\\([^ \t\n{;]+\\)\\s *")
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'cperl-comment-indent)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+  (make-local-variable 'indent-region-function)
+  (setq indent-region-function 'cperl-indent-region)
+  ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
+  (make-local-variable 'imenu-create-index-function)
+  (setq imenu-create-index-function
+	(function imenu-example--create-perl-index))
+  (make-local-variable 'imenu-sort-function)
+  (setq imenu-sort-function nil)
+  (make-local-variable 'vc-header-alist)
+  (setq vc-header-alist cperl-vc-header-alist)
+  (make-local-variable 'font-lock-defaults)
+  (setq	font-lock-defaults
+	(if (string< emacs-version "19.30")
+	    '(perl-font-lock-keywords-2)
+	  '((perl-font-lock-keywords
+	     perl-font-lock-keywords-1
+	     perl-font-lock-keywords-2))))
+  (or (fboundp 'cperl-old-auto-fill-mode)
+      (progn
+	(fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
+	(defun auto-fill-mode (&optional arg)
+	  (interactive "P")
+	  (cperl-old-auto-fill-mode arg)
+	  (and auto-fill-function (eq major-mode 'perl-mode)
+	       (setq auto-fill-function 'cperl-do-auto-fill)))))
+  (if (cperl-enable-font-lock)
+      (if (cperl-val 'cperl-font-lock) 
+	  (progn (or cperl-faces-init (cperl-init-faces))
+		 (font-lock-mode 1))))
+  (and (boundp 'msb-menu-cond)
+       (not cperl-msb-fixed)
+       (cperl-msb-fix))
+  (run-hooks 'cperl-mode-hook)
+  ;; After hooks since fontification will break this
+  (if cperl-pod-here-scan (cperl-find-pods-heres)))
+
+;; Fix for msb.el
+(defvar cperl-msb-fixed nil)
+
+(defun cperl-msb-fix ()
+  ;; Adds perl files to msb menu, supposes that msb is already loaded
+  (setq cperl-msb-fixed t)
+  (let* ((l (length msb-menu-cond))
+	 (last (nth (1- l) msb-menu-cond))
+	 (precdr (nthcdr (- l 2) msb-menu-cond)) ; cdr of this is last
+	 (handle (1- (nth 1 last))))
+    (setcdr precdr (list
+		    (list
+		     '(eq major-mode 'perl-mode)
+		     handle
+		     "Perl Files (%d)")
+		    last))))
+
+;; This is used by indent-for-comment
+;; to decide how much to indent a comment in CPerl code
+;; based on its context. Do fallback if comment is found wrong.
+
+(defvar cperl-wrong-comment)
+
+(defun cperl-comment-indent ()
+  (let ((p (point)) (c (current-column)) was)
+    (if (looking-at "^#") 0		; Existing comment at bol stays there.
+      ;; Wrong comment found
+      (save-excursion
+	(setq was (cperl-to-comment-or-eol))
+	(if (= (point) p)
+	    (progn
+	      (skip-chars-backward " \t")
+	      (max (1+ (current-column)) ; Else indent at comment column
+		   comment-column))
+	  (if was nil
+	    (insert comment-start)
+	    (backward-char (length comment-start)))
+	  (setq cperl-wrong-comment t)
+	  (indent-to comment-column 1)	; Indent minimum 1
+	  c)))))			; except leave at least one space.
+
+;;;(defun cperl-comment-indent-fallback ()
+;;;  "Is called if the standard comment-search procedure fails.
+;;;Point is at start of real comment."
+;;;  (let ((c (current-column)) target cnt prevc)
+;;;    (if (= c comment-column) nil
+;;;      (setq cnt (skip-chars-backward "[ \t]"))
+;;;      (setq target (max (1+ (setq prevc 
+;;;			     (current-column))) ; Else indent at comment column
+;;;		   comment-column))
+;;;      (if (= c comment-column) nil
+;;;	(delete-backward-char cnt)
+;;;	(while (< prevc target)
+;;;	  (insert "\t")
+;;;	  (setq prevc (current-column)))
+;;;	(if (> prevc target) (progn (delete-char -1) (setq prevc (current-column))))
+;;;	(while (< prevc target)
+;;;	  (insert " ")
+;;;	  (setq prevc (current-column)))))))
+
+(defun cperl-indent-for-comment ()
+  "Substite for `indent-for-comment' in CPerl."
+  (interactive)
+  (let (cperl-wrong-comment)
+    (indent-for-comment)
+    (if cperl-wrong-comment
+	(progn (cperl-to-comment-or-eol)
+	       (forward-char (length comment-start))))))
+
+(defun cperl-electric-brace (arg &optional only-before)
+  "Insert character and correct line's indentation.
+If ONLY-BEFORE and `cperl-auto-newline', will insert newline before the
+place (even in empty line), but not after."
+  (interactive "P")
+  (let (insertpos)
+    (if (and (not arg)			; No args, end (of empty line or auto)
+	     (eolp)
+	     (or (and (null only-before)
+		      (save-excursion
+			(skip-chars-backward " \t")
+			(bolp)))
+		 (if cperl-auto-newline 
+		     (progn (cperl-indent-line) (newline) t) nil)))
+	(progn
+	  (if cperl-auto-newline
+	      (setq insertpos (point)))
+	  (insert last-command-char)
+	  (cperl-indent-line)
+	  (if (and cperl-auto-newline (null only-before))
+	      (progn
+		(newline)
+		(cperl-indent-line)))
+	  (save-excursion
+	    (if insertpos (progn (goto-char insertpos)
+				 (search-forward (make-string 
+						  1 last-command-char))
+				 (setq insertpos (1- (point)))))
+	    (delete-char -1))))
+    (if insertpos
+	(save-excursion
+	  (goto-char insertpos)
+	  (self-insert-command (prefix-numeric-value arg)))
+      (self-insert-command (prefix-numeric-value arg)))))
+
+(defun cperl-electric-lbrace (arg)
+  "Insert character, correct line's indentation, correct quoting by space."
+  (interactive "P")
+  (let (pos after (cperl-auto-newline cperl-auto-newline))
+    (and (cperl-val 'cperl-electric-lbrace-space)
+	 (eq (preceding-char) ?$)
+	 (save-excursion
+	   (skip-chars-backward "$")
+	   (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
+	 (insert ? ))
+    (if (cperl-after-expr-p) nil (setq cperl-auto-newline nil))
+    (cperl-electric-brace arg)
+    (and (eq last-command-char ?{)
+	 (memq last-command-char 
+	       (append (cperl-val 'cperl-electric-parens "" "([{<") nil))
+	 (setq last-command-char ?} pos (point))
+	 (progn (cperl-electric-brace arg t)
+		(goto-char pos)))))
+
+(defun cperl-electric-paren (arg)
+  "Insert a matching pair of parentheses."
+  (interactive "P")
+  (let ((beg (save-excursion (beginning-of-line) (point))))
+    (if (and (memq last-command-char
+		   (append (cperl-val 'cperl-electric-parens "" "([{<") nil))
+	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
+	     ;;(not (save-excursion (search-backward "#" beg t)))
+	     (if (eq last-command-char ?<)
+		 (cperl-after-expr-p nil "{};(,:=")
+	       1))
+	(progn
+	  (insert last-command-char)
+	  (insert (cdr (assoc last-command-char '((?{ .?})
+						  (?[ . ?])
+						  (?( . ?))
+						  (?< . ?>)))))
+	  (forward-char -1))
+      (insert last-command-char)
+      )))
+
+(defun cperl-electric-keyword ()
+  "Insert a construction appropriate after a keyword."
+  (let ((beg (save-excursion (beginning-of-line) (point))))
+    (and (save-excursion
+	   (backward-sexp 1)
+	   (cperl-after-expr-p nil "{};:"))
+	 (save-excursion 
+	   (not 
+	    (re-search-backward
+	     "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
+	     beg t)))
+	 (save-excursion (or (not (re-search-backward "^=" nil t))
+			     (looking-at "=cut")))
+	 (progn
+	   (cperl-indent-line)
+	   ;;(insert " () {\n}")
+ 	   (cond
+ 	    (cperl-extra-newline-before-brace
+ 	     (insert " ()\n")
+ 	     (insert "{")
+ 	     (cperl-indent-line)
+ 	     (insert "\n")
+ 	     (cperl-indent-line)
+ 	     (insert "\n}"))
+ 	    (t
+ 	     (insert " () {\n}"))
+ 	    )
+	   (or (looking-at "[ \t]\\|$") (insert " "))
+	   (cperl-indent-line)
+	   (search-backward ")")
+	   (cperl-putback-char del-back-ch)))))
+
+(defun cperl-electric-else ()
+  "Insert a construction appropriate after a keyword."
+  (let ((beg (save-excursion (beginning-of-line) (point))))
+    (and (save-excursion
+	   (backward-sexp 1)
+	   (cperl-after-expr-p nil "{};:"))
+	 (save-excursion 
+	   (not 
+	    (re-search-backward
+	     "[#\"'`]\\|\\<q\\(\\|[wqx]\\)\\>"
+	     beg t)))
+	 (save-excursion (or (not (re-search-backward "^=" nil t))
+			     (looking-at "=cut")))
+	 (progn
+	   (cperl-indent-line)
+	   ;;(insert " {\n\n}")
+ 	   (cond
+ 	    (cperl-extra-newline-before-brace
+ 	     (insert "\n")
+ 	     (insert "{")
+ 	     (cperl-indent-line)
+ 	     (insert "\n\n}"))
+ 	    (t
+ 	     (insert " {\n\n}"))
+ 	    )
+	   (or (looking-at "[ \t]\\|$") (insert " "))
+	   (cperl-indent-line)
+	   (forward-line -1)
+	   (cperl-indent-line)
+	   (cperl-putback-char del-back-ch)))))
+
+(defun cperl-linefeed ()
+  "Go to end of line, open a new line and indent appropriately."
+  (interactive)
+  (let ((beg (save-excursion (beginning-of-line) (point)))
+	(end (save-excursion (end-of-line) (point)))
+	(pos (point)) start)
+    (if (and				; Check if we need to split:
+					; i.e., on a boundary and inside "{...}" 
+	 ;;(not (search-backward "\\(^\\|[^$\\\\]\\)#" beg t))
+	 (save-excursion (cperl-to-comment-or-eol)
+	   (>= (point) pos))
+	 (or (save-excursion
+	       (skip-chars-backward " \t" beg)
+	       (forward-char -1)
+	       (looking-at "[;{]"))
+	     (looking-at "[ \t]*}")
+	     (re-search-forward "\\=[ \t]*;" end t))
+	 (save-excursion
+	   (and
+	    (eq (car (parse-partial-sexp pos end -1)) -1)
+	    (looking-at "[ \t]*\\($\\|#\\)")
+	    ;;(setq finish (point-marker))
+	    (progn
+	      (backward-sexp 1)
+	      (setq start (point-marker))
+	      (<= start pos))
+	    ;;(looking-at "[^{}\n]*}[ \t]*$") ; Will fail if there are intervening {}'s
+	    ;;(search-backward "{" beg t)
+	    ;;(looking-at "{[^{}\n]*}[ \t]*$")
+	    )))
+	 ;;(or (looking-at "[ \t]*}")	; and on a boundary of statements
+	 ;;    (save-excursion
+	 ;;      (skip-chars-backward " \t")
+	 ;;      (forward-char -1)
+	 ;;      (looking-at "[{;]"))))
+	(progn
+	  (skip-chars-backward " \t")
+	  (or (memq (preceding-char) (append ";{" nil))
+	      (insert ";"))
+	  (insert "\n")
+	  (forward-line -1)
+	  (cperl-indent-line)
+	  ;;(end-of-line)
+	  ;;(search-backward "{" beg)
+	  (goto-char start)
+	  (or (looking-at "{[ \t]*$")	; If there is a statement
+					; before, move it to separate line
+	      (progn
+		(forward-char 1)
+		(insert "\n")
+		(cperl-indent-line)))
+	  (forward-line 1)		; We are on the target line
+	  (cperl-indent-line)
+	  (beginning-of-line)
+	  (or (looking-at "[ \t]*}[ \t]*$") ; If there is a statement
+					    ; after, move it to separate line
+	      (progn
+		(end-of-line)
+		(search-backward "}" beg)
+		(skip-chars-backward " \t")
+		(or (memq (preceding-char) (append ";{" nil))
+		    (insert ";"))
+		(insert "\n")
+		(cperl-indent-line)
+		(forward-line -1)))
+	  (forward-line -1)		; We are on the line before target 
+	  (end-of-line)
+	  (newline-and-indent))
+      (end-of-line)			; else
+      (if (not (looking-at "\n[ \t]*$"))
+	  (newline-and-indent)
+	(forward-line 1)
+	(cperl-indent-line)))))
+
+(defun cperl-electric-semi (arg)
+  "Insert character and correct line's indentation."
+  (interactive "P")
+  (if cperl-auto-newline
+      (cperl-electric-terminator arg)
+    (self-insert-command (prefix-numeric-value arg))))
+
+(defun cperl-electric-terminator (arg)
+  "Insert character and correct line's indentation."
+  (interactive "P")
+  (let (insertpos (end (point)))
+    (if (and (not arg) (eolp)
+	     (not (save-excursion
+		    (beginning-of-line)
+		    (skip-chars-forward " \t")
+		    (or
+		     ;; Ignore in comment lines
+		     (= (following-char) ?#)
+		     ;; Colon is special only after a label
+		     ;; So quickly rule out most other uses of colon
+		     ;; and do no indentation for them.
+		     (and (eq last-command-char ?:)
+			  (save-excursion
+			    (forward-word 1)
+			    (skip-chars-forward " \t")
+			    (and (< (point) end)
+				 (progn (goto-char (- end 1))
+					(not (looking-at ":"))))))
+		     (progn
+		       (beginning-of-defun)
+		       (let ((pps (parse-partial-sexp (point) end)))
+			 (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
+	(progn
+	  (if cperl-auto-newline
+	      (setq insertpos (point)))
+	  (insert last-command-char)
+	  (cperl-indent-line)
+	  (if cperl-auto-newline
+	      (progn
+		(newline)
+		(cperl-indent-line)))
+	  (save-excursion
+	    (if insertpos (progn (goto-char insertpos)
+				 (search-forward (make-string 
+						  1 last-command-char))
+				 (setq insertpos (1- (point)))))
+	    (delete-char -1))))
+    (if insertpos
+	(save-excursion
+	  (goto-char insertpos)
+	  (self-insert-command (prefix-numeric-value arg)))
+      (self-insert-command (prefix-numeric-value arg)))))
+
+(defun cperl-inside-parens-p ()
+  (condition-case ()
+      (save-excursion
+	(save-restriction
+	  (narrow-to-region (point)
+			    (progn (beginning-of-defun) (point)))
+	  (goto-char (point-max))
+	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
+    (error nil)))
+
+(defun cperl-indent-command (&optional whole-exp)
+  (interactive "P")
+  "Indent current line as Perl code, or in some cases insert a tab character.
+If `cperl-tab-always-indent' is non-nil (the default), always indent current line.
+Otherwise, indent the current line only if point is at the left margin
+or in the line's indentation; otherwise insert a tab.
+
+A numeric argument, regardless of its value,
+means indent rigidly all the lines of the expression starting after point
+so that this line becomes properly indented.
+The relative indentation among the lines of the expression are preserved."
+  (if whole-exp
+      ;; If arg, always indent this line as Perl
+      ;; and shift remaining lines of expression the same amount.
+      (let ((shift-amt (cperl-indent-line))
+	    beg end)
+	(save-excursion
+	  (if cperl-tab-always-indent
+	      (beginning-of-line))
+	  (setq beg (point))
+	  (forward-sexp 1)
+	  (setq end (point))
+	  (goto-char beg)
+	  (forward-line 1)
+	  (setq beg (point)))
+	(if (> end beg)
+	    (indent-code-rigidly beg end shift-amt "#")))
+    (if (and (not cperl-tab-always-indent)
+	     (save-excursion
+	       (skip-chars-backward " \t")
+	       (not (bolp))))
+	(insert-tab)
+      (cperl-indent-line))))
+
+(defun cperl-indent-line (&optional symbol)
+  "Indent current line as Perl code.
+Return the amount the indentation changed by."
+  (let (indent
+	beg shift-amt
+	(case-fold-search nil)
+	(pos (- (point-max) (point))))
+    (setq indent (cperl-calculate-indent nil symbol))
+    (beginning-of-line)
+    (setq beg (point))
+    (cond ((eq indent nil)
+	   (setq indent (current-indentation)))
+	  ;;((eq indent t)    ; Never?
+	  ;; (setq indent (cperl-calculate-indent-within-comment)))
+	  ;;((looking-at "[ \t]*#")
+	  ;; (setq indent 0))
+	  (t
+	   (skip-chars-forward " \t")
+	   (if (listp indent) (setq indent (car indent)))
+	   (cond ((looking-at "[A-Za-z]+:[^:]")
+		  (and (> indent 0)
+		       (setq indent (max cperl-min-label-indent
+					 (+ indent cperl-label-offset)))))
+		 ((= (following-char) ?})
+		  (setq indent (- indent cperl-indent-level)))
+		 ((memq (following-char) '(?\) ?\])) ; To line up with opening paren.
+		  (setq indent (+ indent cperl-close-paren-offset)))
+		 ((= (following-char) ?{)
+		  (setq indent (+ indent cperl-brace-offset))))))
+    (skip-chars-forward " \t")
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+	(if (> (- (point-max) pos) (point))
+	    (goto-char (- (point-max) pos)))
+      (delete-region beg (point))
+      (indent-to indent)
+      ;; If initial point was within line's indentation,
+      ;; position after the indentation.  Else stay at same point in text.
+      (if (> (- (point-max) pos) (point))
+	  (goto-char (- (point-max) pos))))
+    shift-amt))
+
+(defun cperl-after-label ()
+  ;; Returns true if the point is after label. Does not do save-excursion.
+  (and (eq (preceding-char) ?:)
+       (memq (char-syntax (char-after (- (point) 2)))
+	     '(?w ?_))
+       (progn
+	 (backward-sexp)
+	 (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:"))))
+
+(defun cperl-get-state (&optional parse-start start-state)
+  ;; returns list (START STATE DEPTH PRESTART), START is a good place
+  ;; to start parsing, STATE is what is returned by
+  ;; `parse-partial-sexp'. DEPTH is true is we are immediately after
+  ;; end of block which contains START. PRESTART is the position
+  ;; basing on which START was found.
+  (save-excursion
+    (let ((start-point (point)) depth state start prestart)
+      (if parse-start
+	  (goto-char parse-start)
+	(beginning-of-defun))
+      (setq prestart (point))
+      (if start-state nil
+	;; Try to go out, if sub is not on the outermost level
+	(while (< (point) start-point)
+	  (setq start (point) parse-start start depth nil
+		state (parse-partial-sexp start start-point -1))
+	  (if (> (car state) -1) nil
+	    ;; The current line could start like }}}, so the indentation
+	    ;; corresponds to a different level than what we reached
+	    (setq depth t)
+	    (beginning-of-line 2)))	; Go to the next line.
+	(if start (goto-char start)))	; Not at the start of file
+      (setq start (point))
+      (if (< start start-point) (setq parse-start start))
+      (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
+      (list start state depth prestart))))
+
+(defun cperl-block-p ()			; Do not C-M-q ! One string contains ";" !
+  ;; Positions is before ?\{. Checks whether it starts a block.
+  ;; No save-excursion!
+  (cperl-backward-to-noncomment (point-min))
+  ;;(skip-chars-backward " \t\n\f")
+  (or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at bobp
+					; Label may be mixed up with `$blah :'
+      (save-excursion (cperl-after-label))
+      (and (eq (char-syntax (preceding-char)) ?w)
+	   (progn
+	     (backward-sexp)
+	     (or (looking-at "\\sw+[ \t\n\f]*[{#]") ; Method call syntax
+		 (progn
+		   (skip-chars-backward " \t\n\f")
+		   (and (eq (char-syntax (preceding-char)) ?w)
+			(progn
+			  (backward-sexp)
+			  (looking-at 
+			   "sub[ \t]+\\sw+[ \t\n\f]*[#{]")))))))))
+
+(defun cperl-calculate-indent (&optional parse-start symbol)
+  "Return appropriate indentation for current line as Perl code.
+In usual case returns an integer: the column to indent to.
+Returns nil if line starts inside a string, t if in a comment."
+  (save-excursion
+    (if (memq (get-text-property (point) 'syntax-type) '(pod here-doc)) nil
+      (beginning-of-line)
+      (let* ((indent-point (point))
+	     (case-fold-search nil)
+	     (s-s (cperl-get-state))
+	     (start (nth 0 s-s))
+	     (state (nth 1 s-s))
+	     (containing-sexp (car (cdr state)))
+	     (char-after (save-excursion
+			   (skip-chars-forward " \t")
+			   (following-char)))
+	     (start-indent (save-excursion
+			     (goto-char start)
+			     (- (current-indentation)
+				(if (nth 2 s-s) cperl-indent-level 0))))
+	     old-indent)
+	;;      (or parse-start (null symbol)
+	;;	  (setq parse-start (symbol-value symbol) 
+	;;		start-indent (nth 2 parse-start) 
+	;;		parse-start (car parse-start)))
+	;;      (if parse-start
+	;;	  (goto-char parse-start)
+	;;	(beginning-of-defun))
+	;;      ;; Try to go out
+	;;      (while (< (point) indent-point)
+	;;	(setq start (point) parse-start start moved nil
+	;;	      state (parse-partial-sexp start indent-point -1))
+	;;	(if (> (car state) -1) nil
+	;;	  ;; The current line could start like }}}, so the indentation
+	;;	  ;; corresponds to a different level than what we reached
+	;;	  (setq moved t)
+	;;	  (beginning-of-line 2)))	; Go to the next line.
+	;;      (if start				; Not at the start of file
+	;;	  (progn
+	;;	    (goto-char start)
+	;;	    (setq start-indent (current-indentation))
+	;;	    (if moved			; Should correct...
+	;;		(setq start-indent (- start-indent cperl-indent-level))))
+	;;	(setq start-indent 0))
+	;;      (if (< (point) indent-point) (setq parse-start (point)))
+	;;      (or state (setq state (parse-partial-sexp 
+	;;			     (point) indent-point -1 nil start-state)))
+	;;      (setq containing-sexp 
+	;;	    (or (car (cdr state)) 
+	;;		(and (>= (nth 6 state) 0) old-containing-sexp))
+	;;	    old-containing-sexp nil start-state nil)
+;;;;      (while (< (point) indent-point)
+;;;;	(setq parse-start (point))
+;;;;	(setq state (parse-partial-sexp (point) indent-point -1 nil start-state))
+;;;;	(setq containing-sexp 
+;;;;	      (or (car (cdr state)) 
+;;;;		  (and (>= (nth 6 state) 0) old-containing-sexp))
+;;;;	      old-containing-sexp nil start-state nil))
+	;;      (if symbol (set symbol (list indent-point state start-indent)))
+	;;      (goto-char indent-point)
+	(cond ((or (nth 3 state) (nth 4 state))
+	       ;; return nil or t if should not change this line
+	       (nth 4 state))
+	      ((null containing-sexp)
+	       ;; Line is at top level.  May be data or function definition,
+	       ;; or may be function argument declaration.
+	       ;; Indent like the previous top level line
+	       ;; unless that ends in a closeparen without semicolon,
+	       ;; in which case this line is the first argument decl.
+	       (skip-chars-forward " \t")
+	       (+ start-indent
+		  (if (= (following-char) ?{) cperl-continued-brace-offset 0)
+		  (progn
+		    (cperl-backward-to-noncomment (or parse-start (point-min)))
+		    ;;(skip-chars-backward " \t\f\n")
+		    ;; Look at previous line that's at column 0
+		    ;; to determine whether we are in top-level decls
+		    ;; or function's arg decls.  Set basic-indent accordingly.
+		    ;; Now add a little if this is a continuation line.
+		    (if (or (bobp)
+			    (memq (preceding-char) (append " ;}" nil)) ; Was ?\)
+			    (memq char-after (append ")]}" nil))) 
+			0
+		      cperl-continued-statement-offset))))
+	      ((/= (char-after containing-sexp) ?{)
+	       ;; line is expression, not statement:
+	       ;; indent to just after the surrounding open,
+	       ;; skip blanks if we do not close the expression.
+	       (goto-char (1+ containing-sexp))
+	       (or (memq char-after (append ")]}" nil))
+		   (looking-at "[ \t]*\\(#\\|$\\)")
+		   (skip-chars-forward " \t"))
+	       (current-column))
+	      ((progn
+		 ;; Containing-expr starts with \{. Check whether it is a hash.
+		 (goto-char containing-sexp)
+		 (not (cperl-block-p)))
+	       (goto-char (1+ containing-sexp))
+	       (or (eq char-after ?\})
+		   (looking-at "[ \t]*\\(#\\|$\\)")
+		   (skip-chars-forward " \t"))
+	       (+ (current-column)	; Correct indentation of trailing ?\}
+		  (if (eq char-after ?\}) (+ cperl-indent-level
+					     cperl-close-paren-offset) 
+		    0)))
+	      (t
+	       ;; Statement level.  Is it a continuation or a new statement?
+	       ;; Find previous non-comment character.
+	       (goto-char indent-point)
+	       (cperl-backward-to-noncomment containing-sexp)
+	       ;; Back up over label lines, since they don't
+	       ;; affect whether our line is a continuation.
+	       (while (or (eq (preceding-char) ?\,)
+			  (and (eq (preceding-char) ?:)
+			       (or;;(eq (char-after (- (point) 2)) ?\') ; ????
+				(memq (char-syntax (char-after (- (point) 2)))
+				      '(?w ?_)))))
+		 (if (eq (preceding-char) ?\,)
+		     ;; Will go to beginning of line, essentially.
+		     ;; Will ignore embedded sexpr XXXX.
+		     (cperl-backward-to-start-of-continued-exp containing-sexp))
+		 (beginning-of-line)
+		 (cperl-backward-to-noncomment containing-sexp))
+	       ;; Now we get the answer.
+	       (if (not (memq (preceding-char) (append ", ;}{" '(nil)))) ; Was ?\,
+		   ;; This line is continuation of preceding line's statement;
+		   ;; indent  `cperl-continued-statement-offset'  more than the
+		   ;; previous line of the statement.
+		   (progn
+		     (cperl-backward-to-start-of-continued-exp containing-sexp)
+		     (+ (if (memq char-after (append "}])" nil))
+			    0		; Closing parenth
+			  cperl-continued-statement-offset)
+			(current-column)
+			(if (eq char-after ?\{)
+			    cperl-continued-brace-offset 0)))
+		 ;; This line starts a new statement.
+		 ;; Position following last unclosed open.
+		 (goto-char containing-sexp)
+		 ;; Is line first statement after an open-brace?
+		 (or
+		  ;; If no, find that first statement and indent like
+		  ;; it.  If the first statement begins with label, do
+		  ;; not belive when the indentation of the label is too
+		  ;; small.
+		  (save-excursion
+		    (forward-char 1)
+		    (setq old-indent (current-indentation))
+		    (let ((colon-line-end 0))
+		      (while (progn (skip-chars-forward " \t\n")
+				    (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]"))
+			;; Skip over comments and labels following openbrace.
+			(cond ((= (following-char) ?\#)
+			       (forward-line 1))
+			      ;; label:
+			      (t
+			       (save-excursion (end-of-line)
+					       (setq colon-line-end (point)))
+			       (search-forward ":"))))
+		      ;; The first following code counts
+		      ;; if it is before the line we want to indent.
+		      (and (< (point) indent-point)
+			   (if (> colon-line-end (point)) ; After label
+			       (if (> (current-indentation) 
+				      cperl-min-label-indent)
+				   (- (current-indentation) cperl-label-offset)
+				 ;; Do not belive: `max' is involved
+				 (+ old-indent cperl-indent-level))
+			     (current-column)))))
+		  ;; If no previous statement,
+		  ;; indent it relative to line brace is on.
+		  ;; For open brace in column zero, don't let statement
+		  ;; start there too.  If cperl-indent-level is zero,
+		  ;; use cperl-brace-offset + cperl-continued-statement-offset instead.
+		  ;; For open-braces not the first thing in a line,
+		  ;; add in cperl-brace-imaginary-offset.
+
+		  ;; If first thing on a line:  ?????
+		  (+ (if (and (bolp) (zerop cperl-indent-level))
+			 (+ cperl-brace-offset cperl-continued-statement-offset)
+		       cperl-indent-level)
+		     ;; Move back over whitespace before the openbrace.
+		     ;; If openbrace is not first nonwhite thing on the line,
+		     ;; add the cperl-brace-imaginary-offset.
+		     (progn (skip-chars-backward " \t")
+			    (if (bolp) 0 cperl-brace-imaginary-offset))
+		     ;; If the openbrace is preceded by a parenthesized exp,
+		     ;; move to the beginning of that;
+		     ;; possibly a different line
+		     (progn
+		       (if (eq (preceding-char) ?\))
+			   (forward-sexp -1))
+		       ;; Get initial indentation of the line we are on.
+		       ;; If line starts with label, calculate label indentation
+		       (if (save-excursion
+			     (beginning-of-line)
+			     (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+			   (if (> (current-indentation) cperl-min-label-indent)
+			       (- (current-indentation) cperl-label-offset)
+			     (cperl-calculate-indent 
+			      (if (and parse-start (<= parse-start (point)))
+				  parse-start)))
+			 (current-indentation))))))))))))
+
+(defvar cperl-indent-alist
+  '((string nil)
+    (comment nil)
+    (toplevel 0)
+    (toplevel-after-parenth 2)
+    (toplevel-continued 2)
+    (expression 1))
+  "Alist of indentation rules for CPerl mode.
+The values mean:
+  nil: do not indent;
+  number: add this amount of indentation.")
+
+(defun cperl-where-am-i (&optional parse-start start-state)
+  ;; Unfinished
+  "Return a list of lists ((TYPE POS)...) of good points before the point.
+POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'."
+  (save-excursion
+    (let* ((start-point (point))
+	   (s-s (cperl-get-state))
+	   (start (nth 0 s-s))
+	   (state (nth 1 s-s))
+	   (prestart (nth 3 s-s))
+	   (containing-sexp (car (cdr state)))
+	   (case-fold-search nil)
+	   (res (list (list 'parse-start start) (list 'parse-prestart prestart))))
+      (cond ((nth 3 state)		; In string
+	     (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string
+	    ((nth 4 state)		; In comment
+	     (setq res (cons '(comment) res)))
+	    ((null containing-sexp)
+	     ;; Line is at top level.  
+	     ;; Indent like the previous top level line
+	     ;; unless that ends in a closeparen without semicolon,
+	     ;; in which case this line is the first argument decl.
+	     (cperl-backward-to-noncomment (or parse-start (point-min)))
+	     ;;(skip-chars-backward " \t\f\n")
+	     (cond
+	      ((or (bobp)
+		   (memq (preceding-char) (append ";}" nil)))
+	       (setq res (cons (list 'toplevel start) res)))
+	      ((eq (preceding-char) ?\) )
+	       (setq res (cons (list 'toplevel-after-parenth start) res)))
+	      (t 
+	       (setq res (cons (list 'toplevel-continued start) res)))))
+	    ((/= (char-after containing-sexp) ?{)
+	     ;; line is expression, not statement:
+	     ;; indent to just after the surrounding open.
+	     ;; skip blanks if we do not close the expression.
+	     (setq res (cons (list 'expression-blanks
+				   (progn
+				     (goto-char (1+ containing-sexp))
+				     (or (looking-at "[ \t]*\\(#\\|$\\)")
+					 (skip-chars-forward " \t"))
+				     (point)))
+			     (cons (list 'expression containing-sexp) res))))
+	    ((progn
+	      ;; Containing-expr starts with \{. Check whether it is a hash.
+	      (goto-char containing-sexp)
+	      (not (cperl-block-p)))
+	     (setq res (cons (list 'expression-blanks
+				   (progn
+				     (goto-char (1+ containing-sexp))
+				     (or (looking-at "[ \t]*\\(#\\|$\\)")
+					 (skip-chars-forward " \t"))
+				     (point)))
+			     (cons (list 'expression containing-sexp) res))))
+	    (t
+	     ;; Statement level.
+	     (setq res (cons (list 'in-block containing-sexp) res))
+	     ;; Is it a continuation or a new statement?
+	     ;; Find previous non-comment character.
+	     (cperl-backward-to-noncomment containing-sexp)
+	     ;; Back up over label lines, since they don't
+	     ;; affect whether our line is a continuation.
+	     ;; Back up comma-delimited lines too ?????
+	     (while (or (eq (preceding-char) ?\,)
+			(save-excursion (cperl-after-label)))
+	       (if (eq (preceding-char) ?\,)
+		   ;; Will go to beginning of line, essentially
+		     ;; Will ignore embedded sexpr XXXX.
+		   (cperl-backward-to-start-of-continued-exp containing-sexp))
+	       (beginning-of-line)
+	       (cperl-backward-to-noncomment containing-sexp))
+	     ;; Now we get the answer.
+	     (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\,
+		 ;; This line is continuation of preceding line's statement.
+		 (list (list 'statement-continued containing-sexp))
+	       ;; This line starts a new statement.
+	       ;; Position following last unclosed open.
+	       (goto-char containing-sexp)
+	       ;; Is line first statement after an open-brace?
+	       (or
+		;; If no, find that first statement and indent like
+		;; it.  If the first statement begins with label, do
+		;; not belive when the indentation of the label is too
+		;; small.
+		(save-excursion
+		  (forward-char 1)
+		  (let ((colon-line-end 0))
+		    (while (progn (skip-chars-forward " \t\n" start-point)
+				  (and (< (point) start-point)
+				       (looking-at
+					"#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]")))
+		      ;; Skip over comments and labels following openbrace.
+		      (cond ((= (following-char) ?\#)
+			     ;;(forward-line 1)
+			     (end-of-line))
+			    ;; label:
+			    (t
+			     (save-excursion (end-of-line)
+					     (setq colon-line-end (point)))
+			     (search-forward ":"))))
+		    ;; Now at the point, after label, or at start 
+		    ;; of first statement in the block.
+		    (and (< (point) start-point)
+			 (if (> colon-line-end (point)) 
+			     ;; Before statement after label
+			     (if (> (current-indentation) 
+				    cperl-min-label-indent)
+				 (list (list 'label-in-block (point)))
+			       ;; Do not belive: `max' is involved
+			       (list
+				(list 'label-in-block-min-indent (point))))
+			   ;; Before statement
+			   (list 'statement-in-block (point))))))
+		;; If no previous statement,
+		;; indent it relative to line brace is on.
+		;; For open brace in column zero, don't let statement
+		;; start there too.  If cperl-indent-level is zero,
+		;; use cperl-brace-offset + cperl-continued-statement-offset instead.
+		;; For open-braces not the first thing in a line,
+		;; add in cperl-brace-imaginary-offset.
+
+		;; If first thing on a line:  ?????
+		(+ (if (and (bolp) (zerop cperl-indent-level))
+		       (+ cperl-brace-offset cperl-continued-statement-offset)
+		     cperl-indent-level)
+		   ;; Move back over whitespace before the openbrace.
+		   ;; If openbrace is not first nonwhite thing on the line,
+		   ;; add the cperl-brace-imaginary-offset.
+		   (progn (skip-chars-backward " \t")
+			  (if (bolp) 0 cperl-brace-imaginary-offset))
+		   ;; If the openbrace is preceded by a parenthesized exp,
+		   ;; move to the beginning of that;
+		   ;; possibly a different line
+		   (progn
+		     (if (eq (preceding-char) ?\))
+			 (forward-sexp -1))
+		     ;; Get initial indentation of the line we are on.
+		     ;; If line starts with label, calculate label indentation
+		     (if (save-excursion
+			   (beginning-of-line)
+			   (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_]*:[^:]"))
+			 (if (> (current-indentation) cperl-min-label-indent)
+			     (- (current-indentation) cperl-label-offset)
+			   (cperl-calculate-indent 
+			    (if (and parse-start (<= parse-start (point)))
+				parse-start)))
+		       (current-indentation))))))))
+      res)))
+
+(defun cperl-calculate-indent-within-comment ()
+  "Return the indentation amount for line, assuming that
+the current line is to be regarded as part of a block comment."
+  (let (end star-start)
+    (save-excursion
+      (beginning-of-line)
+      (skip-chars-forward " \t")
+      (setq end (point))
+      (and (= (following-char) ?#)
+	   (forward-line -1)
+	   (cperl-to-comment-or-eol)
+	   (setq end (point)))
+      (goto-char end)
+      (current-column))))
+
+
+(defun cperl-to-comment-or-eol ()
+  "Goes to position before comment on the current line, or to end of line.
+Returns true if comment is found."
+  (let (state stop-in cpoint (lim (progn (end-of-line) (point))))
+      (beginning-of-line)
+      (if (re-search-forward "\\=[ \t]*\\(#\\|$\\)" lim t) 
+	  (if (eq (preceding-char) ?\#) (progn (backward-char 1) t))
+	;; Else
+	(while (not stop-in)
+	  (setq state (parse-partial-sexp (point) lim nil nil nil t))
+					; stop at comment
+	  ;; If fails (beginning-of-line inside sexp), then contains not-comment
+	  ;; Do simplified processing
+	  ;;(if (re-search-forward "[^$]#" lim 1)
+	  ;;      (progn
+	  ;;	(forward-char -1)
+	  ;;	(skip-chars-backward " \t\n\f" lim))
+	  ;;    (goto-char lim))		; No `#' at all
+	  ;;)
+	  (if (nth 4 state)		; After `#';
+					; (nth 2 state) can be
+					; beginning of m,s,qq and so
+					; on
+	      (if (nth 2 state)
+		  (progn
+		    (setq cpoint (point))
+		    (goto-char (nth 2 state))
+		    (cond
+		     ((looking-at "\\(s\\|tr\\)\\>")
+		      (or (re-search-forward
+			   "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*"
+			   lim 'move)
+			  (setq stop-in t)))
+		     ((looking-at "\\(m\\|q\\([qxw]\\)?\\)\\>")
+		      (or (re-search-forward
+			   "\\=\\w+[ \t]*#\\([^\n\\\\#]\\|\\\\[\\\\#]\\)*#"
+			   lim 'move)
+			  (setq stop-in t)))
+		     (t			; It was fair comment
+		      (setq stop-in t)	; Finish
+		      (goto-char (1- cpoint)))))
+		(setq stop-in t)	; Finish
+		(forward-char -1))
+	    (setq stop-in t))		; Finish
+	  )
+	(nth 4 state))))
+
+(defun cperl-find-pods-heres (&optional min max)
+  "Scans the buffer for POD sections and here-documents.
+If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify 
+the sections using `cperl-pod-head-face', `cperl-pod-face', 
+`cperl-here-face'."
+  (interactive)
+  (or min (setq min (point-min)))
+  (or max (setq max (point-max)))
+  (let (face head-face here-face b e bb tag err
+	     (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
+	     (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
+	     (modified (buffer-modified-p)))
+    (unwind-protect
+	(progn
+	  (save-excursion
+	    (message "Scanning for pods and here-docs...")
+	    (if cperl-pod-here-fontify
+		(setq face (eval cperl-pod-face) 
+		      head-face (eval cperl-pod-head-face)
+		      here-face (eval cperl-here-face)))
+	    (remove-text-properties min max '(syntax-type t))
+	    ;; Need to remove face as well...
+	    (goto-char min)
+	    (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
+	      (if (looking-at "\n*cut\\>")
+		  (progn
+		    (message "=cut is not preceeded by a pod section")
+		    (setq err (point)))
+		(beginning-of-line)
+		(setq b (point) bb b)
+		(or (re-search-forward "\n\n=cut\\>" max 'toend)
+		    (message "Cannot find the end of a pod section"))
+		(beginning-of-line 4)
+		(setq e (point))
+		(put-text-property b e 'in-pod t)
+		(goto-char b)
+		(while (re-search-forward "\n\n[ \t]" e t)
+		  (beginning-of-line)
+		  (put-text-property b (point) 'syntax-type 'pod)
+		  (put-text-property (max (point-min) (1- b))
+				     (point) cperl-do-not-fontify t)
+		  (if cperl-pod-here-fontify (put-text-property b (point) 'face face))
+		  (re-search-forward "\n\n[^ \t\f]" e 'toend)
+		  (beginning-of-line)
+		  (setq b (point)))
+		(put-text-property (point) e 'syntax-type 'pod)
+		(put-text-property (max (point-min) (1- (point)))
+				   e cperl-do-not-fontify t)
+		(if cperl-pod-here-fontify 
+		    (progn (put-text-property (point) e 'face face)
+			   (goto-char bb)
+			   (while (re-search-forward
+				   ;; One paragraph
+				   "\n\n=[a-zA-Z0-9]+\\>[ \t]*\\(\\(\n?[^\n]\\)+\\)$"
+				   e 'toend)
+			     (put-text-property 
+			      (match-beginning 1) (match-end 1)
+			      'face head-face))))
+		(goto-char e)))
+	    (goto-char min)
+	    (while (re-search-forward 
+		    "<<\\(\\([\"'`]\\)?\\)\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\1"
+		    max t)
+	      (setq tag (buffer-substring (match-beginning 3)
+					  (match-end 3)))
+	      (if cperl-pod-here-fontify 
+		  (put-text-property (match-beginning 3) (match-end 3) 
+				     'face font-lock-reference-face))
+	      (forward-line)
+	      (setq b (point))
+	      (and (re-search-forward (concat "^" tag "$") max 'toend)
+		   (progn
+		     (if cperl-pod-here-fontify 
+			 (progn
+			   (put-text-property (match-beginning 0) (match-end 0) 
+					      'face font-lock-reference-face)
+			   (put-text-property (max (point-min) (1- b))
+					      (min (point-mox)
+						   (1+ (match-end 0)))
+					      cperl-do-not-fontify t)
+			   (put-text-property b (match-beginning 0) 
+					      'face here-face)))
+		     (put-text-property b (match-beginning 0) 
+					'syntax-type 'here-doc)))))
+	  (if err (goto-char err)
+	    (message "Scan for pods and here-docs completed.")))
+      (and (buffer-modified-p)
+	   (not modified)
+	   (set-buffer-modified-p nil)))))
+
+(defun cperl-backward-to-noncomment (lim)
+  ;; Stops at lim or after non-whitespace that is not in comment
+  (let (stop p)
+    (while (and (not stop) (> (point) (or lim 1)))
+      (skip-chars-backward " \t\n\f" lim)
+      (setq p (point))
+      (beginning-of-line)
+      (if (looking-at "^[ \t]*\\(#\\|$\\)") nil	; Only comment, skip
+	;; Else
+	(cperl-to-comment-or-eol) 
+	(skip-chars-backward " \t")
+	(if (< p (point)) (goto-char p))
+	(setq stop t)))))
+
+(defun cperl-after-expr-p (&optional lim chars test)
+  "Returns true if the position is good for start of expression.
+TEST is the expression to evaluate at the found position. If absent,
+CHARS is a string that contains good characters to have before us."
+  (let (stop p)
+    (save-excursion
+      (while (and (not stop) (> (point) (or lim 1)))
+	(skip-chars-backward " \t\n\f" lim)
+	(setq p (point))
+	(beginning-of-line)
+	(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
+	  ;; Else: last iteration (What to do with labels?)
+	  (cperl-to-comment-or-eol) 
+	  (skip-chars-backward " \t")
+	  (if (< p (point)) (goto-char p))
+	  (setq stop t)))
+      (or (bobp)
+	  (progn
+	    (backward-char 1)
+	    (if test (eval test)
+	      (memq (following-char) (append (or chars "{};") nil))))))))
+
+(defun cperl-backward-to-start-of-continued-exp (lim)
+  (if (memq (preceding-char) (append ")]}\"'`" nil))
+      (forward-sexp -1))
+  (beginning-of-line)
+  (if (<= (point) lim)
+      (goto-char (1+ lim)))
+  (skip-chars-forward " \t"))
+
+
+(defvar innerloop-done nil)
+(defvar last-depth nil)
+
+(defun cperl-indent-exp ()
+  "Simple variant of indentation of continued-sexp.
+Should be slow. Will not indent comment if it starts at `comment-indent'
+or looks like continuation of the comment on the previous line."
+  (interactive)
+  (save-excursion
+    (let ((tmp-end (progn (end-of-line) (point))) top done)
+      (save-excursion
+	(while (null done)
+	  (beginning-of-line)
+	  (setq top (point))
+	  (while (= (nth 0 (parse-partial-sexp (point) tmp-end
+					       -1)) -1)
+	    (setq top (point)))		; Get the outermost parenths in line
+	  (goto-char top)
+	  (while (< (point) tmp-end)
+	    (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
+	    (or (eolp) (forward-sexp 1)))
+	  (if (> (point) tmp-end) (progn (end-of-line) (setq tmp-end (point)))
+	    (setq done t)))
+	(goto-char tmp-end)
+	(setq tmp-end (point-marker)))
+      (cperl-indent-region (point) tmp-end))))
+
+(defun cperl-indent-region (start end)
+  "Simple variant of indentation of region in CPerl mode.
+Should be slow. Will not indent comment if it starts at `comment-indent' 
+or looks like continuation of the comment on the previous line.
+Indents all the lines whose first character is between START and END 
+inclusive."
+  (interactive "r")
+  (save-excursion
+    (let (st comm indent-info old-comm-indent new-comm-indent 
+	     (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
+      (goto-char start)
+      (setq old-comm-indent (and (cperl-to-comment-or-eol)
+				 (current-column))
+	    new-comm-indent old-comm-indent)
+      (goto-char start)
+      (or (bolp) (beginning-of-line 2))
+      (or (fboundp 'imenu-progress-message)
+	  (message "Indenting... For feedback load `imenu'..."))
+      (while (and (<= (point) end) (not (eobp))) ; bol to check start
+	(and (fboundp 'imenu-progress-message)
+	     (imenu-progress-message 
+	      pm (/ (* 100 (- (point) start)) (- end start -1))))
+	(setq st (point) 
+	      indent-info nil
+	      ) ; Believe indentation of the current
+	(if (and (setq comm (looking-at "[ \t]*#"))
+		 (or (eq (current-indentation) (or old-comm-indent 
+						   comment-column))
+		     (setq old-comm-indent nil)))
+	    (if (and old-comm-indent
+		     (= (current-indentation) old-comm-indent))
+		(let ((comment-column new-comm-indent))
+		  (indent-for-comment)))
+	  (progn 
+	    (cperl-indent-line 'indent-info)
+	    (or comm
+		(progn
+		  (if (setq old-comm-indent (and (cperl-to-comment-or-eol)
+						 (current-column)))
+		      (progn (indent-for-comment)
+			     (skip-chars-backward " \t")
+			     (skip-chars-backward "#")
+			     (setq new-comm-indent (current-column))))))))
+	(beginning-of-line 2))
+      	(if (fboundp 'imenu-progress-message)
+	     (imenu-progress-message pm 100)
+	  (message nil)))))
+
+(defun cperl-slash-is-regexp (&optional pos)
+  (save-excursion
+    (goto-char (if pos pos (1- (point))))
+    (and
+     (not (memq (get-text-property (point) 'face)
+		'(font-lock-string-face font-lock-comment-face)))
+     (cperl-after-expr-p nil nil '
+		       (or (looking-at "[^]a-zA-Z0-9_)}]")
+			   (eq (get-text-property (point) 'face)
+			       'font-lock-keyword-face))))))
+
+;; Stolen from lisp-mode with a lot of improvements
+
+(defun cperl-fill-paragraph (&optional justify iteration)
+  "Like \\[fill-paragraph], but handle CPerl comments.
+If any of the current line is a comment, fill the comment or the
+block of it that point is in, preserving the comment's initial
+indentation and initial hashes. Behaves usually outside of comment."
+  (interactive "P")
+  (let (
+	;; Non-nil if the current line contains a comment.
+	has-comment
+
+	;; If has-comment, the appropriate fill-prefix for the comment.
+	comment-fill-prefix
+	;; Line that contains code and comment (or nil)
+	start
+	c spaces len dc (comment-column comment-column))
+    ;; Figure out what kind of comment we are looking at.
+    (save-excursion
+      (beginning-of-line)
+      (cond
+
+       ;; A line with nothing but a comment on it?
+       ((looking-at "[ \t]*#[# \t]*")
+	(setq has-comment t
+	      comment-fill-prefix (buffer-substring (match-beginning 0)
+						    (match-end 0))))
+
+       ;; A line with some code, followed by a comment?  Remember that the
+       ;; semi which starts the comment shouldn't be part of a string or
+       ;; character.
+       ((cperl-to-comment-or-eol)
+	(setq has-comment t)
+	(looking-at "#+[ \t]*")
+	(setq start (point) c (current-column) 
+	      comment-fill-prefix
+	      (concat (make-string (current-column) ?\ )
+		      (buffer-substring (match-beginning 0) (match-end 0)))
+	      spaces (progn (skip-chars-backward " \t") 
+			    (buffer-substring (point) start))
+	      dc (- c (current-column)) len (- start (point)) 
+	      start (point-marker))
+	(delete-char len)
+	(insert (make-string dc ?-)))))
+    (if (not has-comment)
+	(fill-paragraph justify)	; Do the usual thing outside of comment
+      ;; Narrow to include only the comment, and then fill the region.
+      (save-restriction
+	(narrow-to-region
+	 ;; Find the first line we should include in the region to fill.
+	 (if start (progn (beginning-of-line) (point))
+	   (save-excursion
+	     (while (and (zerop (forward-line -1))
+			 (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
+	     ;; We may have gone to far.  Go forward again.
+	     (or (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")
+		 (forward-line 1))
+	     (point)))
+	 ;; Find the beginning of the first line past the region to fill.
+	 (save-excursion
+	   (while (progn (forward-line 1)
+			 (looking-at "^[ \t]*#+[ \t]*[^ \t\n#]")))
+	   (point)))
+	;; Remove existing hashes
+	(goto-char (point-min))
+	(while (progn (forward-line 1) (< (point) (point-max)))
+	  (skip-chars-forward " \t")
+	  (and (looking-at "#+") 
+	       (delete-char (- (match-end 0) (match-beginning 0)))))
+
+	;; Lines with only hashes on them can be paragraph boundaries.
+	(let ((paragraph-start (concat paragraph-start "\\|^[ \t#]*$"))
+	      (paragraph-separate (concat paragraph-start "\\|^[ \t#]*$"))
+	      (fill-prefix comment-fill-prefix))
+	  (fill-paragraph justify)))
+      (if (and start)
+	  (progn 
+	    (goto-char start)
+	    (if (> dc 0)
+	      (progn (delete-char dc) (insert spaces)))
+	    (if (or (= (current-column) c) iteration) nil
+	      (setq comment-column c)
+	      (indent-for-comment)
+	      ;; Repeat once more, flagging as iteration
+	      (cperl-fill-paragraph justify t)))))))
+
+(defun cperl-do-auto-fill ()
+  ;; Break out if the line is short enough
+  (if (> (save-excursion
+	   (end-of-line)
+	   (current-column))
+	 fill-column)
+  (let ((c (save-excursion (beginning-of-line)
+			   (cperl-to-comment-or-eol) (point)))
+	(s (memq (following-char) '(?\ ?\t))) marker)
+    (if (>= c (point)) nil
+      (setq marker (point-marker))
+      (cperl-fill-paragraph)
+      (goto-char marker)
+      ;; Is not enough, sometimes marker is a start of line
+      (if (bolp) (progn (re-search-forward "#+[ \t]*") 
+			(goto-char (match-end 0))))
+      ;; Following space could have gone:
+      (if (or (not s) (memq (following-char) '(?\ ?\t))) nil
+	(insert " ")
+	(backward-char 1))
+      ;; Previous space could have gone:
+      (or (memq (preceding-char) '(?\ ?\t)) (insert " "))))))
+
+(defvar imenu-example--function-name-regexp-perl
+      "^\\([ \t]*\\(sub\\|package\\)[ \t\n]+\\([a-zA-Z_0-9:']+\\)[ \t]*\\|=head\\([12]\\)[ \t]+\\([^\n]+\\)$\\)")
+
+(defun imenu-example--create-perl-index (&optional regexp)
+  (require 'cl)
+  (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) 
+	(index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
+	packages ends-ranges p
+	(prev-pos 0) char fchar index index1 name (end-range 0) package)
+    (goto-char (point-min))
+    (imenu-progress-message prev-pos 0)
+    ;; Search for the function
+    (save-match-data
+      (while (re-search-forward
+	      (or regexp imenu-example--function-name-regexp-perl)
+	      nil t)
+	(imenu-progress-message prev-pos)
+	;;(backward-up-list 1)
+	(cond
+	 ((match-beginning 2)		; package or sub
+	  (save-excursion
+	    (goto-char (match-beginning 2))
+	    (setq fchar (following-char))
+	    )
+	  (setq char (following-char))
+	  (setq p (point))
+	  (while (and ends-ranges (>= p (car ends-ranges)))
+	    ;; delete obsolete entries
+	    (setq ends-ranges (cdr ends-ranges) packages (cdr packages)))
+	  (setq package (or (car packages) "")
+		end-range (or (car ends-ranges) 0))
+	  (if (eq fchar ?p)
+	      (progn 
+		(setq name (buffer-substring (match-beginning 3) (match-end 3))
+		      package (concat name "::") 
+		      name (concat "package " name)
+		      end-range 
+		      (save-excursion
+			(parse-partial-sexp (point) (point-max) -1) (point))
+		      ends-ranges (cons end-range ends-ranges)
+		      packages (cons package packages))))
+	  ;;   )
+	  ;; Skip this function name if it is a prototype declaration.
+	  (if (and (eq fchar ?s) (eq char ?\;)) nil
+	    (if (eq fchar ?p) nil
+	      (setq name (buffer-substring (match-beginning 3) (match-end 3)))
+	      (if (or (> p end-range) (string-match "[:']" name)) nil
+		(setq name (concat package name))))
+	    (setq index (imenu-example--name-and-position))
+	    (setcar index name)
+	    (if (eq fchar ?p) 
+		(push index index-pack-alist)
+	      (push index index-alist))
+	    (push index index-unsorted-alist)))
+	 (t				; Pod section
+	  ;; (beginning-of-line)
+	  (setq index (imenu-example--name-and-position)
+		name (buffer-substring (match-beginning 5) (match-end 5)))
+	  (if (eq (char-after (match-beginning 4)) ?2)
+	      (setq name (concat "   " name)))
+	  (setcar index name)
+	  (setq index1 (cons (concat "=" name) (cdr index)))
+	  (push index index-pod-alist)
+	  (push index1 index-unsorted-alist)))))
+    (imenu-progress-message prev-pos 100)
+    (setq index-alist 
+	  (if (default-value 'imenu-sort-function)
+	      (sort index-alist (default-value 'imenu-sort-function))
+	      (nreverse index-alist)))
+    (and index-pod-alist
+	 (push (cons (imenu-create-submenu-name "+POD headers+") 
+		     (nreverse index-pod-alist))
+	       index-alist))
+    (and index-pack-alist
+	 (push (cons (imenu-create-submenu-name "+Packages+") 
+		     (nreverse index-pack-alist))
+	       index-alist))
+    (and (or index-pack-alist index-pod-alist 
+	     (default-value 'imenu-sort-function))
+	 index-unsorted-alist
+	 (push (cons (imenu-create-submenu-name "+Unsorted List+") 
+		     (nreverse index-unsorted-alist))
+	       index-alist))
+    index-alist))
+
+(defvar cperl-compilation-error-regexp-alist 
+  ;; This look like a paranoiac regexp: could anybody find a better one? (which WORK).
+  '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
+     2 3))
+  "Alist that specifies how to match errors in perl output.")
+
+(if (fboundp 'eval-after-load)
+    (eval-after-load
+     "mode-compile"
+     '(setq perl-compilation-error-regexp-alist
+	   cperl-compilation-error-regexp-alist)))
+
+
+(defvar cperl-faces-init nil)
+
+(defun cperl-windowed-init ()
+  "Initialization under windowed version."
+  (add-hook 'font-lock-mode-hook
+	    (function
+	     (lambda ()
+	       (if (or
+		    (eq major-mode 'perl-mode)
+		    (eq major-mode 'cperl-mode))
+		   (progn
+		     (or cperl-faces-init (cperl-init-faces))))))))
+
+(defvar perl-font-lock-keywords-1 nil
+  "Additional expressions to highlight in Perl mode. Minimal set.")
+(defvar perl-font-lock-keywords nil
+  "Additional expressions to highlight in Perl mode. Default set.")
+(defvar perl-font-lock-keywords-2 nil
+  "Additional expressions to highlight in Perl mode. Maximal set")
+
+(defun cperl-init-faces ()
+  (condition-case nil
+      (progn
+	(require 'font-lock)
+	(and (fboundp 'font-lock-fontify-anchored-keywords)
+	     (featurep 'font-lock-extra)
+	     (message "You have an obsolete package `font-lock-extra'. Install `choose-color'."))
+	(let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored)
+	  ;;(defvar cperl-font-lock-enhanced nil
+	  ;;  "Set to be non-nil if font-lock allows active highlights.")
+	  (if (fboundp 'font-lock-fontify-anchored-keywords)
+	      (setq font-lock-anchored t))
+	  (setq 
+	   t-font-lock-keywords
+	   (list
+	    (cons
+	     (concat
+	      "\\(^\\|[^$@%&\\]\\)\\<\\("
+	      (mapconcat
+	       'identity
+	       '("if" "until" "while" "elsif" "else" "unless" "for"
+		 "foreach" "continue" "exit" "die" "last" "goto" "next"
+		 "redo" "return" "local" "exec" "sub" "do" "dump" "use"
+		 "require" "package" "eval" "my" "BEGIN" "END")
+	       "\\|")			; Flow control
+	      "\\)\\>") 2)		; was "\\)[ \n\t;():,\|&]"
+					; In what follows we use `type' style
+					; for overwritable buildins
+	    (list
+	     (concat
+	      "\\(^\\|[^$@%&\\]\\)\\<\\("
+	      ;; "CORE" "__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2"
+	      ;; "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr"
+	      ;; "chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
+	      ;; "crypt" "dbmclose" "dbmopen" "die" "dump" "endgrent" "endhostent"
+	      ;; "endnetent" "endprotoent" "endpwent" "endservent" "eof" "eq" "exec"
+	      ;; "exit" "exp" "fcntl" "fileno" "flock" "fork" "formline" "ge" "getc"
+	      ;; "getgrent" "getgrgid" "getgrnam" "gethostbyaddr" "gethostbyname"
+	      ;; "gethostent" "getlogin" "getnetbyaddr" "getnetbyname" "getnetent"
+	      ;; "getpeername" "getpgrp" "getppid" "getpriority" "getprotobyname"
+	      ;; "getprotobynumber" "getprotoent" "getpwent" "getpwnam" "getpwuid"
+	      ;; "getservbyname" "getservbyport" "getservent" "getsockname"
+	      ;; "getsockopt" "glob" "gmtime" "gt" "hex" "index" "int" "ioctl"
+	      ;; "join" "kill" "lc" "lcfirst" "le" "length" "link" "listen"
+	      ;; "localtime" "log" "lstat" "lt" "mkdir" "msgctl" "msgget" "msgrcv"
+	      ;; "msgsnd" "ne" "not" "oct" "open" "opendir" "or" "ord" "pack" "pipe"
+	      ;; "quotemeta" "rand" "read" "readdir" "readline" "readlink"
+	      ;; "readpipe" "recv" "ref" "rename" "require" "reset" "reverse"
+	      ;; "rewinddir" "rindex" "rmdir" "seek" "seekdir" "select" "semctl"
+	      ;; "semget" "semop" "send" "setgrent" "sethostent" "setnetent"
+	      ;; "setpgrp" "setpriority" "setprotoent" "setpwent" "setservent"
+	      ;; "setsockopt" "shmctl" "shmget" "shmread" "shmwrite" "shutdown"
+	      ;; "sin" "sleep" "socket" "socketpair" "sprintf" "sqrt" "srand" "stat"
+	      ;; "substr" "symlink" "syscall" "sysread" "system" "syswrite" "tell"
+	      ;; "telldir" "time" "times" "truncate" "uc" "ucfirst" "umask" "unlink"
+	      ;; "unpack" "utime" "values" "vec" "wait" "waitpid" "wantarray" "warn"
+	      ;; "write" "x" "xor"
+	      "a\\(bs\\|ccept\\|tan2\\|larm\\|nd\\)\\|" 
+	      "b\\(in\\(d\\|mode\\)\\|less\\)\\|"
+	      "c\\(h\\(r\\(\\|oot\\)\\|dir\\|mod\\|own\\)\\|aller\\|rypt\\|"
+	      "lose\\(\\|dir\\)\\|mp\\|o\\(s\\|n\\(tinue\\|nect\\)\\)\\)\\|"
+	      "CORE\\|d\\(ie\\|bm\\(close\\|open\\)\\|ump\\)\\|"
+	      "e\\(x\\(p\\|it\\|ec\\)\\|q\\|nd\\(p\\(rotoent\\|went\\)\\|"
+	      "hostent\\|servent\\|netent\\|grent\\)\\|of\\)\\|"
+	      "f\\(ileno\\|cntl\\|lock\\|or\\(k\\|mline\\)\\)\\|"
+	      "g\\(t\\|lob\\|mtime\\|e\\(\\|t\\(p\\(pid\\|r\\(iority\\|"
+	      "oto\\(byn\\(ame\\|umber\\)\\|ent\\)\\)\\|eername\\|w"
+	      "\\(uid\\|ent\\|nam\\)\\|grp\\)\\|host\\(by\\(addr\\|name\\)\\|"
+	      "ent\\)\\|s\\(erv\\(by\\(port\\|name\\)\\|ent\\)\\|"
+	      "ock\\(name\\|opt\\)\\)\\|c\\|login\\|net\\(by\\(addr\\|name\\)\\|"
+	      "ent\\)\\|gr\\(ent\\|nam\\|gid\\)\\)\\)\\)\\|"
+	      "hex\\|i\\(n\\(t\\|dex\\)\\|octl\\)\\|join\\|kill\\|"
+	      "l\\(i\\(sten\\|nk\\)\\|stat\\|c\\(\\|first\\)\\|t\\|e"
+	      "\\(\\|ngth\\)\\|o\\(caltime\\|g\\)\\)\\|m\\(sg\\(rcv\\|snd\\|"
+	      "ctl\\|get\\)\\|kdir\\)\\|n\\(e\\|ot\\)\\|o\\(pen\\(\\|dir\\)\\|"
+	      "r\\(\\|d\\)\\|ct\\)\\|p\\(ipe\\|ack\\)\\|quotemeta\\|"
+	      "r\\(index\\|and\\|mdir\\|e\\(quire\\|ad\\(pipe\\|\\|lin"
+	      "\\(k\\|e\\)\\|dir\\)\\|set\\|cv\\|verse\\|f\\|winddir\\|name"
+	      "\\)\\)\\|s\\(printf\\|qrt\\|rand\\|tat\\|ubstr\\|e\\(t\\(p\\(r"
+	      "\\(iority\\|otoent\\)\\|went\\|grp\\)\\|hostent\\|s\\(ervent\\|"
+	      "ockopt\\)\\|netent\\|grent\\)\\|ek\\(\\|dir\\)\\|lect\\|"
+	      "m\\(ctl\\|op\\|get\\)\\|nd\\)\\|h\\(utdown\\|m\\(read\\|ctl\\|"
+	      "write\\|get\\)\\)\\|y\\(s\\(read\\|call\\|tem\\|write\\)\\|"
+	      "mlink\\)\\|in\\|leep\\|ocket\\(pair\\|\\)\\)\\|t\\(runcate\\|"
+	      "ell\\(\\|dir\\)\\|ime\\(\\|s\\)\\)\\|u\\(c\\(\\|first\\)\\|"
+	      "time\\|mask\\|n\\(pack\\|link\\)\\)\\|v\\(alues\\|ec\\)\\|"
+	      "w\\(a\\(rn\\|it\\(pid\\|\\)\\|ntarray\\)\\|rite\\)\\|"
+	      "x\\(\\|or\\)\\|__\\(FILE__\\|LINE__\\)"
+	      "\\)\\>") 2 'font-lock-type-face)
+	    ;; In what follows we use `other' style
+	    ;; for nonoverwritable buildins
+	    ;; Somehow 's', 'm' are not autogenerated???
+	    (list
+	     (concat
+	      "\\(^\\|[^$@%&\\]\\)\\<\\("
+	      ;; "AUTOLOAD" "BEGIN" "DESTROY" "END" "__END__" "chomp" "chop"
+	      ;; "defined" "delete" "do" "each" "else" "elsif" "eval" "exists" "for"
+	      ;; "foreach" "format" "goto" "grep" "if" "keys" "last" "local" "map"
+	      ;; "my" "next" "no" "package" "pop" "pos" "print" "printf" "push" "q"
+	      ;; "qq" "qw" "qx" "redo" "return" "scalar" "shift" "sort" "splice"
+	      ;; "split" "study" "sub" "tie" "tr" "undef" "unless" "unshift" "untie"
+	      ;; "until" "use" "while" "y"
+	      "AUTOLOAD\\|BEGIN\\|cho\\(p\\|mp\\)\\|d\\(e\\(fined\\|lete\\)\\|"
+	      "o\\)\\|DESTROY\\|e\\(ach\\|val\\|xists\\|ls\\(e\\|if\\)\\)\\|"
+	      "END\\|for\\(\\|each\\|mat\\)\\|g\\(rep\\|oto\\)\\|if\\|keys\\|"
+	      "l\\(ast\\|ocal\\)\\|m\\(ap\\|y\\)\\|n\\(ext\\|o\\)\\|"
+	      "p\\(ackage\\|rint\\(\\|f\\)\\|ush\\|o\\(p\\|s\\)\\)\\|"
+	      "q\\(\\|q\\|w\\|x\\)\\|re\\(turn\\|do\\)\\|s\\(pli\\(ce\\|t\\)\\|"
+	      "calar\\|tudy\\|ub\\|hift\\|ort\\)\\|t\\(r\\|ie\\)\\|"
+	      "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
+	      "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
+	      "\\|[sm]"			; Added manually
+	      "\\)\\>") 2 'font-lock-other-type-face)
+	    ;;		(mapconcat 'identity
+	    ;;			   '("#endif" "#else" "#ifdef" "#ifndef" "#if"
+	    ;;			     "#include" "#define" "#undef")
+	    ;;			   "\\|")
+	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
+	      font-lock-function-name-face) ; Not very good, triggers at "[a-z]"
+	    '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*[{\n]" 1
+	      font-lock-function-name-face)
+	    '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
+	      2 font-lock-function-name-face)
+	    (cond ((featurep 'font-lock-extra)
+		   '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 
+		     (2 font-lock-string-face t)
+		     (0 '(restart 2 t)))) ; To highlight $a{bc}{ef}
+		  (font-lock-anchored
+		   '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+		     (2 font-lock-string-face t)
+		     ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+		      nil nil
+		      (1 font-lock-string-face t))))
+		  (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+		       2 font-lock-string-face t)))
+	    '("[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
+	      font-lock-string-face t)
+	    '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1 
+	      font-lock-reference-face) ; labels
+	    '("\\<\\(continue\\|next\\|last\\|redo\\|goto\\)\\>[ \t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
+	      2 font-lock-reference-face)
+	    (cond ((featurep 'font-lock-extra)
+		   '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
+		     (3 font-lock-variable-name-face)
+		     (4 '(another 4 nil
+				  ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?"
+				   (1 font-lock-variable-name-face)
+				   (2 '(restart 2 nil) nil t))) 
+			nil t)))	; local variables, multiple
+		  (font-lock-anchored
+		   '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+		     (3 font-lock-variable-name-face)
+		     ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
+		      nil nil
+		      (1 font-lock-variable-name-face))))
+		  (t '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+		       3 font-lock-variable-name-face)))
+	    '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
+	      2 font-lock-variable-name-face)))
+	  (setq 
+	   t-font-lock-keywords-1
+	   (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
+		(not (cperl-xemacs-p)) ; not yet as of XEmacs 19.12
+		'(("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
+		   1
+		   (if (= (- (match-end 2) (match-beginning 2)) 1) 
+		       (if (eq (char-after (match-beginning 3)) ?{)
+			   font-lock-other-emphasized-face
+			 font-lock-emphasized-face) ; arrays and hashes
+		     font-lock-variable-name-face) ; Just to put something
+		   t)
+		  ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
+		   (if (eq (char-after (match-beginning 2)) ?%)
+		       font-lock-other-emphasized-face
+		     font-lock-emphasized-face)
+		   t)			; arrays and hashes
+		  ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
+		       ;;; Too much noise from \s* @s[ and friends
+		  ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" 
+		  ;;(3 font-lock-function-name-face t t)
+		  ;;(4
+		  ;; (if (cperl-slash-is-regexp)
+		  ;;    font-lock-function-name-face 'default) nil t))
+		  )))
+	  (setq perl-font-lock-keywords-1 t-font-lock-keywords
+		perl-font-lock-keywords perl-font-lock-keywords-1
+		perl-font-lock-keywords-2 (append
+					   t-font-lock-keywords
+					   t-font-lock-keywords-1)))
+	(if (fboundp 'ps-print-buffer) (cperl-ps-print-init))
+	(if (or (featurep 'choose-color) (featurep 'font-lock-extra))
+	    (font-lock-require-faces
+	     (list
+	      ;; Color-light    Color-dark      Gray-light      Gray-dark Mono
+	      (list 'font-lock-comment-face
+		    ["Firebrick"	"OrangeRed" 	"DimGray"	"Gray80"]
+		    nil
+		    [nil		nil		t		t	t]
+		    [nil		nil		t		t	t]
+		    nil)
+	      (list 'font-lock-string-face
+		    ["RosyBrown"	"LightSalmon" 	"Gray50"	"LightGray"]
+		    nil
+		    nil
+		    [nil		nil		t		t	t]
+		    nil)
+	      (list 'font-lock-keyword-face
+		    ["Purple"		"LightSteelBlue" "DimGray"	"Gray90"]
+		    nil
+		    [nil		nil		t		t	t]
+		    nil
+		    nil)
+	      (list 'font-lock-function-name-face
+		    (vector
+		     "Blue"		"LightSkyBlue"	"Gray50"	"LightGray"
+		     (cdr (assq 'background-color ; if mono
+				(frame-parameters))))
+		    (vector
+		     nil		nil		nil		nil
+		     (cdr (assq 'foreground-color ; if mono
+				(frame-parameters))))
+		    [nil		nil		t		t	t]
+		    nil
+		    nil)
+	      (list 'font-lock-variable-name-face
+		    ["DarkGoldenrod"	"LightGoldenrod" "DimGray"	"Gray90"]
+		    nil
+		    [nil		nil		t		t	t]
+		    [nil		nil		t		t	t]
+		    nil)
+	      (list 'font-lock-type-face
+		    ["DarkOliveGreen"	"PaleGreen" 	"DimGray"	"Gray80"]
+		    nil
+		    [nil		nil		t		t	t]
+		    nil
+		    [nil		nil		t		t	t]
+		    )
+	      (list 'font-lock-reference-face
+		    ["CadetBlue"	"Aquamarine" 	"Gray50"	"LightGray"]
+		    nil
+		    [nil		nil		t		t	t]
+		    nil
+		    [nil		nil		t		t	t]
+		    )
+	      (list 'font-lock-other-type-face
+		    ["chartreuse3"	("orchid1" "orange")
+		     nil		"Gray80"]
+		    [nil		nil		"gray90"]
+		    [nil		nil		nil		t	t]
+		    [nil		nil		t		t]
+		    [nil		nil		t		t	t]
+		    )
+	      (list 'font-lock-emphasized-face
+		    ["blue"		"yellow" 	nil		"Gray80"]
+		    ["lightyellow2"	("navy" "os2blue" "darkgreen")
+		     "gray90"]
+		    t
+		    nil
+		    nil)
+	      (list 'font-lock-other-emphasized-face
+		    ["red"		"red"	 	nil		"Gray80"]
+		    ["lightyellow2"	("navy" "os2blue" "darkgreen")
+		     "gray90"]
+		    t
+		    t
+		    nil)))
+	  (defvar cperl-guessed-background nil
+	    "Display characteristics as guessed by cperl.")
+	  (or (fboundp 'x-color-defined-p)
+	      (defalias 'x-color-defined-p 
+		(cond ((fboundp 'color-defined-p) 'color-defined-p)
+		      ;; XEmacs >= 19.12
+		      ((fboundp 'valid-color-name-p) 'valid-color-name-p)
+		      ;; XEmacs 19.11
+		      (t 'x-valid-color-name-p))))
+	  (defvar font-lock-reference-face 'font-lock-reference-face)
+	  (defvar font-lock-variable-name-face 'font-lock-variable-name-face)
+	  (or (boundp 'font-lock-type-face)
+	      (defconst font-lock-type-face
+		'font-lock-type-face
+		"Face to use for data types.")
+	      )
+	  (or (boundp 'font-lock-other-type-face)
+	      (defconst font-lock-other-type-face
+		'font-lock-other-type-face
+		"Face to use for data types from another group.")
+	      )
+	  (if (not (cperl-xemacs-p)) nil
+	    (or (boundp 'font-lock-comment-face)
+		(defconst font-lock-comment-face
+		  'font-lock-comment-face
+		  "Face to use for comments.")
+		)
+	    (or (boundp 'font-lock-keyword-face)
+		(defconst font-lock-keyword-face
+		  'font-lock-keyword-face
+		  "Face to use for keywords.")
+		)
+	    (or (boundp 'font-lock-function-name-face)
+		(defconst font-lock-function-name-face
+		  'font-lock-function-name-face
+		  "Face to use for function names.")
+		)
+	    )
+	  ;;(if (featurep 'font-lock)
+	  (if (face-equal font-lock-type-face font-lock-comment-face)
+	      (defconst font-lock-type-face
+		'font-lock-type-face
+		"Face to use for basic data types.")
+	    )
+;;;	  (if (fboundp 'eval-after-load)
+;;;	      (eval-after-load "font-lock"
+;;;			       '(if (face-equal font-lock-type-face
+;;;						font-lock-comment-face)
+;;;				    (defconst font-lock-type-face
+;;;				      'font-lock-type-face
+;;;				      "Face to use for basic data types.")
+;;;				  )))	; This does not work :-( Why?!
+;;;					; Workaround: added to font-lock-m-h
+;;;	  )
+	  (or (boundp 'font-lock-other-emphasized-face)
+	      (defconst font-lock-other-emphasized-face
+		'font-lock-other-emphasized-face
+		"Face to use for another type of emphasizing.")
+	      )
+	  (or (boundp 'font-lock-emphasized-face)
+	      (defconst font-lock-emphasized-face
+		'font-lock-emphasized-face
+		"Face to use for emphasizing.")
+	      )
+	  ;; Here we try to guess background
+	  (let ((background
+		 (if (boundp 'font-lock-background-mode)
+		     font-lock-background-mode
+		   'light)) 
+		(face-list (and (fboundp 'face-list) (face-list)))
+		is-face)
+	    (fset 'is-face
+		  (cond ((fboundp 'find-face)
+			 (symbol-function 'find-face))
+			(face-list
+			 (function (lambda (face) (member face face-list))))
+			(t
+			 (function (lambda (face) (boundp face))))))
+	    (defvar cperl-guessed-background
+	      (if (and (boundp 'font-lock-display-type)
+		       (eq font-lock-display-type 'grayscale))
+		  'gray
+		background)
+	      "Background as guessed by CPerl mode")
+	    (if (is-face 'font-lock-type-face) nil
+	      (copy-face 'default 'font-lock-type-face)
+	      (cond
+	       ((eq background 'light)
+		(set-face-foreground 'font-lock-type-face
+				     (if (x-color-defined-p "seagreen")
+					 "seagreen"
+				       "sea green")))
+	       ((eq background 'dark)
+		(set-face-foreground 'font-lock-type-face
+				     (if (x-color-defined-p "os2pink")
+					 "os2pink"
+				       "pink")))
+	       (t
+		(set-face-background 'font-lock-type-face "gray90"))))
+	    (if (is-face 'font-lock-other-type-face)
+		nil
+	      (copy-face 'font-lock-type-face 'font-lock-other-type-face)
+	      (cond
+	       ((eq background 'light)
+		(set-face-foreground 'font-lock-other-type-face
+				     (if (x-color-defined-p "chartreuse3")
+					 "chartreuse3"
+				       "chartreuse")))
+	       ((eq background 'dark)
+		(set-face-foreground 'font-lock-other-type-face
+				     (if (x-color-defined-p "orchid1")
+					 "orchid1"
+				       "orange")))))
+	    (if (is-face 'font-lock-other-emphasized-face) nil
+	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
+	      (cond
+	       ((eq background 'light)
+		(set-face-background 'font-lock-other-emphasized-face
+				     (if (x-color-defined-p "lightyellow2")
+					 "lightyellow2"
+				       (if (x-color-defined-p "lightyellow")
+					   "lightyellow"
+					 "light yellow"))))
+	       ((eq background 'dark)
+		(set-face-background 'font-lock-other-emphasized-face
+				     (if (x-color-defined-p "navy")
+					 "navy"
+				       (if (x-color-defined-p "darkgreen")
+					   "darkgreen"
+					 "dark green"))))
+	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
+	    (if (is-face 'font-lock-emphasized-face) nil
+	      (copy-face 'bold 'font-lock-emphasized-face)
+	      (cond
+	       ((eq background 'light)
+		(set-face-background 'font-lock-emphasized-face
+				     (if (x-color-defined-p "lightyellow2")
+					 "lightyellow2"
+				       "lightyellow")))
+	       ((eq background 'dark)
+		(set-face-background 'font-lock-emphasized-face
+				     (if (x-color-defined-p "navy")
+					 "navy"
+				       (if (x-color-defined-p "darkgreen")
+					   "darkgreen"
+					 "dark green"))))
+	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
+	    (if (is-face 'font-lock-variable-name-face) nil
+	      (copy-face 'italic 'font-lock-variable-name-face))
+	    (if (is-face 'font-lock-reference-face) nil
+	      (copy-face 'italic 'font-lock-reference-face))))
+	(setq cperl-faces-init t))
+    (error nil)))
+
+
+(defun cperl-ps-print-init ()
+  "Initialization of `ps-print' components for faces used in CPerl."
+  ;; Guard against old versions
+  (defvar ps-underlined-faces nil)
+  (defvar ps-bold-faces nil)
+  (defvar ps-italic-faces nil)
+  (setq ps-bold-faces
+	(append '(font-lock-emphasized-face
+		  font-lock-keyword-face 
+		  font-lock-variable-name-face 
+		  font-lock-reference-face 
+		  font-lock-other-emphasized-face) 
+		ps-bold-faces))
+  (setq ps-italic-faces
+	(append '(font-lock-other-type-face
+		  font-lock-reference-face 
+		  font-lock-other-emphasized-face)
+		ps-italic-faces))
+  (setq ps-underlined-faces
+	(append '(font-lock-emphasized-face
+		  font-lock-other-emphasized-face 
+		  font-lock-other-type-face font-lock-type-face)
+		ps-underlined-faces))
+  (cons 'font-lock-type-face ps-underlined-faces))
+
+
+(if (cperl-enable-font-lock) (cperl-windowed-init))
+
+(defun cperl-set-style (style)
+  "Set CPerl-mode variables to use one of several different indentation styles.
+The arguments are a string representing the desired style.
+Available styles are GNU, K&R, BSD and Whitesmith."
+  (interactive 
+   (let ((list (mapcar (function (lambda (elt) (list (car elt)))) 
+		       c-style-alist)))
+     (list (completing-read "Enter style: " list nil 'insist))))
+  (let ((style (cdr (assoc style c-style-alist))) setting str sym)
+    (while style
+      (setq setting (car style) style (cdr style))
+      (setq str (symbol-name (car setting)))
+      (and (string-match "^c-" str)
+	   (setq str (concat "cperl-" (substring str 2)))
+	   (setq sym (intern-soft str))
+	   (boundp sym)
+	   (set sym (cdr setting))))))
+
+(defun cperl-check-syntax ()
+  (interactive)
+  (require 'mode-compile)
+  (let ((perl-dbg-flags "-wc"))
+    (mode-compile)))
+
+(defun cperl-info-buffer ()
+  ;; Returns buffer with documentation. Creats if missing
+  (let ((info (get-buffer "*info-perl*")))
+    (if info info
+      (save-window-excursion
+	;; Get Info running
+	(require 'info)
+	(save-window-excursion
+	  (info))
+	(Info-find-node "perl5" "perlfunc")
+	(set-buffer "*info*")
+	(rename-buffer "*info-perl*")
+	(current-buffer)))))
+
+(defun cperl-word-at-point (&optional p)
+  ;; Returns the word at point or at P.
+  (save-excursion
+    (if p (goto-char p))
+    (require 'etags)
+    (funcall (or (and (boundp 'find-tag-default-function)
+		      find-tag-default-function)
+		 (get major-mode 'find-tag-default-function)
+		 ;; XEmacs 19.12 has `find-tag-default-hook'; it is
+		 ;; automatically used within `find-tag-default':
+		 'find-tag-default))))
+
+(defun cperl-info-on-command (command)
+  "Shows documentation for Perl command in other window."
+  (interactive 
+   (let* ((default (cperl-word-at-point))
+	  (read (read-string 
+		     (format "Find doc for Perl function (default %s): " 
+			     default))))
+     (list (if (equal read "") 
+		   default 
+		 read))))
+
+  (let ((buffer (current-buffer))
+	(cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
+	pos)
+    (if (string-match "^-[a-zA-Z]$" command)
+	(setq cmd-desc "^-X[ \t\n]"))
+    (set-buffer (cperl-info-buffer))
+    (beginning-of-buffer)
+    (re-search-forward "^-X[ \t\n]")
+    (forward-line -1)
+    (if (re-search-forward cmd-desc nil t)
+	(progn
+	  (setq pos (progn (beginning-of-line)
+			   (point)))
+	  (pop-to-buffer (cperl-info-buffer))
+	  (set-window-start (selected-window) pos))
+      (message "No entry for %s found." command))
+    (pop-to-buffer buffer)))
+
+(defun cperl-info-on-current-command ()
+  "Shows documentation for Perl command at point in other window."
+  (interactive)
+  (cperl-info-on-command (cperl-word-at-point)))
+
+(defun cperl-imenu-info-imenu-search ()
+  (if (looking-at "^-X[ \t\n]") nil
+    (re-search-backward
+     "^\n\\([-a-zA-Z]+\\)[ \t\n]")
+    (forward-line 1)))
+
+(defun cperl-imenu-info-imenu-name ()  
+  (buffer-substring
+   (match-beginning 1) (match-end 1)))
+
+(defun cperl-imenu-on-info ()
+  (interactive)
+  (let* ((buffer (current-buffer))
+	 imenu-create-index-function
+	 imenu-prev-index-position-function 
+	 imenu-extract-index-name-function 
+	 (index-item (save-restriction
+		       (save-window-excursion
+			 (set-buffer (cperl-info-buffer))
+			 (setq imenu-create-index-function 
+			       'imenu-default-create-index-function
+			       imenu-prev-index-position-function
+			       'cperl-imenu-info-imenu-search
+			       imenu-extract-index-name-function
+			       'cperl-imenu-info-imenu-name)
+			 (imenu-choose-buffer-index)))))
+    (and index-item
+	 (progn
+	   (push-mark)
+	   (pop-to-buffer "*info-perl*")
+	   (cond
+	    ((markerp (cdr index-item))
+	     (goto-char (marker-position (cdr index-item))))
+	    (t
+	     (goto-char (cdr index-item))))
+	   (set-window-start (selected-window) (point))
+	   (pop-to-buffer buffer)))))
+
+(defun cperl-lineup (beg end &optional step minshift)
+  "Lineup construction in a region.
+Beginning of region should be at the start of a construction.
+All first occurences of this construction in the lines that are
+partially contained in the region are lined up at the same column.
+
+MINSHIFT is the minimal amount of space to insert before the construction.
+STEP is the tabwidth to position constructions.
+If STEP is `nil', `cperl-lineup-step' will be used 
+\(or `cperl-indent-level', if `cperl-lineup-step' is `nil').
+Will not move the position at the start to the left."
+  (interactive "r")
+  (let (search col tcol seen b e)
+    (save-excursion
+      (goto-char end)
+      (end-of-line)
+      (setq end (point-marker))
+      (goto-char beg)
+      (skip-chars-forward " \t\f")
+      (setq beg (point-marker))
+      (indent-region beg end nil)
+      (goto-char beg)
+      (setq col (current-column))
+      (if (looking-at "\\sw")
+	  (if (looking-at "\\<\\sw+\\>")
+	      (setq search
+		    (concat "\\<" 
+			    (regexp-quote 
+			     (buffer-substring (match-beginning 0)
+					       (match-end 0))) "\\>"))
+	    (error "Cannot line up in a middle of the word"))
+	(if (looking-at "$")
+	    (error "Cannot line up end of line"))
+	(setq search (regexp-quote (char-to-string (following-char)))))
+      (setq step (or step cperl-lineup-step cperl-indent-level))
+      (or minshift (setq minshift 1))
+      (while (progn
+	       (beginning-of-line 2)
+	       (and (< (point) end) 
+		    (re-search-forward search end t)
+		    (goto-char (match-beginning 0))))
+	(setq tcol (current-column) seen t)
+	(if (> tcol col) (setq col tcol)))
+      (or seen
+	  (error "The construction to line up occured only once"))
+      (goto-char beg)
+      (setq col (+ col minshift))
+      (if (/= (% col step) 0) (setq step (* step (1+ (/ col step)))))
+      (while 
+	  (progn
+	    (setq e (point))
+	    (skip-chars-backward " \t")
+	    (delete-region (point) e)
+	    (indent-to-column col); (make-string (- col (current-column)) ?\ ))
+	    (beginning-of-line 2) 
+	    (and (< (point) end) 
+		 (re-search-forward search end t)
+		 (goto-char (match-beginning 0)))))))) ; No body
+
+(defun cperl-etags (&optional add all files)
+  "Run etags with appropriate options for Perl files.
+If optional argument ALL is `recursive', will process Perl files
+in subdirectories too."
+  (interactive)
+  (let ((cmd "etags")
+	(args '("-l" "none" "-r" "/\\<\\(package\\|sub\\)[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)[ \\t]*\\([{#]\\|$\\)\\)/\\4/"))
+	res)
+    (if add (setq args (cons "-a" args)))
+    (or files (setq files (list buffer-file-name)))
+    (cond
+     ((eq all 'recursive)
+      ;;(error "Not implemented: recursive")
+      (setq args (append (list "-e" 
+			       "sub wanted {push @ARGV, $File::Find::name if /\\.[Pp][Llm]$/}
+				use File::Find;
+				find(\\&wanted, '.');
+				exec @ARGV;" 
+			       cmd) args)
+	    cmd "perl"))
+     (all 
+      ;;(error "Not implemented: all")
+      (setq args (append (list "-e" 
+			       "push @ARGV, <*.PL *.pl *.pm>;
+				exec @ARGV;" 
+			       cmd) args)
+	    cmd "perl"))
+     (t
+      (setq args (append args files))))
+    (setq res (apply 'call-process cmd nil nil nil args))
+    (or (eq res 0)
+	(message "etags returned \"%s\"" res))))
diff --git a/gnu/usr.bin/perl/embed.h b/gnu/usr.bin/perl/embed.h
new file mode 100644
index 00000000000..bfd73bd7f6d
--- /dev/null
+++ b/gnu/usr.bin/perl/embed.h
@@ -0,0 +1,1389 @@
+/* This file is derived from global.sym and interp.sym */
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+#ifndef NO_EMBED
+#  define EMBED 1 
+#endif
+
+#ifdef EMBED
+
+/* globals we need to hide from the world */
+#define AMG_names	Perl_AMG_names
+#define No		Perl_No
+#define Sv		Perl_Sv
+#define Xpv		Perl_Xpv
+#define Yes		Perl_Yes
+#define abs_amg		Perl_abs_amg
+#define add_amg		Perl_add_amg
+#define add_ass_amg	Perl_add_ass_amg
+#define additem		Perl_additem
+#define amagic_generation	Perl_amagic_generation
+#define an		Perl_an
+#define atan2_amg	Perl_atan2_amg
+#define band_amg	Perl_band_amg
+#define bool__amg	Perl_bool__amg
+#define bor_amg		Perl_bor_amg
+#define buf		Perl_buf
+#define bufend		Perl_bufend
+#define bufptr		Perl_bufptr
+#define bxor_amg	Perl_bxor_amg
+#define check		Perl_check
+#define compiling	Perl_compiling
+#define compl_amg	Perl_compl_amg
+#define compcv		Perl_compcv
+#define comppad		Perl_comppad
+#define comppad_name	Perl_comppad_name
+#define comppad_name_fill	Perl_comppad_name_fill
+#define concat_amg	Perl_concat_amg
+#define concat_ass_amg	Perl_concat_ass_amg
+#define cop_seqmax	Perl_cop_seqmax
+#define cos_amg		Perl_cos_amg
+#define cryptseen	Perl_cryptseen
+#define cshlen		Perl_cshlen
+#define cshname		Perl_cshname
+#define curcop		Perl_curcop
+#define curinterp	Perl_curinterp
+#define curpad		Perl_curpad
+#define dc		Perl_dc
+#define dec_amg		Perl_dec_amg
+#define di		Perl_di
+#define div_amg		Perl_div_amg
+#define div_ass_amg	Perl_div_ass_amg
+#define ds		Perl_ds
+#define egid		Perl_egid
+#define envgv		Perl_envgv
+#define eq_amg		Perl_eq_amg
+#define error_count	Perl_error_count
+#define euid		Perl_euid
+#define evalseq		Perl_evalseq
+#define exp_amg		Perl_exp_amg
+#define expect		Perl_expect
+#define expectterm	Perl_expectterm
+#define fallback_amg	Perl_fallback_amg
+#define filter_add	Perl_filter_add
+#define filter_del	Perl_filter_del
+#define filter_read	Perl_filter_read
+#define fold		Perl_fold
+#define freq		Perl_freq
+#define ge_amg		Perl_ge_amg
+#define gid		Perl_gid
+#define gt_amg		Perl_gt_amg
+#define hexdigit	Perl_hexdigit
+#define hints		Perl_hints
+#define in_my		Perl_in_my
+#define inc_amg		Perl_inc_amg
+#define io_close	Perl_io_close
+#define know_next	Perl_know_next
+#define last_lop	Perl_last_lop
+#define last_lop_op	Perl_last_lop_op
+#define last_uni	Perl_last_uni
+#define le_amg		Perl_le_amg
+#define lex_state	Perl_lex_state
+#define lex_defer	Perl_lex_defer
+#define lex_expect	Perl_lex_expect
+#define lex_brackets	Perl_lex_brackets
+#define lex_formbrack	Perl_lex_formbrack
+#define lex_fakebrack	Perl_lex_fakebrack
+#define lex_casemods	Perl_lex_casemods
+#define lex_dojoin	Perl_lex_dojoin
+#define lex_starts	Perl_lex_starts
+#define lex_stuff	Perl_lex_stuff
+#define lex_repl	Perl_lex_repl
+#define lex_op		Perl_lex_op
+#define lex_inpat	Perl_lex_inpat
+#define lex_inwhat	Perl_lex_inwhat
+#define lex_brackstack	Perl_lex_brackstack
+#define lex_casestack	Perl_lex_casestack
+#define linestr		Perl_linestr
+#define log_amg		Perl_log_amg
+#define lshift_amg	Perl_lshift_amg
+#define lshift_ass_amg	Perl_lshift_ass_amg
+#define lt_amg		Perl_lt_amg
+#define markstack	Perl_markstack
+#define markstack_max	Perl_markstack_max
+#define markstack_ptr	Perl_markstack_ptr
+#define maxo		Perl_maxo
+#define max_intro_pending	Perl_max_intro_pending
+#define min_intro_pending	Perl_min_intro_pending
+#define mod_amg		Perl_mod_amg
+#define mod_ass_amg	Perl_mod_ass_amg
+#define mult_amg	Perl_mult_amg
+#define mult_ass_amg	Perl_mult_ass_amg
+#define multi_close	Perl_multi_close
+#define multi_end	Perl_multi_end
+#define multi_open	Perl_multi_open
+#define multi_start	Perl_multi_start
+#define na		Perl_na
+#define ncmp_amg	Perl_ncmp_amg
+#define nextval		Perl_nextval
+#define nexttype	Perl_nexttype
+#define nexttoke	Perl_nexttoke
+#define ne_amg		Perl_ne_amg
+#define neg_amg		Perl_neg_amg
+#define nexttype	Perl_nexttype
+#define nextval		Perl_nextval
+#define no_aelem	Perl_no_aelem
+#define no_dir_func	Perl_no_dir_func
+#define no_func		Perl_no_func
+#define no_helem	Perl_no_helem
+#define no_mem		Perl_no_mem
+#define no_modify	Perl_no_modify
+#define no_security	Perl_no_security
+#define no_sock_func	Perl_no_sock_func
+#define no_usym		Perl_no_usym
+#define nointrp		Perl_nointrp
+#define nomem		Perl_nomem
+#define nomemok		Perl_nomemok
+#define nomethod_amg	Perl_nomethod_amg
+#define not_amg		Perl_not_amg
+#define numer_amg	Perl_numer_amg
+#define oldbufptr	Perl_oldbufptr
+#define oldoldbufptr	Perl_oldoldbufptr
+#define op		Perl_op
+#define op_desc		Perl_op_desc
+#define op_name		Perl_op_name
+#define op_seqmax	Perl_op_seqmax
+#define opargs		Perl_opargs
+#define origalen	Perl_origalen
+#define origenviron	Perl_origenviron
+#define osname		Perl_osname
+#define padix		Perl_padix
+#define patleave	Perl_patleave
+#define pow_amg		Perl_pow_amg
+#define pow_ass_amg	Perl_pow_ass_amg
+#define ppaddr		Perl_ppaddr
+#define profiledata	Perl_profiledata
+#define provide_ref	Perl_provide_ref
+#define qrt_amg		Perl_qrt_amg
+#define rcsid		Perl_rcsid
+#define reall_srchlen	Perl_reall_srchlen
+#define regarglen	Perl_regarglen
+#define regbol		Perl_regbol
+#define regcode		Perl_regcode
+#define regdummy	Perl_regdummy
+#define regendp		Perl_regendp
+#define regeol		Perl_regeol
+#define regfold		Perl_regfold
+#define reginput	Perl_reginput
+#define regkind	Perl_regkind
+#define reglastparen	Perl_reglastparen
+#define regmyendp	Perl_regmyendp
+#define regmyp_size	Perl_regmyp_size
+#define regmystartp	Perl_regmystartp
+#define regnarrate	Perl_regnarrate
+#define regnaughty	Perl_regnaughty
+#define regnpar		Perl_regnpar
+#define regparse	Perl_regparse
+#define regprecomp	Perl_regprecomp
+#define regprev		Perl_regprev
+#define regsawback	Perl_regsawback
+#define regsize		Perl_regsize
+#define regstartp	Perl_regstartp
+#define regtill		Perl_regtill
+#define regxend		Perl_regxend
+#define repeat_amg	Perl_repeat_amg
+#define repeat_ass_amg	Perl_repeat_ass_amg
+#define retstack	Perl_retstack
+#define retstack_ix	Perl_retstack_ix
+#define retstack_max	Perl_retstack_max
+#define rsfp		Perl_rsfp
+#define rsfp_filters	Perl_rsfp_filters
+#define rshift_amg	Perl_rshift_amg
+#define rshift_ass_amg	Perl_rshift_ass_amg
+#define save_pptr	Perl_save_pptr
+#define savestack	Perl_savestack
+#define savestack_ix	Perl_savestack_ix
+#define savestack_max	Perl_savestack_max
+#define saw_return	Perl_saw_return
+#define scmp_amg	Perl_scmp_amg
+#define scopestack	Perl_scopestack
+#define scopestack_ix	Perl_scopestack_ix
+#define scopestack_max	Perl_scopestack_max
+#define scrgv		Perl_scrgv
+#define seq_amg		Perl_seq_amg
+#define sge_amg		Perl_sge_amg
+#define sgt_amg		Perl_sgt_amg
+#define sig_name	Perl_sig_name
+#define sig_num		Perl_sig_num
+#define siggv		Perl_siggv
+#define sighandler	Perl_sighandler
+#define simple		Perl_simple
+#define sin_amg		Perl_sin_amg
+#define sle_amg		Perl_sle_amg
+#define slt_amg		Perl_slt_amg
+#define sne_amg		Perl_sne_amg
+#define stack		Perl_stack
+#define stack_base	Perl_stack_base
+#define stack_max	Perl_stack_max
+#define stack_sp	Perl_stack_sp
+#define statbuf		Perl_statbuf
+#define string_amg	Perl_string_amg
+#define sub_generation	Perl_sub_generation
+#define subline		Perl_subline
+#define subname		Perl_subname
+#define subtr_amg	Perl_subtr_amg
+#define subtr_ass_amg	Perl_subtr_ass_amg
+#define sv_no		Perl_sv_no
+#define sv_undef	Perl_sv_undef
+#define sv_yes		Perl_sv_yes
+#define tainting	Perl_tainting
+#define thisexpr	Perl_thisexpr
+#define timesbuf	Perl_timesbuf
+#define tokenbuf	Perl_tokenbuf
+#define uid		Perl_uid
+#define varies		Perl_varies
+#define vert		Perl_vert
+#define vtbl_amagic	Perl_vtbl_amagic
+#define vtbl_amagicelem	Perl_vtbl_amagicelem
+#define vtbl_arylen	Perl_vtbl_arylen
+#define vtbl_bm		Perl_vtbl_bm
+#define vtbl_dbline	Perl_vtbl_dbline
+#define vtbl_env	Perl_vtbl_env
+#define vtbl_envelem	Perl_vtbl_envelem
+#define vtbl_glob	Perl_vtbl_glob
+#define vtbl_isa	Perl_vtbl_isa
+#define vtbl_isaelem	Perl_vtbl_isaelem
+#define vtbl_mglob	Perl_vtbl_mglob
+#define vtbl_pack	Perl_vtbl_pack
+#define vtbl_packelem	Perl_vtbl_packelem
+#define vtbl_pos	Perl_vtbl_pos
+#define vtbl_sig	Perl_vtbl_sig
+#define vtbl_sigelem	Perl_vtbl_sigelem
+#define vtbl_substr	Perl_vtbl_substr
+#define vtbl_sv		Perl_vtbl_sv
+#define vtbl_taint	Perl_vtbl_taint
+#define vtbl_uvar	Perl_vtbl_uvar
+#define vtbl_vec	Perl_vtbl_vec
+#define warn_nl		Perl_warn_nl
+#define warn_nosemi	Perl_warn_nosemi
+#define warn_reserved	Perl_warn_reserved
+#define watchaddr	Perl_watchaddr
+#define watchok		Perl_watchok
+#define yychar		Perl_yychar
+#define yycheck		Perl_yycheck
+#define yydebug		Perl_yydebug
+#define yydefred	Perl_yydefred
+#define yydgoto		Perl_yydgoto
+#define yyerrflag	Perl_yyerrflag
+#define yygindex	Perl_yygindex
+#define yylen		Perl_yylen
+#define yylhs		Perl_yylhs
+#define yylval		Perl_yylval
+#define yyname		Perl_yyname
+#define yynerrs		Perl_yynerrs
+#define yyrindex	Perl_yyrindex
+#define yyrule		Perl_yyrule
+#define yysindex	Perl_yysindex
+#define yytable		Perl_yytable
+#define yyval		Perl_yyval
+#define Gv_AMupdate	Perl_Gv_AMupdate
+#define amagic_call	Perl_amagic_call
+#define append_elem	Perl_append_elem
+#define append_list	Perl_append_list
+#define apply		Perl_apply
+#define assertref	Perl_assertref
+#define av_clear	Perl_av_clear
+#define av_extend	Perl_av_extend
+#define av_fake		Perl_av_fake
+#define av_fetch	Perl_av_fetch
+#define av_fill		Perl_av_fill
+#define av_len		Perl_av_len
+#define av_make		Perl_av_make
+#define av_pop		Perl_av_pop
+#define av_push		Perl_av_push
+#define av_shift	Perl_av_shift
+#define av_store	Perl_av_store
+#define av_undef	Perl_av_undef
+#define av_unshift	Perl_av_unshift
+#define bind_match	Perl_bind_match
+#define block_end	Perl_block_end
+#define block_start	Perl_block_start
+#define calllist	Perl_calllist
+#define cando		Perl_cando
+#define cast_ulong	Perl_cast_ulong
+#define check_uni	Perl_check_uni
+#define checkcomma	Perl_checkcomma
+#define chsize		Perl_chsize
+#define ck_aelem	Perl_ck_aelem
+#define ck_concat	Perl_ck_concat
+#define ck_delete	Perl_ck_delete
+#define ck_eof		Perl_ck_eof
+#define ck_eval		Perl_ck_eval
+#define ck_exec		Perl_ck_exec
+#define ck_formline	Perl_ck_formline
+#define ck_ftst		Perl_ck_ftst
+#define ck_fun		Perl_ck_fun
+#define ck_glob		Perl_ck_glob
+#define ck_grep		Perl_ck_grep
+#define ck_gvconst	Perl_ck_gvconst
+#define ck_index	Perl_ck_index
+#define ck_lengthconst	Perl_ck_lengthconst
+#define ck_lfun		Perl_ck_lfun
+#define ck_listiob	Perl_ck_listiob
+#define ck_match	Perl_ck_match
+#define ck_null		Perl_ck_null
+#define ck_repeat	Perl_ck_repeat
+#define ck_require	Perl_ck_require
+#define ck_retarget	Perl_ck_retarget
+#define ck_rfun		Perl_ck_rfun
+#define ck_rvconst	Perl_ck_rvconst
+#define ck_select	Perl_ck_select
+#define ck_shift	Perl_ck_shift
+#define ck_sort		Perl_ck_sort
+#define ck_spair	Perl_ck_spair
+#define ck_split	Perl_ck_split
+#define ck_subr		Perl_ck_subr
+#define ck_svconst	Perl_ck_svconst
+#define ck_trunc	Perl_ck_trunc
+#define convert		Perl_convert
+#define cpytill		Perl_cpytill
+#define croak		Perl_croak
+#define cv_clone	Perl_cv_clone
+#define cv_undef	Perl_cv_undef
+#define cx_dump		Perl_cx_dump
+#define cxinc		Perl_cxinc
+#define deb		Perl_deb
+#define deb_growlevel	Perl_deb_growlevel
+#define debop		Perl_debop
+#define debprofdump	Perl_debprofdump
+#define debstack	Perl_debstack
+#define debstackptrs	Perl_debstackptrs
+#define deprecate	Perl_deprecate
+#define die		Perl_die
+#define die_where	Perl_die_where
+#define do_aexec	Perl_do_aexec
+#define do_chomp	Perl_do_chomp
+#define do_chop		Perl_do_chop
+#define do_close	Perl_do_close
+#define do_eof		Perl_do_eof
+#define do_exec		Perl_do_exec
+#define do_execfree	Perl_do_execfree
+#define do_ipcctl	Perl_do_ipcctl
+#define do_ipcget	Perl_do_ipcget
+#define do_join		Perl_do_join
+#define do_kv		Perl_do_kv
+#define do_msgrcv	Perl_do_msgrcv
+#define do_msgsnd	Perl_do_msgsnd
+#define do_open		Perl_do_open
+#define do_pipe		Perl_do_pipe
+#define do_print	Perl_do_print
+#define do_readline	Perl_do_readline
+#define do_seek		Perl_do_seek
+#define do_semop	Perl_do_semop
+#define do_shmio	Perl_do_shmio
+#define do_sprintf	Perl_do_sprintf
+#define do_tell		Perl_do_tell
+#define do_trans	Perl_do_trans
+#define do_vecset	Perl_do_vecset
+#define do_vop		Perl_do_vop
+#define doeval		Perl_doeval
+#define dofindlabel	Perl_dofindlabel
+#define dopoptoeval	Perl_dopoptoeval
+#define dounwind	Perl_dounwind
+#define dowantarray	Perl_dowantarray
+#define dump_all	Perl_dump_all
+#define dump_eval	Perl_dump_eval
+#define dump_fds	Perl_dump_fds
+#define dump_form	Perl_dump_form
+#define dump_gv		Perl_dump_gv
+#define dump_mstats	Perl_dump_mstats
+#define dump_op		Perl_dump_op
+#define dump_packsubs	Perl_dump_packsubs
+#define dump_pm		Perl_dump_pm
+#define dump_sub	Perl_dump_sub
+#define fbm_compile	Perl_fbm_compile
+#define fbm_instr	Perl_fbm_instr
+#define fetch_gv	Perl_fetch_gv
+#define fetch_io	Perl_fetch_io
+#define filter_add	Perl_filter_add
+#define filter_del	Perl_filter_del
+#define filter_read	Perl_filter_read
+#define fold_constants	Perl_fold_constants
+#define force_ident	Perl_force_ident
+#define force_list	Perl_force_list
+#define force_next	Perl_force_next
+#define force_word	Perl_force_word
+#define free_tmps	Perl_free_tmps
+#define gen_constant_list	Perl_gen_constant_list
+#define gp_free		Perl_gp_free
+#define gp_ref		Perl_gp_ref
+#define gv_AVadd	Perl_gv_AVadd
+#define gv_HVadd	Perl_gv_HVadd
+#define gv_IOadd	Perl_gv_IOadd
+#define gv_check	Perl_gv_check
+#define gv_efullname	Perl_gv_efullname
+#define gv_fetchfile	Perl_gv_fetchfile
+#define gv_fetchmeth	Perl_gv_fetchmeth
+#define gv_fetchmethod	Perl_gv_fetchmethod
+#define gv_fetchpv	Perl_gv_fetchpv
+#define gv_fullname	Perl_gv_fullname
+#define gv_init		Perl_gv_init
+#define gv_stashpv	Perl_gv_stashpv
+#define gv_stashsv	Perl_gv_stashsv
+#define he_delayfree	Perl_he_delayfree
+#define he_free		Perl_he_free
+#define he_root		Perl_he_root
+#define hoistmust	Perl_hoistmust
+#define hv_clear	Perl_hv_clear
+#define hv_delete	Perl_hv_delete
+#define hv_exists	Perl_hv_exists
+#define hv_fetch	Perl_hv_fetch
+#define hv_iterinit	Perl_hv_iterinit
+#define hv_iterkey	Perl_hv_iterkey
+#define hv_iternext	Perl_hv_iternext
+#define hv_iternextsv	Perl_hv_iternextsv
+#define hv_iterval	Perl_hv_iterval
+#define hv_magic	Perl_hv_magic
+#define hv_stashpv	Perl_hv_stashpv
+#define hv_store	Perl_hv_store
+#define hv_undef	Perl_hv_undef
+#define ibcmp		Perl_ibcmp
+#define ingroup		Perl_ingroup
+#define instr		Perl_instr
+#define intuit_more	Perl_intuit_more
+#define invert		Perl_invert
+#define jmaybe		Perl_jmaybe
+#define keyword		Perl_keyword
+#define leave_scope	Perl_leave_scope
+#define lex_end		Perl_lex_end
+#define lex_start	Perl_lex_start
+#define linklist	Perl_linklist
+#define list		Perl_list
+#define listkids	Perl_listkids
+#define localize	Perl_localize
+#define looks_like_number	Perl_looks_like_number
+#define magic_clearenv	Perl_magic_clearenv
+#define magic_clearpack	Perl_magic_clearpack
+#define magic_existspack	Perl_magic_existspack
+#define magic_get	Perl_magic_get
+#define magic_getarylen	Perl_magic_getarylen
+#define magic_getglob	Perl_magic_getglob
+#define magic_getpack	Perl_magic_getpack
+#define magic_getpos	Perl_magic_getpos
+#define magic_gettaint	Perl_magic_gettaint
+#define magic_getuvar	Perl_magic_getuvar
+#define magic_len	Perl_magic_len
+#define magic_nextpack	Perl_magic_nextpack
+#define magic_set	Perl_magic_set
+#define magic_setamagic	Perl_magic_setamagic
+#define magic_setarylen	Perl_magic_setarylen
+#define magic_setbm	Perl_magic_setbm
+#define magic_setdbline	Perl_magic_setdbline
+#define magic_setenv	Perl_magic_setenv
+#define magic_setglob	Perl_magic_setglob
+#define magic_setisa	Perl_magic_setisa
+#define magic_setmglob	Perl_magic_setmglob
+#define magic_setpack	Perl_magic_setpack
+#define magic_setpos	Perl_magic_setpos
+#define magic_setsig	Perl_magic_setsig
+#define magic_setsubstr	Perl_magic_setsubstr
+#define magic_settaint	Perl_magic_settaint
+#define magic_setuvar	Perl_magic_setuvar
+#define magic_setvec	Perl_magic_setvec
+#define magic_wipepack	Perl_magic_wipepack
+#define magicname	Perl_magicname
+#define markstack_grow	Perl_markstack_grow
+#define mess		Perl_mess
+#define mg_clear	Perl_mg_clear
+#define mg_copy		Perl_mg_copy
+#define mg_find		Perl_mg_find
+#define mg_free		Perl_mg_free
+#define mg_get		Perl_mg_get
+#define mg_len		Perl_mg_len
+#define mg_magical	Perl_mg_magical
+#define mg_set		Perl_mg_set
+#define mod		Perl_mod
+#define modkids		Perl_modkids
+#define moreswitches	Perl_moreswitches
+#define mstats		Perl_mstats
+#define my		Perl_my
+#define my_bcopy	Perl_my_bcopy
+#define my_bzero	Perl_my_bzero
+#define my_exit		Perl_my_exit
+#define my_htonl	Perl_my_htonl
+#define my_lstat	Perl_my_lstat
+#define my_memcmp	Perl_my_memcmp
+#define my_ntohl	Perl_my_ntohl
+#define my_pclose	Perl_my_pclose
+#define my_popen	Perl_my_popen
+#define my_setenv	Perl_my_setenv
+#define my_stat		Perl_my_stat
+#define my_swap		Perl_my_swap
+#define my_unexec	Perl_my_unexec
+#define newANONHASH	Perl_newANONHASH
+#define newANONLIST	Perl_newANONLIST
+#define newANONSUB	Perl_newANONSUB
+#define newASSIGNOP	Perl_newASSIGNOP
+#define newAV		Perl_newAV
+#define newAVREF	Perl_newAVREF
+#define newBINOP	Perl_newBINOP
+#define newCONDOP	Perl_newCONDOP
+#define newCVREF	Perl_newCVREF
+#define newFORM		Perl_newFORM
+#define newFOROP	Perl_newFOROP
+#define newGVOP		Perl_newGVOP
+#define newGVREF	Perl_newGVREF
+#define newGVgen	Perl_newGVgen
+#define newHV		Perl_newHV
+#define newHVREF	Perl_newHVREF
+#define newIO		Perl_newIO
+#define newLISTOP	Perl_newLISTOP
+#define newLOGOP	Perl_newLOGOP
+#define newLOOPEX	Perl_newLOOPEX
+#define newLOOPOP	Perl_newLOOPOP
+#define newNULLLIST	Perl_newNULLLIST
+#define newOP		Perl_newOP
+#define newPMOP		Perl_newPMOP
+#define newPROG		Perl_newPROG
+#define newPVOP		Perl_newPVOP
+#define newRANGE	Perl_newRANGE
+#define newRV		Perl_newRV
+#define newSLICEOP	Perl_newSLICEOP
+#define newSTATEOP	Perl_newSTATEOP
+#define newSUB		Perl_newSUB
+#define newSV		Perl_newSV
+#define newSVOP		Perl_newSVOP
+#define newSVREF	Perl_newSVREF
+#define newSViv		Perl_newSViv
+#define newSVnv		Perl_newSVnv
+#define newSVpv		Perl_newSVpv
+#define newSVrv		Perl_newSVrv
+#define newSVsv		Perl_newSVsv
+#define newUNOP		Perl_newUNOP
+#define newWHILEOP	Perl_newWHILEOP
+#define newXS		Perl_newXS
+#define newXSUB		Perl_newXSUB
+#define nextargv	Perl_nextargv
+#define ninstr		Perl_ninstr
+#define no_fh_allowed	Perl_no_fh_allowed
+#define no_op		Perl_no_op
+#define oopsAV		Perl_oopsAV
+#define oopsCV		Perl_oopsCV
+#define oopsHV		Perl_oopsHV
+#define op_free		Perl_op_free
+#define package		Perl_package
+#define pad_alloc	Perl_pad_alloc
+#define pad_allocmy	Perl_pad_allocmy
+#define pad_findmy	Perl_pad_findmy
+#define pad_free	Perl_pad_free
+#define pad_leavemy	Perl_pad_leavemy
+#define pad_reset	Perl_pad_reset
+#define pad_sv		Perl_pad_sv
+#define pad_swipe	Perl_pad_swipe
+#define peep		Perl_peep
+#define pidgone		Perl_pidgone
+#define pmflag		Perl_pmflag
+#define pmruntime	Perl_pmruntime
+#define pmtrans		Perl_pmtrans
+#define pop_return	Perl_pop_return
+#define pop_scope	Perl_pop_scope
+#define pp_aassign	Perl_pp_aassign
+#define pp_abs		Perl_pp_abs
+#define pp_accept	Perl_pp_accept
+#define pp_add		Perl_pp_add
+#define pp_aelem	Perl_pp_aelem
+#define pp_aelemfast	Perl_pp_aelemfast
+#define pp_alarm	Perl_pp_alarm
+#define pp_and		Perl_pp_and
+#define pp_andassign	Perl_pp_andassign
+#define pp_anoncode	Perl_pp_anoncode
+#define pp_anonhash	Perl_pp_anonhash
+#define pp_anonlist	Perl_pp_anonlist
+#define pp_aslice	Perl_pp_aslice
+#define pp_atan2	Perl_pp_atan2
+#define pp_av2arylen	Perl_pp_av2arylen
+#define pp_backtick	Perl_pp_backtick
+#define pp_bind		Perl_pp_bind
+#define pp_binmode	Perl_pp_binmode
+#define pp_bit_and	Perl_pp_bit_and
+#define pp_bit_or	Perl_pp_bit_or
+#define pp_bit_xor	Perl_pp_bit_xor
+#define pp_bless	Perl_pp_bless
+#define pp_caller	Perl_pp_caller
+#define pp_chdir	Perl_pp_chdir
+#define pp_chmod	Perl_pp_chmod
+#define pp_chomp	Perl_pp_chomp
+#define pp_chop		Perl_pp_chop
+#define pp_chown	Perl_pp_chown
+#define pp_chr		Perl_pp_chr
+#define pp_chroot	Perl_pp_chroot
+#define pp_close	Perl_pp_close
+#define pp_closedir	Perl_pp_closedir
+#define pp_complement	Perl_pp_complement
+#define pp_concat	Perl_pp_concat
+#define pp_cond_expr	Perl_pp_cond_expr
+#define pp_connect	Perl_pp_connect
+#define pp_const	Perl_pp_const
+#define pp_cos		Perl_pp_cos
+#define pp_crypt	Perl_pp_crypt
+#define pp_cswitch	Perl_pp_cswitch
+#define pp_dbmclose	Perl_pp_dbmclose
+#define pp_dbmopen	Perl_pp_dbmopen
+#define pp_dbstate	Perl_pp_dbstate
+#define pp_defined	Perl_pp_defined
+#define pp_delete	Perl_pp_delete
+#define pp_die		Perl_pp_die
+#define pp_divide	Perl_pp_divide
+#define pp_dofile	Perl_pp_dofile
+#define pp_dump		Perl_pp_dump
+#define pp_each		Perl_pp_each
+#define pp_egrent	Perl_pp_egrent
+#define pp_ehostent	Perl_pp_ehostent
+#define pp_enetent	Perl_pp_enetent
+#define pp_enter	Perl_pp_enter
+#define pp_entereval	Perl_pp_entereval
+#define pp_enteriter	Perl_pp_enteriter
+#define pp_enterloop	Perl_pp_enterloop
+#define pp_entersub	Perl_pp_entersub
+#define pp_entersubr	Perl_pp_entersubr
+#define pp_entertry	Perl_pp_entertry
+#define pp_enterwrite	Perl_pp_enterwrite
+#define pp_eof		Perl_pp_eof
+#define pp_eprotoent	Perl_pp_eprotoent
+#define pp_epwent	Perl_pp_epwent
+#define pp_eq		Perl_pp_eq
+#define pp_eservent	Perl_pp_eservent
+#define pp_evalonce	Perl_pp_evalonce
+#define pp_exec		Perl_pp_exec
+#define pp_exists	Perl_pp_exists
+#define pp_exit		Perl_pp_exit
+#define pp_exp		Perl_pp_exp
+#define pp_fcntl	Perl_pp_fcntl
+#define pp_fileno	Perl_pp_fileno
+#define pp_flip		Perl_pp_flip
+#define pp_flock	Perl_pp_flock
+#define pp_flop		Perl_pp_flop
+#define pp_fork		Perl_pp_fork
+#define pp_formline	Perl_pp_formline
+#define pp_ftatime	Perl_pp_ftatime
+#define pp_ftbinary	Perl_pp_ftbinary
+#define pp_ftblk	Perl_pp_ftblk
+#define pp_ftchr	Perl_pp_ftchr
+#define pp_ftctime	Perl_pp_ftctime
+#define pp_ftdir	Perl_pp_ftdir
+#define pp_fteexec	Perl_pp_fteexec
+#define pp_fteowned	Perl_pp_fteowned
+#define pp_fteread	Perl_pp_fteread
+#define pp_ftewrite	Perl_pp_ftewrite
+#define pp_ftfile	Perl_pp_ftfile
+#define pp_ftis		Perl_pp_ftis
+#define pp_ftlink	Perl_pp_ftlink
+#define pp_ftmtime	Perl_pp_ftmtime
+#define pp_ftpipe	Perl_pp_ftpipe
+#define pp_ftrexec	Perl_pp_ftrexec
+#define pp_ftrowned	Perl_pp_ftrowned
+#define pp_ftrread	Perl_pp_ftrread
+#define pp_ftrwrite	Perl_pp_ftrwrite
+#define pp_ftsgid	Perl_pp_ftsgid
+#define pp_ftsize	Perl_pp_ftsize
+#define pp_ftsock	Perl_pp_ftsock
+#define pp_ftsuid	Perl_pp_ftsuid
+#define pp_ftsvtx	Perl_pp_ftsvtx
+#define pp_fttext	Perl_pp_fttext
+#define pp_fttty	Perl_pp_fttty
+#define pp_ftzero	Perl_pp_ftzero
+#define pp_ge		Perl_pp_ge
+#define pp_gelem	Perl_pp_gelem
+#define pp_getc		Perl_pp_getc
+#define pp_getlogin	Perl_pp_getlogin
+#define pp_getpeername	Perl_pp_getpeername
+#define pp_getpgrp	Perl_pp_getpgrp
+#define pp_getppid	Perl_pp_getppid
+#define pp_getpriority	Perl_pp_getpriority
+#define pp_getsockname	Perl_pp_getsockname
+#define pp_ggrent	Perl_pp_ggrent
+#define pp_ggrgid	Perl_pp_ggrgid
+#define pp_ggrnam	Perl_pp_ggrnam
+#define pp_ghbyaddr	Perl_pp_ghbyaddr
+#define pp_ghbyname	Perl_pp_ghbyname
+#define pp_ghostent	Perl_pp_ghostent
+#define pp_glob		Perl_pp_glob
+#define pp_gmtime	Perl_pp_gmtime
+#define pp_gnbyaddr	Perl_pp_gnbyaddr
+#define pp_gnbyname	Perl_pp_gnbyname
+#define pp_gnetent	Perl_pp_gnetent
+#define pp_goto		Perl_pp_goto
+#define pp_gpbyname	Perl_pp_gpbyname
+#define pp_gpbynumber	Perl_pp_gpbynumber
+#define pp_gprotoent	Perl_pp_gprotoent
+#define pp_gpwent	Perl_pp_gpwent
+#define pp_gpwnam	Perl_pp_gpwnam
+#define pp_gpwuid	Perl_pp_gpwuid
+#define pp_grepstart	Perl_pp_grepstart
+#define pp_grepwhile	Perl_pp_grepwhile
+#define pp_gsbyname	Perl_pp_gsbyname
+#define pp_gsbyport	Perl_pp_gsbyport
+#define pp_gservent	Perl_pp_gservent
+#define pp_gsockopt	Perl_pp_gsockopt
+#define pp_gt		Perl_pp_gt
+#define pp_gv		Perl_pp_gv
+#define pp_gvsv		Perl_pp_gvsv
+#define pp_helem	Perl_pp_helem
+#define pp_hex		Perl_pp_hex
+#define pp_hslice	Perl_pp_hslice
+#define pp_i_add	Perl_pp_i_add
+#define pp_i_divide	Perl_pp_i_divide
+#define pp_i_eq		Perl_pp_i_eq
+#define pp_i_ge		Perl_pp_i_ge
+#define pp_i_gt		Perl_pp_i_gt
+#define pp_i_le		Perl_pp_i_le
+#define pp_i_lt		Perl_pp_i_lt
+#define pp_i_modulo	Perl_pp_i_modulo
+#define pp_i_multiply	Perl_pp_i_multiply
+#define pp_i_ncmp	Perl_pp_i_ncmp
+#define pp_i_ne		Perl_pp_i_ne
+#define pp_i_negate	Perl_pp_i_negate
+#define pp_i_subtract	Perl_pp_i_subtract
+#define pp_index	Perl_pp_index
+#define pp_indread	Perl_pp_indread
+#define pp_int		Perl_pp_int
+#define pp_interp	Perl_pp_interp
+#define pp_ioctl	Perl_pp_ioctl
+#define pp_iter		Perl_pp_iter
+#define pp_join		Perl_pp_join
+#define pp_keys		Perl_pp_keys
+#define pp_kill		Perl_pp_kill
+#define pp_last		Perl_pp_last
+#define pp_lc		Perl_pp_lc
+#define pp_lcfirst	Perl_pp_lcfirst
+#define pp_le		Perl_pp_le
+#define pp_leave	Perl_pp_leave
+#define pp_leaveeval	Perl_pp_leaveeval
+#define pp_leaveloop	Perl_pp_leaveloop
+#define pp_leavesub	Perl_pp_leavesub
+#define pp_leavetry	Perl_pp_leavetry
+#define pp_leavewrite	Perl_pp_leavewrite
+#define pp_left_shift	Perl_pp_left_shift
+#define pp_length	Perl_pp_length
+#define pp_lineseq	Perl_pp_lineseq
+#define pp_link		Perl_pp_link
+#define pp_list		Perl_pp_list
+#define pp_listen	Perl_pp_listen
+#define pp_localtime	Perl_pp_localtime
+#define pp_log		Perl_pp_log
+#define pp_lslice	Perl_pp_lslice
+#define pp_lstat	Perl_pp_lstat
+#define pp_lt		Perl_pp_lt
+#define pp_map		Perl_pp_map
+#define pp_mapstart	Perl_pp_mapstart
+#define pp_mapwhile	Perl_pp_mapwhile
+#define pp_match	Perl_pp_match
+#define pp_method	Perl_pp_method
+#define pp_mkdir	Perl_pp_mkdir
+#define pp_modulo	Perl_pp_modulo
+#define pp_msgctl	Perl_pp_msgctl
+#define pp_msgget	Perl_pp_msgget
+#define pp_msgrcv	Perl_pp_msgrcv
+#define pp_msgsnd	Perl_pp_msgsnd
+#define pp_multiply	Perl_pp_multiply
+#define pp_ncmp		Perl_pp_ncmp
+#define pp_ne		Perl_pp_ne
+#define pp_negate	Perl_pp_negate
+#define pp_next		Perl_pp_next
+#define pp_nextstate	Perl_pp_nextstate
+#define pp_not		Perl_pp_not
+#define pp_nswitch	Perl_pp_nswitch
+#define pp_null		Perl_pp_null
+#define pp_oct		Perl_pp_oct
+#define pp_open		Perl_pp_open
+#define pp_open_dir	Perl_pp_open_dir
+#define pp_or		Perl_pp_or
+#define pp_orassign	Perl_pp_orassign
+#define pp_ord		Perl_pp_ord
+#define pp_pack		Perl_pp_pack
+#define pp_padany	Perl_pp_padany
+#define pp_padav	Perl_pp_padav
+#define pp_padhv	Perl_pp_padhv
+#define pp_padsv	Perl_pp_padsv
+#define pp_pipe_op	Perl_pp_pipe_op
+#define pp_pop		Perl_pp_pop
+#define pp_pos		Perl_pp_pos
+#define pp_postdec	Perl_pp_postdec
+#define pp_postinc	Perl_pp_postinc
+#define pp_pow		Perl_pp_pow
+#define pp_predec	Perl_pp_predec
+#define pp_preinc	Perl_pp_preinc
+#define pp_print	Perl_pp_print
+#define pp_prototype	Perl_pp_prototype
+#define pp_prtf		Perl_pp_prtf
+#define pp_push		Perl_pp_push
+#define pp_pushmark	Perl_pp_pushmark
+#define pp_pushre	Perl_pp_pushre
+#define pp_quotemeta	Perl_pp_quotemeta
+#define pp_rand		Perl_pp_rand
+#define pp_range	Perl_pp_range
+#define pp_rcatline	Perl_pp_rcatline
+#define pp_read		Perl_pp_read
+#define pp_readdir	Perl_pp_readdir
+#define pp_readline	Perl_pp_readline
+#define pp_readlink	Perl_pp_readlink
+#define pp_recv		Perl_pp_recv
+#define pp_redo		Perl_pp_redo
+#define pp_ref		Perl_pp_ref
+#define pp_refgen	Perl_pp_refgen
+#define pp_regcmaybe	Perl_pp_regcmaybe
+#define pp_regcomp	Perl_pp_regcomp
+#define pp_rename	Perl_pp_rename
+#define pp_repeat	Perl_pp_repeat
+#define pp_require	Perl_pp_require
+#define pp_reset	Perl_pp_reset
+#define pp_return	Perl_pp_return
+#define pp_reverse	Perl_pp_reverse
+#define pp_rewinddir	Perl_pp_rewinddir
+#define pp_right_shift	Perl_pp_right_shift
+#define pp_rindex	Perl_pp_rindex
+#define pp_rmdir	Perl_pp_rmdir
+#define pp_rv2av	Perl_pp_rv2av
+#define pp_rv2cv	Perl_pp_rv2cv
+#define pp_rv2gv	Perl_pp_rv2gv
+#define pp_rv2hv	Perl_pp_rv2hv
+#define pp_rv2sv	Perl_pp_rv2sv
+#define pp_sassign	Perl_pp_sassign
+#define pp_scalar	Perl_pp_scalar
+#define pp_schomp	Perl_pp_schomp
+#define pp_schop	Perl_pp_schop
+#define pp_scmp		Perl_pp_scmp
+#define pp_scope	Perl_pp_scope
+#define pp_seek		Perl_pp_seek
+#define pp_seekdir	Perl_pp_seekdir
+#define pp_select	Perl_pp_select
+#define pp_semctl	Perl_pp_semctl
+#define pp_semget	Perl_pp_semget
+#define pp_semop	Perl_pp_semop
+#define pp_send		Perl_pp_send
+#define pp_seq		Perl_pp_seq
+#define pp_setpgrp	Perl_pp_setpgrp
+#define pp_setpriority	Perl_pp_setpriority
+#define pp_sge		Perl_pp_sge
+#define pp_sgrent	Perl_pp_sgrent
+#define pp_sgt		Perl_pp_sgt
+#define pp_shift	Perl_pp_shift
+#define pp_shmctl	Perl_pp_shmctl
+#define pp_shmget	Perl_pp_shmget
+#define pp_shmread	Perl_pp_shmread
+#define pp_shmwrite	Perl_pp_shmwrite
+#define pp_shostent	Perl_pp_shostent
+#define pp_shutdown	Perl_pp_shutdown
+#define pp_sin		Perl_pp_sin
+#define pp_sle		Perl_pp_sle
+#define pp_sleep	Perl_pp_sleep
+#define pp_slt		Perl_pp_slt
+#define pp_sne		Perl_pp_sne
+#define pp_snetent	Perl_pp_snetent
+#define pp_socket	Perl_pp_socket
+#define pp_sockpair	Perl_pp_sockpair
+#define pp_sort		Perl_pp_sort
+#define pp_splice	Perl_pp_splice
+#define pp_split	Perl_pp_split
+#define pp_sprintf	Perl_pp_sprintf
+#define pp_sprotoent	Perl_pp_sprotoent
+#define pp_spwent	Perl_pp_spwent
+#define pp_sqrt		Perl_pp_sqrt
+#define pp_srand	Perl_pp_srand
+#define pp_srefgen	Perl_pp_srefgen
+#define pp_sselect	Perl_pp_sselect
+#define pp_sservent	Perl_pp_sservent
+#define pp_ssockopt	Perl_pp_ssockopt
+#define pp_stat		Perl_pp_stat
+#define pp_stringify	Perl_pp_stringify
+#define pp_stub		Perl_pp_stub
+#define pp_study	Perl_pp_study
+#define pp_subst	Perl_pp_subst
+#define pp_substcont	Perl_pp_substcont
+#define pp_substr	Perl_pp_substr
+#define pp_subtract	Perl_pp_subtract
+#define pp_symlink	Perl_pp_symlink
+#define pp_syscall	Perl_pp_syscall
+#define pp_sysopen	Perl_pp_sysopen
+#define pp_sysread	Perl_pp_sysread
+#define pp_system	Perl_pp_system
+#define pp_syswrite	Perl_pp_syswrite
+#define pp_tell		Perl_pp_tell
+#define pp_telldir	Perl_pp_telldir
+#define pp_tie		Perl_pp_tie
+#define pp_tied		Perl_pp_tied
+#define pp_time		Perl_pp_time
+#define pp_tms		Perl_pp_tms
+#define pp_trans	Perl_pp_trans
+#define pp_truncate	Perl_pp_truncate
+#define pp_uc		Perl_pp_uc
+#define pp_ucfirst	Perl_pp_ucfirst
+#define pp_umask	Perl_pp_umask
+#define pp_undef	Perl_pp_undef
+#define pp_unlink	Perl_pp_unlink
+#define pp_unpack	Perl_pp_unpack
+#define pp_unshift	Perl_pp_unshift
+#define pp_unstack	Perl_pp_unstack
+#define pp_untie	Perl_pp_untie
+#define pp_utime	Perl_pp_utime
+#define pp_values	Perl_pp_values
+#define pp_vec		Perl_pp_vec
+#define pp_wait		Perl_pp_wait
+#define pp_waitpid	Perl_pp_waitpid
+#define pp_wantarray	Perl_pp_wantarray
+#define pp_warn		Perl_pp_warn
+#define pp_xor		Perl_pp_xor
+#define pregcomp	Perl_pregcomp
+#define pregexec	Perl_pregexec
+#define pregfree	Perl_pregfree
+#define prepend_elem	Perl_prepend_elem
+#define push_return	Perl_push_return
+#define push_scope	Perl_push_scope
+#define q		Perl_q
+#define ref		Perl_ref
+#define refkids		Perl_refkids
+#define regdump		Perl_regdump
+#define regnext		Perl_regnext
+#define regprop		Perl_regprop
+#define repeatcpy	Perl_repeatcpy
+#define rninstr		Perl_rninstr
+#define runops		Perl_runops
+#define same_dirent	Perl_same_dirent
+#define save_I32	Perl_save_I32
+#define save_aptr	Perl_save_aptr
+#define save_ary	Perl_save_ary
+#define save_clearsv	Perl_save_clearsv
+#define save_delete	Perl_save_delete
+#define save_destructor	Perl_save_destructor
+#define save_freeop	Perl_save_freeop
+#define save_freepv	Perl_save_freepv
+#define save_freesv	Perl_save_freesv
+#define save_hash	Perl_save_hash
+#define save_hptr	Perl_save_hptr
+#define save_int	Perl_save_int
+#define save_item	Perl_save_item
+#define save_list	Perl_save_list
+#define save_long	Perl_save_long
+#define save_nogv	Perl_save_nogv
+#define save_pptr	Perl_save_pptr
+#define save_scalar	Perl_save_scalar
+#define save_sptr	Perl_save_sptr
+#define save_svref	Perl_save_svref
+#define savepv		Perl_savepv
+#define savepvn		Perl_savepvn
+#define savestack_grow	Perl_savestack_grow
+#define sawparens	Perl_sawparens
+#define scalar		Perl_scalar
+#define scalarkids	Perl_scalarkids
+#define scalarseq	Perl_scalarseq
+#define scalarvoid	Perl_scalarvoid
+#define scan_const	Perl_scan_const
+#define scan_formline	Perl_scan_formline
+#define scan_heredoc	Perl_scan_heredoc
+#define scan_hex	Perl_scan_hex
+#define scan_ident	Perl_scan_ident
+#define scan_inputsymbol	Perl_scan_inputsymbol
+#define scan_num	Perl_scan_num
+#define scan_oct	Perl_scan_oct
+#define scan_pat	Perl_scan_pat
+#define scan_prefix	Perl_scan_prefix
+#define scan_str	Perl_scan_str
+#define scan_subst	Perl_scan_subst
+#define scan_trans	Perl_scan_trans
+#define scan_word	Perl_scan_word
+#define scope		Perl_scope
+#define screaminstr	Perl_screaminstr
+#define setdefout	Perl_setdefout
+#define setenv_getix	Perl_setenv_getix
+#define sighandler	Perl_sighandler
+#define skipspace	Perl_skipspace
+#define stack_grow	Perl_stack_grow
+#define start_subparse	Perl_start_subparse
+#define sublex_done	Perl_sublex_done
+#define sublex_start	Perl_sublex_start
+#define sv_2bool	Perl_sv_2bool
+#define sv_2cv		Perl_sv_2cv
+#define sv_2io		Perl_sv_2io
+#define sv_2iv		Perl_sv_2iv
+#define sv_2mortal	Perl_sv_2mortal
+#define sv_2nv		Perl_sv_2nv
+#define sv_2pv		Perl_sv_2pv
+#define sv_add_arena	Perl_sv_add_arena
+#define sv_backoff	Perl_sv_backoff
+#define sv_bless	Perl_sv_bless
+#define sv_catpv	Perl_sv_catpv
+#define sv_catpvn	Perl_sv_catpvn
+#define sv_catsv	Perl_sv_catsv
+#define sv_chop		Perl_sv_chop
+#define sv_clean_all	Perl_sv_clean_all
+#define sv_clean_objs	Perl_sv_clean_objs
+#define sv_clear	Perl_sv_clear
+#define sv_cmp		Perl_sv_cmp
+#define sv_dec		Perl_sv_dec
+#define sv_dump		Perl_sv_dump
+#define sv_eq		Perl_sv_eq
+#define sv_free		Perl_sv_free
+#define sv_free_arenas	Perl_sv_free_arenas
+#define sv_gets		Perl_sv_gets
+#define sv_grow		Perl_sv_grow
+#define sv_inc		Perl_sv_inc
+#define sv_insert	Perl_sv_insert
+#define sv_isa		Perl_sv_isa
+#define sv_isobject	Perl_sv_isobject
+#define sv_len		Perl_sv_len
+#define sv_magic	Perl_sv_magic
+#define sv_mortalcopy	Perl_sv_mortalcopy
+#define sv_newmortal	Perl_sv_newmortal
+#define sv_newref	Perl_sv_newref
+#define sv_peek		Perl_sv_peek
+#define sv_pvn_force	Perl_sv_pvn_force
+#define sv_ref		Perl_sv_ref
+#define sv_reftype	Perl_sv_reftype
+#define sv_replace	Perl_sv_replace
+#define sv_report_used	Perl_sv_report_used
+#define sv_reset	Perl_sv_reset
+#define sv_setiv	Perl_sv_setiv
+#define sv_setnv	Perl_sv_setnv
+#define sv_setptrobj	Perl_sv_setptrobj
+#define sv_setpv	Perl_sv_setpv
+#define sv_setpvn	Perl_sv_setpvn
+#define sv_setref_iv	Perl_sv_setref_iv
+#define sv_setref_nv	Perl_sv_setref_nv
+#define sv_setref_pv	Perl_sv_setref_pv
+#define sv_setref_pvn	Perl_sv_setref_pvn
+#define sv_setsv	Perl_sv_setsv
+#define sv_unmagic	Perl_sv_unmagic
+#define sv_unref	Perl_sv_unref
+#define sv_upgrade	Perl_sv_upgrade
+#define sv_usepvn	Perl_sv_usepvn
+#define taint_env	Perl_taint_env
+#define taint_not	Perl_taint_not
+#define taint_proper	Perl_taint_proper
+#define too_few_arguments	Perl_too_few_arguments
+#define too_many_arguments	Perl_too_many_arguments
+#define unlnk		Perl_unlnk
+#define utilize		Perl_utilize
+#define wait4pid	Perl_wait4pid
+#define warn		Perl_warn
+#define watch		Perl_watch
+#define whichsig	Perl_whichsig
+#define xiv_arenaroot	Perl_xiv_arenaroot
+#define xiv_root	Perl_xiv_root
+#define xnv_root	Perl_xnv_root
+#define xpv_root	Perl_xpv_root
+#define xrv_root	Perl_xrv_root
+#define yyerror		Perl_yyerror
+#define yylex		Perl_yylex
+#define yyparse		Perl_yyparse
+#define yywarn		Perl_yywarn
+
+#endif /* EMBED */
+
+/* Put interpreter specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+#define Argv		(curinterp->IArgv)
+#define Cmd		(curinterp->ICmd)
+#define DBgv		(curinterp->IDBgv)
+#define DBline		(curinterp->IDBline)
+#define DBsignal	(curinterp->IDBsignal)
+#define DBsingle	(curinterp->IDBsingle)
+#define DBsub		(curinterp->IDBsub)
+#define DBtrace		(curinterp->IDBtrace)
+#define allgvs		(curinterp->Iallgvs)
+#define ampergv		(curinterp->Iampergv)
+#define argvgv		(curinterp->Iargvgv)
+#define argvoutgv	(curinterp->Iargvoutgv)
+#define basetime	(curinterp->Ibasetime)
+#define beginav		(curinterp->Ibeginav)
+#define bodytarget	(curinterp->Ibodytarget)
+#define cddir		(curinterp->Icddir)
+#define chopset		(curinterp->Ichopset)
+#define copline		(curinterp->Icopline)
+#define curblock	(curinterp->Icurblock)
+#define curcop		(curinterp->Icurcop)
+#define curcsv		(curinterp->Icurcsv)
+#define curpm		(curinterp->Icurpm)
+#define curstash	(curinterp->Icurstash)
+#define curstname	(curinterp->Icurstname)
+#define cxstack		(curinterp->Icxstack)
+#define cxstack_ix	(curinterp->Icxstack_ix)
+#define cxstack_max	(curinterp->Icxstack_max)
+#define dbargs		(curinterp->Idbargs)
+#define debdelim	(curinterp->Idebdelim)
+#define debname		(curinterp->Idebname)
+#define debstash	(curinterp->Idebstash)
+#define debug		(curinterp->Idebug)
+#define defgv		(curinterp->Idefgv)
+#define defoutgv	(curinterp->Idefoutgv)
+#define defstash	(curinterp->Idefstash)
+#define delaymagic	(curinterp->Idelaymagic)
+#define diehook		(curinterp->Idiehook)
+#define dirty		(curinterp->Idirty)
+#define dlevel		(curinterp->Idlevel)
+#define dlmax		(curinterp->Idlmax)
+#define do_undump	(curinterp->Ido_undump)
+#define doextract	(curinterp->Idoextract)
+#define doswitches	(curinterp->Idoswitches)
+#define dowarn		(curinterp->Idowarn)
+#define dumplvl		(curinterp->Idumplvl)
+#define e_fp		(curinterp->Ie_fp)
+#define e_tmpname	(curinterp->Ie_tmpname)
+#define endav		(curinterp->Iendav)
+#define envgv		(curinterp->Ienvgv)
+#define errgv		(curinterp->Ierrgv)
+#define eval_root	(curinterp->Ieval_root)
+#define eval_start	(curinterp->Ieval_start)
+#define fdpid		(curinterp->Ifdpid)
+#define filemode	(curinterp->Ifilemode)
+#define firstgv		(curinterp->Ifirstgv)
+#define forkprocess	(curinterp->Iforkprocess)
+#define formfeed	(curinterp->Iformfeed)
+#define formtarget	(curinterp->Iformtarget)
+#define gensym		(curinterp->Igensym)
+#define in_eval		(curinterp->Iin_eval)
+#define incgv		(curinterp->Iincgv)
+#define inplace		(curinterp->Iinplace)
+#define last_in_gv	(curinterp->Ilast_in_gv)
+#define lastfd		(curinterp->Ilastfd)
+#define lastretstr	(curinterp->Ilastretstr)
+#define lastscream	(curinterp->Ilastscream)
+#define lastsize	(curinterp->Ilastsize)
+#define lastspbase	(curinterp->Ilastspbase)
+#define laststatval	(curinterp->Ilaststatval)
+#define laststype	(curinterp->Ilaststype)
+#define leftgv		(curinterp->Ileftgv)
+#define lineary		(curinterp->Ilineary)
+#define localizing	(curinterp->Ilocalizing)
+#define main_cv		(curinterp->Imain_cv)
+#define main_root	(curinterp->Imain_root)
+#define main_start	(curinterp->Imain_start)
+#define mainstack	(curinterp->Imainstack)
+#define maxscream	(curinterp->Imaxscream)
+#define maxsysfd	(curinterp->Imaxsysfd)
+#define minus_F		(curinterp->Iminus_F)
+#define minus_a		(curinterp->Iminus_a)
+#define minus_c		(curinterp->Iminus_c)
+#define minus_l		(curinterp->Iminus_l)
+#define minus_n		(curinterp->Iminus_n)
+#define minus_p		(curinterp->Iminus_p)
+#define multiline	(curinterp->Imultiline)
+#define mystack_base	(curinterp->Imystack_base)
+#define mystack_mark	(curinterp->Imystack_mark)
+#define mystack_max	(curinterp->Imystack_max)
+#define mystack_sp	(curinterp->Imystack_sp)
+#define mystrk		(curinterp->Imystrk)
+#define nrs		(curinterp->Inrs)
+#define ofmt		(curinterp->Iofmt)
+#define ofs		(curinterp->Iofs)
+#define ofslen		(curinterp->Iofslen)
+#define oldlastpm	(curinterp->Ioldlastpm)
+#define oldname		(curinterp->Ioldname)
+#define op_mask		(curinterp->Iop_mask)
+#define origargc	(curinterp->Iorigargc)
+#define origargv	(curinterp->Iorigargv)
+#define origfilename	(curinterp->Iorigfilename)
+#define ors		(curinterp->Iors)
+#define orslen		(curinterp->Iorslen)
+#define pad		(curinterp->Ipad)
+#define padname		(curinterp->Ipadname)
+#define parsehook	(curinterp->Iparsehook)
+#define patchlevel	(curinterp->Ipatchlevel)
+#define perldb		(curinterp->Iperldb)
+#define perl_destruct_level	(curinterp->Iperl_destruct_level)
+#define pidstatus	(curinterp->Ipidstatus)
+#define preambled	(curinterp->Ipreambled)
+#define preambleav	(curinterp->Ipreambleav)
+#define preprocess	(curinterp->Ipreprocess)
+#define restartop	(curinterp->Irestartop)
+#define rightgv		(curinterp->Irightgv)
+#define rs		(curinterp->Irs)
+#define runlevel	(curinterp->Irunlevel)
+#define sawampersand	(curinterp->Isawampersand)
+#define sawi		(curinterp->Isawi)
+#define sawstudy	(curinterp->Isawstudy)
+#define sawvec		(curinterp->Isawvec)
+#define screamfirst	(curinterp->Iscreamfirst)
+#define screamnext	(curinterp->Iscreamnext)
+#define secondgv	(curinterp->Isecondgv)
+#define siggv		(curinterp->Isiggv)
+#define signalstack	(curinterp->Isignalstack)
+#define sortcop		(curinterp->Isortcop)
+#define sortstack	(curinterp->Isortstack)
+#define sortstash	(curinterp->Isortstash)
+#define splitstr	(curinterp->Isplitstr)
+#define stack		(curinterp->Istack)
+#define statcache	(curinterp->Istatcache)
+#define statgv		(curinterp->Istatgv)
+#define statname	(curinterp->Istatname)
+#define statusvalue	(curinterp->Istatusvalue)
+#define stdingv		(curinterp->Istdingv)
+#define strchop		(curinterp->Istrchop)
+#define sv_count	(curinterp->Isv_count)
+#define sv_objcount	(curinterp->Isv_objcount)
+#define sv_root		(curinterp->Isv_root)
+#define sv_arenaroot	(curinterp->Isv_arenaroot)
+#define tainted		(curinterp->Itainted)
+#define tainting	(curinterp->Itainting)
+#define tmps_floor	(curinterp->Itmps_floor)
+#define tmps_ix		(curinterp->Itmps_ix)
+#define tmps_max	(curinterp->Itmps_max)
+#define tmps_stack	(curinterp->Itmps_stack)
+#define top_env		(curinterp->Itop_env)
+#define toptarget	(curinterp->Itoptarget)
+#define unsafe		(curinterp->Iunsafe)
+#define warnhook	(curinterp->Iwarnhook)
+
+#else	/* not multiple, so translate interpreter symbols the other way... */
+
+#define IArgv		Argv
+#define ICmd		Cmd
+#define IDBgv		DBgv
+#define IDBline		DBline
+#define IDBsignal	DBsignal
+#define IDBsingle	DBsingle
+#define IDBsub		DBsub
+#define IDBtrace	DBtrace
+#define Iallgvs		allgvs
+#define Iampergv	ampergv
+#define Iargvgv		argvgv
+#define Iargvoutgv	argvoutgv
+#define Ibasetime	basetime
+#define Ibeginav	beginav
+#define Ibodytarget	bodytarget
+#define Icddir		cddir
+#define Ichopset	chopset
+#define Icopline	copline
+#define Icurblock	curblock
+#define Icurcop		curcop
+#define Icurcsv		curcsv
+#define Icurpm		curpm
+#define Icurstash	curstash
+#define Icurstname	curstname
+#define Icxstack	cxstack
+#define Icxstack_ix	cxstack_ix
+#define Icxstack_max	cxstack_max
+#define Idbargs		dbargs
+#define Idebdelim	debdelim
+#define Idebname	debname
+#define Idebstash	debstash
+#define Idebug		debug
+#define Idefgv		defgv
+#define Idefoutgv	defoutgv
+#define Idefstash	defstash
+#define Idelaymagic	delaymagic
+#define Idiehook	diehook
+#define Idirty		dirty
+#define Idlevel		dlevel
+#define Idlmax		dlmax
+#define Ido_undump	do_undump
+#define Idoextract	doextract
+#define Idoswitches	doswitches
+#define Idowarn		dowarn
+#define Idumplvl	dumplvl
+#define Ie_fp		e_fp
+#define Ie_tmpname	e_tmpname
+#define Iendav		endav
+#define Ienvgv		envgv
+#define Ierrgv		errgv
+#define Ieval_root	eval_root
+#define Ieval_start	eval_start
+#define Ifdpid		fdpid
+#define Ifilemode	filemode
+#define Ifirstgv	firstgv
+#define Iforkprocess	forkprocess
+#define Iformfeed	formfeed
+#define Iformtarget	formtarget
+#define Igensym		gensym
+#define Iin_eval	in_eval
+#define Iincgv		incgv
+#define Iinplace	inplace
+#define Ilast_in_gv	last_in_gv
+#define Ilastfd		lastfd
+#define Ilastretstr	lastretstr
+#define Ilastscream	lastscream
+#define Ilastsize	lastsize
+#define Ilastspbase	lastspbase
+#define Ilaststatval	laststatval
+#define Ilaststype	laststype
+#define Ileftgv		leftgv
+#define Ilineary	lineary
+#define Ilocalizing	localizing
+#define Imain_cv	main_cv
+#define Imain_root	main_root
+#define Imain_start	main_start
+#define Imainstack	mainstack
+#define Imaxscream	maxscream
+#define Imaxsysfd	maxsysfd
+#define Iminus_F	minus_F
+#define Iminus_a	minus_a
+#define Iminus_c	minus_c
+#define Iminus_l	minus_l
+#define Iminus_n	minus_n
+#define Iminus_p	minus_p
+#define Imultiline	multiline
+#define Imystack_base	mystack_base
+#define Imystack_mark	mystack_mark
+#define Imystack_max	mystack_max
+#define Imystack_sp	mystack_sp
+#define Imystrk		mystrk
+#define Inrs		nrs
+#define Iofmt		ofmt
+#define Iofs		ofs
+#define Iofslen		ofslen
+#define Ioldlastpm	oldlastpm
+#define Ioldname	oldname
+#define Iop_mask	op_mask
+#define Iorigargc	origargc
+#define Iorigargv	origargv
+#define Iorigfilename	origfilename
+#define Iors		ors
+#define Iorslen		orslen
+#define Ipad		pad
+#define Ipadname	padname
+#define Iparsehook	parsehook
+#define Ipatchlevel	patchlevel
+#define Iperldb		perldb
+#define Iperl_destruct_level	perl_destruct_level
+#define Ipidstatus	pidstatus
+#define Ipreambled	preambled
+#define Ipreambleav	preambleav
+#define Ipreprocess	preprocess
+#define Irestartop	restartop
+#define Irightgv	rightgv
+#define Irs		rs
+#define Irunlevel	runlevel
+#define Isawampersand	sawampersand
+#define Isawi		sawi
+#define Isawstudy	sawstudy
+#define Isawvec		sawvec
+#define Iscreamfirst	screamfirst
+#define Iscreamnext	screamnext
+#define Isecondgv	secondgv
+#define Isiggv		siggv
+#define Isignalstack	signalstack
+#define Isortcop	sortcop
+#define Isortstack	sortstack
+#define Isortstash	sortstash
+#define Isplitstr	splitstr
+#define Istack		stack
+#define Istatcache	statcache
+#define Istatgv		statgv
+#define Istatname	statname
+#define Istatusvalue	statusvalue
+#define Istdingv	stdingv
+#define Istrchop	strchop
+#define Isv_count	sv_count
+#define Isv_objcount	sv_objcount
+#define Isv_root	sv_root
+#define Isv_arenaroot	sv_arenaroot
+#define Itainted	tainted
+#define Itainting	tainting
+#define Itmps_floor	tmps_floor
+#define Itmps_ix	tmps_ix
+#define Itmps_max	tmps_max
+#define Itmps_stack	tmps_stack
+#define Itop_env	top_env
+#define Itoptarget	toptarget
+#define Iunsafe		unsafe
+#define Iwarnhook	warnhook
+
+#endif /* MULTIPLICITY */
diff --git a/gnu/usr.bin/perl/embed.pl b/gnu/usr.bin/perl/embed.pl
new file mode 100644
index 00000000000..e5423dde3cc
--- /dev/null
+++ b/gnu/usr.bin/perl/embed.pl
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+
+open(EM, ">embed.h") || die "Can't create embed.h: $!\n";
+
+print EM <<'END';
+/* This file is derived from global.sym and interp.sym */
+
+/* (Doing namespace management portably in C is really gross.) */
+
+/*  EMBED has no run-time penalty, but helps keep the Perl namespace
+    from colliding with that used by other libraries pulled in
+    by extensions or by embedding perl.  Allow a cc -DNO_EMBED
+    override, however, to keep binary compatability with previous
+    versions of perl.
+*/
+#ifndef NO_EMBED
+#  define EMBED 1 
+#endif
+
+#ifdef EMBED
+
+/* globals we need to hide from the world */
+END
+
+open(GL, "<global.sym") || die "Can't open global.sym: $!\n";
+
+while(<GL>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	next unless /\S/;
+	s/(.*)/#define $1\t\tPerl_$1/;
+	s/(................\t)\t/$1/;
+	print EM $_;
+}
+
+close(GL) || warn "Can't close global.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* EMBED */
+
+/* Put interpreter specific symbols into a struct? */
+
+#ifdef MULTIPLICITY
+
+END
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	next unless /\S/;
+	s/(.*)/#define $1\t\t(curinterp->I$1)/;
+	s/(................\t)\t/$1/;
+	print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#else	/* not multiple, so translate interpreter symbols the other way... */
+
+END
+
+open(INT, "<interp.sym") || die "Can't open interp.sym: $!\n";
+while (<INT>) {
+	s/[ \t]*#.*//;		# Delete comments.
+	next unless /\S/;
+	s/(.*)/#define I$1\t\t$1/;
+	s/(................\t)\t/$1/;
+	print EM $_;
+}
+close(INT) || warn "Can't close interp.sym: $!\n";
+
+print EM <<'END';
+
+#endif /* MULTIPLICITY */
+END
+
diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.pm b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm
new file mode 100644
index 00000000000..61ac26aafed
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.pm
@@ -0,0 +1,673 @@
+# DB_File.pm -- Perl 5 interface to Berkeley DB 
+#
+# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+# last modified 14th November 1995
+# version 1.01
+
+package DB_File::HASHINFO ;
+
+use strict;
+use vars qw(%elements);
+use Carp;
+
+sub TIEHASH
+{
+    bless {} ;
+}
+
+%elements = ( 'bsize'     => 0,
+              'ffactor'   => 0,
+              'nelem'     => 0,
+              'cachesize' => 0,
+              'hash'      => 0,
+              'lorder'    => 0
+            ) ;
+
+sub FETCH 
+{  
+    return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
+
+    croak "DB_File::HASHINFO::FETCH - Unknown element '$_[1]'" ;
+}
+
+
+sub STORE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        $_[0]{$_[1]} = $_[2] ;
+        return ;
+    }
+    
+    croak "DB_File::HASHINFO::STORE - Unknown element '$_[1]'" ;
+}
+
+sub DELETE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        delete ${$_[0]}{$_[1]} ;
+        return ;
+    }
+    
+    croak "DB_File::HASHINFO::DELETE - Unknown element '$_[1]'" ;
+}
+
+
+sub DESTROY {undef %{$_[0]} }
+sub FIRSTKEY { croak "DB_File::HASHINFO::FIRSTKEY is not implemented" }
+sub NEXTKEY { croak "DB_File::HASHINFO::NEXTKEY is not implemented" }
+sub EXISTS { croak "DB_File::HASHINFO::EXISTS is not implemented" }
+sub CLEAR { croak "DB_File::HASHINFO::CLEAR is not implemented" }
+
+package DB_File::BTREEINFO ;
+
+use strict;
+use vars qw(%elements);
+use Carp;
+
+sub TIEHASH
+{
+    bless {} ;
+}
+
+%elements = ( 'flags'	=> 0,
+              'cachesize'  => 0,
+              'maxkeypage' => 0,
+              'minkeypage' => 0,
+              'psize'      => 0,
+              'compare'    => 0,
+              'prefix'     => 0,
+              'lorder'     => 0
+            ) ;
+
+sub FETCH 
+{  
+    return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
+
+    croak "DB_File::BTREEINFO::FETCH - Unknown element '$_[1]'" ;
+}
+
+
+sub STORE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        $_[0]{$_[1]} = $_[2] ;
+        return ;
+    }
+    
+    croak "DB_File::BTREEINFO::STORE - Unknown element '$_[1]'" ;
+}
+
+sub DELETE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        delete ${$_[0]}{$_[1]} ;
+        return ;
+    }
+    
+    croak "DB_File::BTREEINFO::DELETE - Unknown element '$_[1]'" ;
+}
+
+
+sub DESTROY {undef %{$_[0]} }
+sub FIRSTKEY { croak "DB_File::BTREEINFO::FIRSTKEY is not implemented" }
+sub NEXTKEY { croak "DB_File::BTREEINFO::NEXTKEY is not implemented" }
+sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" }
+sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" }
+
+package DB_File::RECNOINFO ;
+
+use strict;
+use vars qw(%elements);
+use Carp;
+
+sub TIEHASH
+{
+    bless {} ;
+}
+
+%elements = ( 'bval'      => 0,
+              'cachesize' => 0,
+              'psize'     => 0,
+              'flags'     => 0,
+              'lorder'    => 0,
+              'reclen'    => 0,
+              'bfname'    => 0
+            ) ;
+sub FETCH 
+{  
+    return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
+
+    croak "DB_File::RECNOINFO::FETCH - Unknown element '$_[1]'" ;
+}
+
+
+sub STORE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        $_[0]{$_[1]} = $_[2] ;
+        return ;
+    }
+    
+    croak "DB_File::RECNOINFO::STORE - Unknown element '$_[1]'" ;
+}
+
+sub DELETE 
+{
+    if ( defined $elements{$_[1]} )
+    {
+        delete ${$_[0]}{$_[1]} ;
+        return ;
+    }
+    
+    croak "DB_File::RECNOINFO::DELETE - Unknown element '$_[1]'" ;
+}
+
+
+sub DESTROY {undef %{$_[0]} }
+sub FIRSTKEY { croak "DB_File::RECNOINFO::FIRSTKEY is not implemented" }
+sub NEXTKEY { croak "DB_File::RECNOINFO::NEXTKEY is not implemented" }
+sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" }
+sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" }
+
+
+
+package DB_File ;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ;
+use Carp;
+
+
+$VERSION = "1.01" ;
+
+#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
+$DB_BTREE = TIEHASH DB_File::BTREEINFO ;
+$DB_HASH  = TIEHASH DB_File::HASHINFO ;
+$DB_RECNO = TIEHASH 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;
+}
+
+bootstrap DB_File $VERSION;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+1;
+__END__
+
+=cut
+
+=head1 NAME
+
+DB_File - Perl5 access to Berkeley DB
+
+=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 ;
+    
+ 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.  If you intend to use this
+module you should really have a copy of the Berkeley DB manualpage at
+hand. 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 DB_HASH
+
+This database type allows arbitrary key/data 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 DB_BTREE
+
+The btree format allows arbitrary key/data 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 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 How does DB_File 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 use most of
+the functions provided in the Berkeley DB API.
+
+=head2 Differences with Berkeley DB
+
+Berkeley DB uses the function dbopen() to open or create a database.
+Below 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 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 ;
+
+
+=head2 RECNO
+
+
+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.
+
+
+=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.
+
+
+=head2 Using the Berkeley DB Interface Directly
+
+As well as accessing Berkeley DB using a tied hash or array, it is also
+possible to make direct use of most of the functions defined in the
+Berkeley DB documentation.
+
+
+To do this you need to remember the return value from the tie.
+
+	$db = tie %hash, DB_File, "filename"
+
+Once you have done that, you can access the Berkeley DB API functions
+directly.
+
+	$db->put($key, $value, R_NOOVERWRITE) ;
+
+All the functions defined in L<dbx(3X)> are available except for
+close() and dbopen() itself. The B<DB_File> interface to these
+functions have been implemented to mirror the the way Berkeley DB
+works. In particular note that all the functions return only a status
+value. Whenever a Berkeley DB function returns data via one of its
+parameters, the B<DB_File> equivalent does exactly the same.
+
+All the constants defined in L<dbopen> are also available.
+
+Below is a list of the functions available.
+
+=over 5
+
+=item get
+
+Same as in C<recno> except that the flags parameter is optional.
+Remember the value associated with the key you request is returned in
+the $value parameter.
+
+=item put
+
+As usual the flags parameter is optional. 
+
+If you use either the R_IAFTER or R_IBEFORE flags, the key parameter
+will have the record number of the inserted key/value pair set.
+
+=item del
+
+The flags parameter is optional.
+
+=item fd
+
+As in I<recno>.
+
+=item seq
+
+The flags parameter is optional.
+
+Both the key and value parameters will be set.
+
+=item sync
+
+The flags parameter is optional.
+
+=back
+
+=head1 EXAMPLES
+
+It is always a lot easier to understand something when you see a real
+example. So here are a few.
+
+=head2 Using HASH
+
+	use DB_File ;
+	use Fcntl ;
+	
+	tie %h,  "DB_File", "hashed", O_RDWR|O_CREAT, 0640, $DB_HASH ;
+	
+	# Add a key/value pair to the file
+	$h{"apple"} = "orange" ;
+	
+	# Check for existence of a key
+	print "Exists\n" if $h{"banana"} ;
+	
+	# Delete 
+	delete $h{"apple"} ;
+	
+	untie %h ;
+
+=head2 Using BTREE
+
+Here is sample of code which used BTREE. Just to make life more
+interesting the default comparision function will not be used. Instead
+a Perl sub, C<Compare()>, will be used to do a case insensitive
+comparison.
+
+        use DB_File ;
+        use Fcntl ;
+	 
+	sub Compare
+        {
+	    my ($key1, $key2) = @_ ;
+	
+	    "\L$key1" cmp "\L$key2" ;
+	}
+	
+        $DB_BTREE->{compare} = 'Compare' ;
+	 
+        tie %h,  'DB_File', "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE ;
+	 
+        # 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
+
+
+=head2 Using RECNO
+
+	use DB_File ;
+	use Fcntl ;
+	
+	$DB_RECNO->{psize} = 3000 ;
+	
+	tie @h,  DB_File, "text", O_RDWR|O_CREAT, 0640, $DB_RECNO ;
+	
+	# Add a key/value pair to the file
+	$h[0] = "orange" ;
+	
+	# Check for existence of a key
+	print "Exists\n" if $h[1] ;
+	
+	untie @h ;
+
+
+=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 Fcntl;
+    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;
+    sleep 10;
+
+    flock(DB_FH, LOCK_UN);
+    untie %db;
+    close(DB_FH);
+    print "$$: Updated db to $key=$value\n";
+
+=head1 HISTORY
+
+=over
+
+=item 0.1
+
+First Release.
+
+=item 0.2
+
+When B<DB_File> is opening a database file it no longer terminates the
+process if I<dbopen> returned an error. This allows file protection
+errors to be caught at run time. Thanks to Judith Grass
+E<lt>grass@cybercash.comE<gt> for spotting the bug.
+
+=item 0.3
+
+Added prototype support for multiple btree compare callbacks.
+
+=item 1.0
+
+B<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 I<push> method on an empty list didn't work properly. This
+has been fixed.
+
+=item 1.01
+
+Fixed a core dump problem with SunOS.
+
+The return value from TIEHASH wasn't set to NULL when dbopen returned
+an error.
+
+=head1 WARNINGS
+
+If you happen find any other functions defined in the source for this
+module that have not been mentioned in this document -- beware.  I may
+drop them at a moments notice.
+
+If you cannot find any, then either you didn't look very hard or the
+moment has passed and I have dropped them.
+
+=head1 BUGS
+
+Some older versions of Berkeley DB had problems with fixed length
+records using the RECNO file format. The newest version at the time of
+writing was 1.85 - this seems to have fixed the problems with RECNO.
+
+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
+
+Berkeley DB is available at your nearest CPAN archive (see
+L<perlmod/"CPAN"> for a list) in F<src/misc/db.1.85.tar.gz>, or via the
+host F<ftp.cs.berkeley.edu> in F</ucb/4bsd/db.tar.gz>.  It is I<not> under
+the GPL.
+
+=head1 SEE ALSO
+
+L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)> 
+
+Berkeley DB is available from F<ftp.cs.berkeley.edu> in the directory
+F</ucb/4bsd>.
+
+=head1 AUTHOR
+
+The DB_File interface was written by Paul Marquess
+<pmarquess@bfsec.bt.co.uk>.
+Questions about the DB system itself may be addressed to Keith Bostic
+<bostic@cs.berkeley.edu>.
+
+=cut
diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File.xs b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs
new file mode 100644
index 00000000000..dd9e03d0d09
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DB_File/DB_File.xs
@@ -0,0 +1,992 @@
+/* 
+
+ DB_File.xs -- Perl 5 interface to Berkeley DB 
+
+ written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+ last modified 14th November 1995
+ version 1.01
+
+ All comments/suggestions/problems are welcome
+
+ 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.
+*/
+
+#include "EXTERN.h"  
+#include "perl.h"
+#include "XSUB.h"
+
+#include <db.h>
+
+#include <fcntl.h> 
+
+typedef struct {
+	DBTYPE	type ;
+	DB * 	dbp ;
+	SV *	compare ;
+	SV *	prefix ;
+	SV *	hash ;
+	} DB_File_type;
+
+typedef DB_File_type * DB_File ;
+typedef DBT DBTKEY ;
+
+union INFO {
+        HASHINFO 	hash ;
+        RECNOINFO 	recno ;
+        BTREEINFO 	btree ;
+      } ;
+
+
+/* #define TRACE  */
+
+#define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
+#define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, &key, flags)
+#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
+#define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, &key, &value, flags)
+
+#define db_close(db)			((db->dbp)->close)(db->dbp)
+#define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
+#define db_fd(db)                       ((db->dbp)->fd)(db->dbp) 
+#define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
+#define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, &key, &value, flags)
+#define db_seq(db, key, value, flags)   ((db->dbp)->seq)(db->dbp, &key, &value, flags)
+#define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
+
+
+#define OutputValue(arg, name)  \
+	{ if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
+
+#define OutputKey(arg, name)	 				\
+	{ if (RETVAL == 0) \
+	  { 							\
+		if (db->type != DB_RECNO) 			\
+		    sv_setpvn(arg, name.data, name.size); 	\
+		else 						\
+		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 	\
+	  } 							\
+	}
+
+/* Internal Global Data */
+static recno_t Value ; 
+static DB_File CurrentDB ;
+static recno_t zero = 0 ;
+static DBTKEY empty = { &zero, sizeof(recno_t) } ;
+
+
+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 %s, 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 %s, 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 = "" ;
+
+    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 %s, got %d\n", count) ;
+
+    retval = POPi ;
+
+    PUTBACK ;
+    FREETMPS ;
+    LEAVE ;
+
+    return (retval) ;
+}
+
+
+#ifdef TRACE
+
+static void
+PrintHash(hash)
+HASHINFO hash ;
+{
+    printf ("HASH Info\n") ;
+    printf ("  hash      = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
+    printf ("  bsize     = %d\n", hash.bsize) ;
+    printf ("  ffactor   = %d\n", hash.ffactor) ;
+    printf ("  nelem     = %d\n", hash.nelem) ;
+    printf ("  cachesize = %d\n", hash.cachesize) ;
+    printf ("  lorder    = %d\n", hash.lorder) ;
+
+}
+
+static void
+PrintRecno(recno)
+RECNOINFO recno ;
+{
+    printf ("RECNO Info\n") ;
+    printf ("  flags     = %d\n", recno.flags) ;
+    printf ("  cachesize = %d\n", recno.cachesize) ;
+    printf ("  psize     = %d\n", recno.psize) ;
+    printf ("  lorder    = %d\n", recno.lorder) ;
+    printf ("  reclen    = %d\n", recno.reclen) ;
+    printf ("  bval      = %d\n", recno.bval) ;
+    printf ("  bfname    = %s\n", recno.bfname) ;
+}
+
+PrintBtree(btree)
+BTREEINFO btree ;
+{
+    printf ("BTREE Info\n") ;
+    printf ("  compare    = %s\n", (btree.compare ? "redefined" : "default")) ;
+    printf ("  prefix     = %s\n", (btree.prefix ? "redefined" : "default")) ;
+    printf ("  flags      = %d\n", btree.flags) ;
+    printf ("  cachesize  = %d\n", btree.cachesize) ;
+    printf ("  psize      = %d\n", btree.psize) ;
+    printf ("  maxkeypage = %d\n", btree.maxkeypage) ;
+    printf ("  minkeypage = %d\n", btree.minkeypage) ;
+    printf ("  lorder     = %d\n", btree.lorder) ;
+}
+
+#else
+
+#define PrintRecno(recno)
+#define PrintHash(hash)
+#define PrintBtree(btree)
+
+#endif /* TRACE */
+
+
+static I32
+GetArrayLength(db)
+DB * db ;
+{
+    DBT		key ;
+    DBT		value ;
+    int		RETVAL ;
+
+    RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
+    if (RETVAL == 0)
+        RETVAL = *(I32 *)key.data ;
+    else if (RETVAL == 1) /* No key means empty file */
+        RETVAL = 0 ;
+
+    return (RETVAL) ;
+}
+
+static DB_File
+ParseOpenInfo(name, flags, mode, sv, string)
+char * name ;
+int    flags ;
+int    mode ;
+SV *   sv ;
+char * string ;
+{
+    SV **	svp;
+    HV *	action ;
+    union INFO	info ;
+    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
+    void *	openinfo = NULL ;
+    /* DBTYPE	type = DB_HASH ; */
+
+    RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
+    RETVAL->type = DB_HASH ;
+
+    if (sv)
+    {
+        if (! SvROK(sv) )
+            croak ("type parameter is not a reference") ;
+
+        action = (HV*)SvRV(sv);
+        if (sv_isa(sv, "DB_File::HASHINFO"))
+        {
+            RETVAL->type = DB_HASH ;
+            openinfo = (void*)&info ;
+  
+            svp = hv_fetch(action, "hash", 4, FALSE); 
+
+            if (svp && SvOK(*svp))
+            {
+                info.hash.hash = hash_cb ;
+		RETVAL->hash = newSVsv(*svp) ;
+            }
+            else
+	        info.hash.hash = NULL ;
+
+           svp = hv_fetch(action, "bsize", 5, FALSE);
+           info.hash.bsize = svp ? SvIV(*svp) : 0;
+           
+           svp = hv_fetch(action, "ffactor", 7, FALSE);
+           info.hash.ffactor = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "nelem", 5, FALSE);
+           info.hash.nelem = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "cachesize", 9, FALSE);
+           info.hash.cachesize = svp ? SvIV(*svp) : 0;
+         
+           svp = hv_fetch(action, "lorder", 6, FALSE);
+           info.hash.lorder = svp ? SvIV(*svp) : 0;
+
+           PrintHash(info) ; 
+        }
+        else if (sv_isa(sv, "DB_File::BTREEINFO"))
+        {
+            RETVAL->type = DB_BTREE ;
+            openinfo = (void*)&info ;
+   
+            svp = hv_fetch(action, "compare", 7, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                info.btree.compare = btree_compare ;
+		RETVAL->compare = newSVsv(*svp) ;
+            }
+            else
+                info.btree.compare = NULL ;
+
+            svp = hv_fetch(action, "prefix", 6, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                info.btree.prefix = btree_prefix ;
+		RETVAL->prefix = newSVsv(*svp) ;
+            }
+            else
+                info.btree.prefix = NULL ;
+
+            svp = hv_fetch(action, "flags", 5, FALSE);
+            info.btree.flags = svp ? SvIV(*svp) : 0;
+   
+            svp = hv_fetch(action, "cachesize", 9, FALSE);
+            info.btree.cachesize = svp ? SvIV(*svp) : 0;
+         
+            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;
+
+            svp = hv_fetch(action, "psize", 5, FALSE);
+            info.btree.psize = svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "lorder", 6, FALSE);
+            info.btree.lorder = svp ? SvIV(*svp) : 0;
+
+            PrintBtree(info) ;
+         
+        }
+        else if (sv_isa(sv, "DB_File::RECNOINFO"))
+        {
+            RETVAL->type = DB_RECNO ;
+            openinfo = (void *)&info ;
+
+            svp = hv_fetch(action, "flags", 5, FALSE);
+            info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "cachesize", 9, FALSE);
+            info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "psize", 5, FALSE);
+            info.recno.psize = (int) svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "lorder", 6, FALSE);
+            info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
+         
+            svp = hv_fetch(action, "reclen", 6, FALSE);
+            info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
+         
+	    svp = hv_fetch(action, "bval", 4, FALSE);
+            if (svp && SvOK(*svp))
+            {
+                if (SvPOK(*svp))
+		    info.recno.bval = (u_char)*SvPV(*svp, na) ;
+		else
+		    info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
+            }
+            else
+ 	    {
+		if (info.recno.flags & R_FIXEDLEN)
+                    info.recno.bval = (u_char) ' ' ;
+		else
+                    info.recno.bval = (u_char) '\n' ;
+	    }
+         
+            svp = hv_fetch(action, "bfname", 6, FALSE); 
+            info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
+
+            PrintRecno(info) ;
+        }
+        else
+            croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
+    }
+
+
+    RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
+
+#if 0
+    /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
+		       so remember a DB_RECNO by saving the address
+		       of one of it's internal routines
+    */
+    if (RETVAL->dbp && type == DB_RECNO)
+        DB_recno_close = RETVAL->dbp->close ;
+#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 '_':
+	if (strEQ(name, "__R_UNUSED"))
+#ifdef __R_UNUSED
+	    return __R_UNUSED;
+#else
+	    goto not_there;
+#endif
+	break;
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+MODULE = DB_File	PACKAGE = DB_File	PREFIX = db_
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+
+DB_File
+db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
+	char *		dbtype
+	int		flags
+	int		mode
+	CODE:
+	{
+	    char *	name = (char *) NULL ; 
+	    SV *	sv = (SV *) NULL ; 
+
+	    if (items >= 2 && SvOK(ST(1))) 
+	        name = (char*) SvPV(ST(1), na) ; 
+
+            if (items == 5)
+	        sv = ST(4) ;
+
+	    RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
+	    if (RETVAL->dbp == NULL)
+	        RETVAL = NULL ;
+	}
+	OUTPUT:	
+	    RETVAL
+
+BOOT:
+    newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file);
+
+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) ;
+
+
+int
+db_DELETE(db, key, flags=0)
+	DB_File		db
+	DBTKEY		key
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+
+int
+db_FETCH(db, key, flags=0)
+	DB_File		db
+	DBTKEY		key
+	u_int		flags
+	CODE:
+	{
+	    DBT		value  ;
+
+	    CurrentDB = db ;
+	    RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
+	    ST(0) = sv_newmortal();
+	    if (RETVAL == 0)
+	        sv_setpvn(ST(0), value.data, value.size);
+	}
+
+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 ;
+
+	    CurrentDB = db ;
+	    RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
+	    ST(0) = sv_newmortal();
+	    if (RETVAL == 0)
+	    {
+	        if (Db->type != DB_RECNO)
+	            sv_setpvn(ST(0), key.data, key.size);
+	        else
+	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
+	    }
+	}
+
+int
+db_NEXTKEY(db, key)
+	DB_File		db
+	DBTKEY		key
+	CODE:
+	{
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    CurrentDB = db ;
+	    RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
+	    ST(0) = sv_newmortal();
+	    if (RETVAL == 0)
+	    {
+	        if (Db->type != DB_RECNO)
+	            sv_setpvn(ST(0), key.data, key.size);
+	        else
+	            sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
+	    }
+	}
+
+#
+# These would be nice for RECNO
+#
+
+int
+unshift(db, ...)
+	DB_File		db
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    int		i ;
+	    int		One ;
+	    DB *	Db = db->dbp ;
+
+	    CurrentDB = db ;
+	    RETVAL = -1 ;
+	    for (i = items-1 ; i > 0 ; --i)
+	    {
+	        value.data = SvPV(ST(i), na) ;
+	        value.size = na ;
+	        One = 1 ;
+	        key.data = &One ;
+	        key.size = sizeof(int) ;
+	        RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
+	        if (RETVAL != 0)
+	            break;
+	    }
+	}
+	OUTPUT:
+	    RETVAL
+
+I32
+pop(db)
+	DB_File		db
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    CurrentDB = db ;
+	    /* First get the final value */
+	    RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;	
+	    ST(0) = sv_newmortal();
+	    /* Now delete it */
+	    if (RETVAL == 0)
+	    {
+	        RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
+	        if (RETVAL == 0)
+	            sv_setpvn(ST(0), value.data, value.size);
+	    }
+	}
+
+I32
+shift(db)
+	DB_File		db
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+
+	    CurrentDB = db ;
+	    /* get the first value */
+	    RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;	
+	    ST(0) = sv_newmortal();
+	    /* Now delete it */
+	    if (RETVAL == 0)
+	    {
+	        RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
+	        if (RETVAL == 0)
+	            sv_setpvn(ST(0), value.data, value.size);
+	    }
+	}
+
+
+I32
+push(db, ...)
+	DB_File		db
+	CODE:
+	{
+	    DBTKEY	key ;
+	    DBTKEY *	keyptr = &key ; 
+	    DBT		value ;
+	    DB *	Db = db->dbp ;
+	    int		i ;
+
+	    CurrentDB = db ;
+	    /* Set the Cursor to the Last element */
+	    RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
+	    if (RETVAL >= 0)
+	    {
+		if (RETVAL == 1)
+		    keyptr = &empty ;
+	        for (i = items - 1 ; i > 0 ; --i)
+	        {
+	            value.data = SvPV(ST(i), na) ;
+	            value.size = na ;
+	            RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
+	            if (RETVAL != 0)
+	                break;
+	        }
+	    }
+	}
+	OUTPUT:
+	    RETVAL
+
+
+I32
+length(db)
+	DB_File		db
+	CODE:
+	    CurrentDB = db ;
+	    RETVAL = GetArrayLength(db->dbp) ;
+	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
+	INIT:
+	  CurrentDB = db ;
+
+
+int
+db_get(db, key, value, flags=0)
+	DB_File		db
+	DBTKEY		key
+	DBT		value
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+	OUTPUT:
+	  value
+
+int
+db_put(db, key, value, flags=0)
+	DB_File		db
+	DBTKEY		key
+	DBT		value
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+	OUTPUT:
+	  key		if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
+
+int
+db_fd(db)
+	DB_File		db
+	INIT:
+	  CurrentDB = db ;
+
+int
+db_sync(db, flags=0)
+	DB_File		db
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+
+
+int
+db_seq(db, key, value, flags)
+	DB_File		db
+	DBTKEY		key 
+	DBT		value
+	u_int		flags
+	INIT:
+	  CurrentDB = db ;
+	OUTPUT:
+	  key
+	  value
diff --git a/gnu/usr.bin/perl/ext/DB_File/DB_File_BS b/gnu/usr.bin/perl/ext/DB_File/DB_File_BS
new file mode 100644
index 00000000000..9282c498811
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/DB_File/Makefile.PL b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL
new file mode 100644
index 00000000000..4cda63507d2
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DB_File/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+	NAME 	=> 'DB_File',
+	LIBS 	=> ["-L/usr/local/lib -ldb"],
+	MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+	#INC	=> '-I/usr/local/include',
+	VERSION_FROM	=> 'DB_File.pm',
+	XSPROTOARG => '-noprototypes', 		# XXX remove later?
+);
+
diff --git a/gnu/usr.bin/perl/ext/DB_File/typemap b/gnu/usr.bin/perl/ext/DB_File/typemap
new file mode 100644
index 00000000000..4acc65e0781
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DB_File/typemap
@@ -0,0 +1,39 @@
+# typemap for Perl 5 interface to Berkeley DB
+#
+# written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
+# last modified 23rd June 1994
+# version 0.1
+#
+#################################### 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, na);
+	    $var.size = (int)na;
+	}
+	else
+	{
+	    Value =  SvIV($arg) ; 
+	    ++ Value ; 
+	    $var.data = & Value; 
+	    $var.size = (int)sizeof(recno_t);
+	}
+T_dbtdatum
+	$var.data = SvPV($arg, na);
+	$var.size = (int)na;
+
+OUTPUT
+
+T_dbtkeydatum
+	OutputKey($arg, $var)
+T_dbtdatum
+	OutputValue($arg, $var)
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader.pm b/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader.pm
new file mode 100644
index 00000000000..282d364372e
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/DynaLoader.pm
@@ -0,0 +1,593 @@
+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
+
+use vars qw($VERSION @ISA) ;
+
+require Carp;
+require Config;
+require AutoLoader;
+
+@ISA=qw(AutoLoader);
+
+$VERSION = "1.00" ;
+
+sub import { }		# override import inherited from AutoLoader
+
+# enable debug/trace messages from DynaLoader perl code
+$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
+
+($dl_dlext, $dlsrc)
+	= @Config::Config{'dlext', 'dlsrc'};
+
+# 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
+
+# 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'}));
+
+# 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
+
+
+# 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);
+
+    Carp::confess("Usage: DynaLoader::bootstrap(module)") unless $module;
+
+    # A common error on platforms which don't support dynamic loading.
+    # Since it's fatal and potentially confusing we give a detailed message.
+    Carp::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
+	last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
+
+	# no luck here, save dir for possible later dl_findfile search
+	push(@dirs, "-L$dir");
+    }
+    # last resort, let dl_findfile have a go in all known locations
+    $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
+
+    Carp::croak("Can't find loadable object for module $module in \@INC (@INC)")
+	unless $file;
+
+    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) or
+	Carp::croak("Can't load '$file' for module $module: ".dl_error()."\n");
+
+    my @unresolved = dl_undef_symbols();
+    Carp::carp("Undefined symbols present after loading $file: @unresolved\n")
+        if @unresolved;
+
+    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
+         Carp::croak("Can't find '$bootname' symbol in $file\n");
+
+    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
+
+    # 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
+    my $dl_ext= $Config::Config{'dlext'}; # suffix for perl extensions
+    my $dl_so = $Config::Config{'so'};	# suffix for shared libraries
+
+    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 = _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
+	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;
+}
+
+
+=head1 NAME
+
+DynaLoader - Dynamically load C libraries into Perl code
+
+dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_find_symbol(), dl_undef_symbols(), dl_install_xsub(), boostrap() - routines used by DynaLoader modules
+
+=head1 SYNOPSIS
+
+    package YourPackage;
+    require DynaLoader;
+    @ISA = qw(... DynaLoader ...);
+    bootstrap YourPackage;
+
+
+=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.  It is anticipated that any
+glue that may be developed in the future will be implemented in a
+separate dynamically loaded module.
+
+DynaLoader Interface Summary
+
+  @dl_library_path
+  @dl_resolve_using
+  @dl_require_symbols
+  $dl_debug
+                                                  Implemented in:
+  bootstrap($modulename)                               Perl
+  @filepaths = dl_findfile(@names)                     Perl
+
+  $libref  = dl_load_file($filename)                   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 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_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)
+
+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.
+
+(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 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])
+
+
+=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_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 boostrap()
+
+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_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.
+
+=cut
diff --git a/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL
new file mode 100644
index 00000000000..64ee4d02598
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL
@@ -0,0 +1,28 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME	=> 'DynaLoader',
+    LINKTYPE	=> 'static',
+    DEFINE	=> '-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',
+    clean	=> {FILES => 'DynaLoader.c'},
+);
+
+
+sub MY::postamble {
+	'
+DynaLoader.c: $(DLSRC)
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(DLSRC) >tmp && mv tmp $@
+
+# 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/gnu/usr.bin/perl/ext/DynaLoader/README b/gnu/usr.bin/perl/ext/DynaLoader/README
new file mode 100644
index 00000000000..0551cf375c9
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs
new file mode 100644
index 00000000000..f8bace13146
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_aix.xs
@@ -0,0 +1,582 @@
+/* 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>
+
+/*
+ * 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);
+
+  
+/* 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: ");
+		strcat(errbuf, strerror(errno));
+		return NULL;
+	}
+	
+	if ((mp->name = savepv(path)) == NULL) {
+		errvalid++;
+		strcpy(errbuf, "savepv: ");
+		strcat(errbuf, strerror(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)
+				strcpy(errbuf, strerror(errno));
+			else {
+				char **p;
+				for (p = tmp; *p; p++)
+					caterr(*p);
+			}
+		} else
+			strcat(errbuf, strerror(errno));
+		return NULL;
+	}
+	mp->refCnt = 1;
+	mp->next = modList;
+	modList = mp;
+	if (loadbind(0, mainModule, mp->entry) == -1) {
+		dlclose(mp);
+		errvalid++;
+		strcpy(errbuf, "loadbind: ");
+		strcat(errbuf, strerror(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:
+		strcat(errbuf, strerror(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++;
+		strcpy(errbuf, strerror(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: ");
+			strcat(errbuf, strerror(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: ");
+			strcat(errbuf, strerror(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: ");
+				strcat(errbuf, strerror(errno));
+				return -1;
+			}
+		}
+		if (i == -1) {
+			errvalid++;
+			strcpy(errbuf, "readExports: ");
+			strcat(errbuf, strerror(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: ");
+			strcat(errbuf, strerror(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: ");
+		strcat(errbuf, strerror(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;
+	}
+	if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
+		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: ");
+		strcat(errbuf, strerror(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: ");
+		strcat(errbuf, strerror(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: ");
+			strcat(errbuf, strerror(errno));
+			return NULL;
+		}
+	}
+	if (i == -1) {
+		errvalid++;
+		strcpy(errbuf, "findMain: ");
+		strcat(errbuf, strerror(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)
+	char *		filename
+	CODE:
+	DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+	RETVAL = dlopen(filename, 1) ;
+	DLDEBUG(2,fprintf(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,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+		libhandle, symbolname));
+	RETVAL = dlsym(libhandle, symbolname);
+	DLDEBUG(2,fprintf(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,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/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs
new file mode 100644
index 00000000000..a0028a1f7ad
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_dld.xs
@@ -0,0 +1,172 @@
+/*
+ *    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(origargv[0]));
+        if (dlderr) {
+            char *msg = dld_strerror(dlderr);
+            SaveError("dld_init(%s) failed: %s", origargv[0], msg);
+            DLDEBUG(1,fprintf(stderr,"%s", LastError));
+        }
+#ifdef __linux__
+    }
+#endif
+}
+
+
+MODULE = DynaLoader     PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+char *
+dl_load_file(filename)
+    char *	filename
+    CODE:
+    int dlderr,x,max;
+    GV *gv;
+    RETVAL = filename;
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename));
+
+    max = AvFILL(dl_require_symbols);
+    for (x = 0; x <= max; x++) {
+	char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
+	DLDEBUG(1,fprintf(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,fprintf(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,fprintf(stderr, "dld_link(%s)\n", sym));
+	if (dlderr = dld_link(sym)) {
+	    SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr));
+	    goto haverror;
+	}
+    }
+    DLDEBUG(2,fprintf(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,fprintf(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,fprintf(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,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/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs
new file mode 100644
index 00000000000..a2a68162b2e
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_dlopen.xs
@@ -0,0 +1,210 @@
+/* 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)
+    char *		filename
+    CODE:
+    int mode = RTLD_LAZY;
+#ifdef RTLD_NOW
+    if (dl_nonlazy)
+	mode = RTLD_NOW;
+#endif
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,fprintf(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:
+#ifdef DLSYM_NEEDS_UNDERSCORE
+    char symbolname_buf[1024];
+    symbolname = dl_add_underscore(symbolname, symbolname_buf);
+#endif
+    DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+	libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2,fprintf(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,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/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs
new file mode 100644
index 00000000000..0e146830ef3
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_hpux.xs
@@ -0,0 +1,132 @@
+/*
+ * Author: Jeff Okamoto (okamoto@corp.hp.com)
+ * Version: 2.1, 1995/1/25
+ */
+
+#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)
+    char *		filename
+    CODE:
+    shl_t obj = NULL;
+    int	i, max, bind_type;
+
+    if (dl_nonlazy)
+	bind_type = BIND_IMMEDIATE;
+    else
+	bind_type = BIND_DEFERRED;
+
+    max = AvFILL(dl_resolve_using);
+    for (i = 0; i <= max; i++) {
+	char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
+	DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym));
+	obj = shl_load(sym, bind_type | BIND_NOSTART, 0L);
+	if (obj == NULL) {
+	    goto end;
+	}
+    }
+
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename));
+    obj = shl_load(filename, bind_type | BIND_NOSTART, 0L);
+
+    DLDEBUG(2,fprintf(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
+    char symbolname_buf[MAXPATHLEN];
+    symbolname = dl_add_underscore(symbolname, symbolname_buf);
+#endif
+    DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+		libhandle, symbolname));
+    ST(0) = sv_newmortal() ;
+    errno = 0;
+
+    status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
+    DLDEBUG(2,fprintf(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,fprintf(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,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/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs
new file mode 100644
index 00000000000..33a41003eff
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_next.xs
@@ -0,0 +1,222 @@
+/* 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
+
+*/
+
+/* include these before perl headers */
+#include <mach-o/rld.h>
+#include <streams/streams.h>
+
+#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;
+
+NXStream *
+OpenError()
+{
+    return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
+}
+
+void
+TransferError( s)
+NXStream *s;
+{
+    char *buffer;
+    int len, maxlen;
+
+    if ( dl_last_error ) {
+        safefree(dl_last_error);
+    }
+    NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
+    dl_last_error = safemalloc(len);
+    strcpy(dl_last_error, buffer);
+}
+
+void
+CloseError( s)
+NXStream *s;
+{
+    if ( s ) {
+      NXCloseMemory( s, NX_FREEBUFFER);
+    }
+}
+
+char *dlerror()
+{
+    return dl_last_error;
+}
+
+char *
+dlopen(path, mode)
+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), 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), &sv_yes, 0);
+    } else {
+	TransferError(nxerr);
+	result = (char*) 0;
+    }
+    CloseError(nxerr);
+    return result;
+}
+
+int
+dlclose(handle) /* stub only */
+void *handle;
+{
+    return 0;
+}
+
+void *
+dlsym(handle, symbol)
+void *handle;
+char *symbol;
+{
+    NXStream	*nxerr = OpenError();
+    char	symbuf[1024];
+    unsigned long	symref = 0;
+
+    sprintf(symbuf, "_%s", symbol);
+    if (!rld_lookup(nxerr, symbuf, &symref)) {
+	TransferError(nxerr);
+    }
+    CloseError(nxerr);
+    return (void*) symref;
+}
+
+
+/* ----- 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)
+    char *	filename
+    CODE:
+    int mode = 1;
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,fprintf(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,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+	    libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2,fprintf(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,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/gnu/usr.bin/perl/ext/DynaLoader/dl_none.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_none.xs
new file mode 100644
index 00000000000..5a193e4346e
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/DynaLoader/dl_os2.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_os2.xs
new file mode 100644
index 00000000000..2c72be23ed8
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_os2.xs
@@ -0,0 +1,188 @@
+/* dl_os2.xs
+ * 
+ * Platform:	OS/2.
+ * Author:	Andreas Kaiser (ak@ananke.s.bawue.de)
+ * Created:	08th December 1994
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define INCL_BASE
+#include <os2.h>
+
+#include "dlutils.c"	/* SaveError() etc	*/
+
+static ULONG retcode;
+
+static void *
+dlopen(char *path, int mode)
+{
+	HMODULE handle;
+	char tmp[260], *beg, *dot;
+	char fail[300];
+	ULONG rc;
+
+	if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0)
+		return (void *)handle;
+
+	retcode = rc;
+
+	/* Not found. Check for non-FAT name and try truncated name. */
+	/* Don't know if this helps though... */
+	for (beg = dot = path + strlen(path);
+	     beg > path && !strchr(":/\\", *(beg-1));
+	     beg--)
+		if (*beg == '.')
+			dot = beg;
+	if (dot - beg > 8) {
+		int n = beg+8-path;
+		memmove(tmp, path, n);
+		memmove(tmp+n, dot, strlen(dot)+1);
+		if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0)
+			return (void *)handle;
+	}
+
+	return NULL;
+}
+
+static void *
+dlsym(void *handle, char *symbol)
+{
+	ULONG rc, type;
+	PFN addr;
+
+	rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr);
+	if (rc == 0) {
+		rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type);
+		if (rc == 0 && type == PT_32BIT)
+			return (void *)addr;
+		rc = ERROR_CALL_NOT_IMPLEMENTED;
+	}
+	retcode = rc;
+	return NULL;
+}
+
+static char *
+dlerror(void)
+{
+	static char buf[300];
+	ULONG len;
+
+	if (retcode == 0)
+		return NULL;
+	if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len))
+		sprintf(buf, "OS/2 system error code %d", retcode);
+	else
+		buf[len] = '\0';
+	retcode = 0;
+	return buf;
+}
+
+
+static void
+dl_private_init()
+{
+    (void)dl_generic_private_init();
+}
+
+static char *
+mod2fname(sv)
+     SV   *sv;
+{
+    static char fname[9];
+    int pos = 7;
+    int len;
+    AV  *av;
+    SV  *svp;
+    char *s;
+
+    if (!SvROK(sv)) croak("Not a reference given to mod2fname");
+    sv = SvRV(sv);
+    if (SvTYPE(sv) != SVt_PVAV) 
+      croak("Not array reference given to mod2fname");
+    if (av_len((AV*)sv) < 0) 
+      croak("Empty array reference given to mod2fname");
+    s = SvPV(*av_fetch((AV*)sv, av_len((AV*)sv), FALSE), na);
+    strncpy(fname, s, 8);
+    if ((len=strlen(s)) < 7) pos = len;
+    fname[pos] = '_';
+    fname[pos + 1] = '\0';
+    return (char *)fname;
+}
+
+MODULE = DynaLoader	PACKAGE = DynaLoader
+
+BOOT:
+    (void)dl_private_init();
+
+
+void *
+dl_load_file(filename)
+    char *		filename
+    CODE:
+    int mode = 1;     /* Solaris 1 */
+#ifdef RTLD_LAZY
+    mode = RTLD_LAZY; /* Solaris 2 */
+#endif
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
+    RETVAL = dlopen(filename, mode) ;
+    DLDEBUG(2,fprintf(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:
+#ifdef DLSYM_NEEDS_UNDERSCORE
+    char symbolname_buf[1024];
+    symbolname = dl_add_underscore(symbolname, symbolname_buf);
+#endif
+    DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
+	libhandle, symbolname));
+    RETVAL = dlsym(libhandle, symbolname);
+    DLDEBUG(2,fprintf(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:
+
+char *
+mod2fname(sv)
+     SV   *sv;
+
+
+# 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/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs b/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs
new file mode 100644
index 00000000000..3f46ffc9408
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dl_vms.xs
@@ -0,0 +1,354 @@
+/* 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,fprintf(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,fprintf(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,fprintf(stderr,"\tSYNCHK sys$parse = %d\n",sts));
+    if (!(sts & 1)) {
+      dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+      ST(0) = &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,fprintf(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,fprintf(stderr,"\tname/default sys$parse = %d\n",sts));
+      if (!(sts & 1)) {
+        dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+        ST(0) = &sv_undef;
+      }
+      else {
+        /* Now find the actual file */
+        sts = sys$search(&dlfab);
+        DLDEBUG(2,fprintf(stderr,"\tsys$search = %d\n",sts));
+        if (!(sts & 1)) {
+          dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
+          ST(0) = &sv_undef;
+        }
+        else {
+          ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
+          DLDEBUG(1,fprintf(stderr,"\tresult = \\%.*s\\\n",
+                            dlnam.nam$b_rsl,dlnam.nam$l_rsa));
+        }
+      }
+    }
+
+void
+dl_load_file(filespec)
+    char *	filespec
+    CODE:
+    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)();
+
+    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n",filespec));
+    specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
+    specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
+    DLDEBUG(2,fprintf(stderr,"\tVMS-ified filespec is %s\n",
+                      specdsc.dsc$a_pointer));
+    New(7901,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,fprintf(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;
+      dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
+      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,fprintf(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,fprintf(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,fprintf(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,fprintf(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) = &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,fprintf(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,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts));
+    DLDEBUG(2,fprintf(stderr,"\tentry point is %d\n",
+                      (unsigned long int) entry));
+    if (!(sts & 1)) {
+      /* error message already saved by findsym_handler */
+      ST(0) = &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,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/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c b/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c
new file mode 100644
index 00000000000..67dea787cc7
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/DynaLoader/dlutils.c
@@ -0,0 +1,96 @@
+/* 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()	/* 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,fprintf(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 */
+#ifdef STANDARD_C
+static void
+SaveError(char* pat, ...)
+#else
+/*VARARGS0*/
+static void
+SaveError(pat, va_alist)
+    char *pat;
+    va_dcl
+#endif
+{
+    va_list args;
+    char *message;
+    int len;
+
+    /* This code is based on croak/warn, see mess() in util.c */
+
+#ifdef I_STDARG
+    va_start(args, pat);
+#else
+    va_start(args);
+#endif
+    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 = safemalloc(len) ;
+
+    /* Copy message into LastError (including terminating null char)	*/
+    strncpy(LastError, message, len) ;
+    DLDEBUG(2,fprintf(stderr,"DynaLoader: stored error msg '%s'\n",LastError));
+}
+
+
+/* prepend underscore to s. write into buf. return buf. */
+char *
+dl_add_underscore(s, buf)
+char *s;
+char *buf;
+{
+    *buf = '_';
+    (void)strcpy(buf + 1, s);
+    return buf;
+}
+
diff --git a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm
new file mode 100644
index 00000000000..32a31943269
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.pm
@@ -0,0 +1,73 @@
+package Fcntl;
+
+=head1 NAME
+
+Fcntl - load the C Fcntl.h defines
+
+=head1 SYNOPSIS
+
+    use Fcntl;
+
+=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.
+
+=cut
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+
+require Exporter;
+use AutoLoader;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+$VERSION = "1.00";
+# Items to export into callers namespace by default
+# (move infrequently used names to @EXPORT_OK below)
+@EXPORT =
+  qw(
+     F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW
+     FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK
+     O_CREAT O_EXCL O_NOCTTY O_TRUNC
+     O_APPEND O_NONBLOCK
+     O_NDELAY
+     O_RDONLY O_RDWR O_WRONLY
+     );
+# Other items we are prepared to export if requested
+@EXPORT_OK = qw(
+);
+
+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;
+	    die "Your vendor has not defined Fcntl macro $constname, used at $file line $line.
+";
+	}
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+bootstrap Fcntl $VERSION;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+package Fcntl; # return to package Fcntl so AutoSplit is happy
+1;
+__END__
diff --git a/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs
new file mode 100644
index 00000000000..90f3af5028c
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Fcntl/Fcntl.xs
@@ -0,0 +1,205 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef VMS
+#  include <file.h>
+#else
+#  include <fcntl.h>
+#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(s)
+char *s;
+{
+    croak("%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+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_GETFD"))
+#ifdef F_GETFD
+	        return F_GETFD;
+#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_SETFD"))
+#ifdef F_SETFD
+	        return F_SETFD;
+#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_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_RDLCK"))
+#ifdef F_RDLCK
+	        return F_RDLCK;
+#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;
+	} else
+	  if (strEQ(name, "FD_CLOEXEC"))
+#ifdef FD_CLOEXEC
+	    return FD_CLOEXEC;
+#else
+	    goto not_there;
+#endif
+	break;
+    case 'O':
+	if (strnEQ(name, "O_", 2)) {
+	    if (strEQ(name, "O_CREAT"))
+#ifdef O_CREAT
+	        return O_CREAT;
+#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_TRUNC"))
+#ifdef O_TRUNC
+	        return O_TRUNC;
+#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_NONBLOCK"))
+#ifdef O_NONBLOCK
+	        return O_NONBLOCK;
+#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_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_BINARY"))
+#ifdef O_BINARY
+	        return O_BINARY;
+#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/gnu/usr.bin/perl/ext/Fcntl/Makefile.PL b/gnu/usr.bin/perl/ext/Fcntl/Makefile.PL
new file mode 100644
index 00000000000..66a6df6060d
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/FileHandle/FileHandle.pm b/gnu/usr.bin/perl/ext/FileHandle/FileHandle.pm
new file mode 100644
index 00000000000..2770b91c7fb
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/FileHandle/FileHandle.pm
@@ -0,0 +1,467 @@
+package FileHandle;
+
+=head1 NAME
+
+FileHandle - supply object methods for filehandles
+
+=head1 SYNOPSIS
+
+    use FileHandle;
+
+    $fh = new FileHandle;
+    if ($fh->open "< file") {
+        print <$fh>;
+        $fh->close;
+    }
+
+    $fh = new FileHandle "> FOO";
+    if (defined $fh) {
+        print $fh "bar\n";
+        $fh->close;
+    }
+
+    $fh = new FileHandle "file", "r";
+    if (defined $fh) {
+        print <$fh>;
+        undef $fh;       # automatically closes the file
+    }
+
+    $fh = new FileHandle "file", O_WRONLY|O_APPEND;
+    if (defined $fh) {
+        print $fh "corge\n";
+        undef $fh;       # automatically closes the file
+    }
+
+    $pos = $fh->getpos;
+    $fh->setpos $pos;
+
+    $fh->setvbuf($buffer_var, _IOLBF, 1024);
+
+    ($readfh, $writefh) = FileHandle::pipe;
+
+    autoflush STDOUT 1;
+
+=head1 DESCRIPTION
+
+C<FileHandle::new> creates a C<FileHandle>, which is a reference to a
+newly created symbol (see the C<Symbol> package).  If it receives any
+parameters, they are passed to C<FileHandle::open>; if the open fails,
+the C<FileHandle> object is destroyed.  Otherwise, it is returned to
+the caller.
+
+C<FileHandle::new_from_fd> creates a C<FileHandle> like C<new> does.
+It requires two parameters, which are passed to C<FileHandle::fdopen>;
+if the fdopen fails, the C<FileHandle> object is destroyed.
+Otherwise, it is returned to the caller.
+
+C<FileHandle::open> accepts one parameter or two.  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 in either Perl form (">", "+<", etc.) or POSIX form
+("w", "r+", etc.).
+
+C<FileHandle::fdopen> is like C<open> except that its first parameter
+is not a filename but rather a file handle name, a FileHandle object,
+or a file descriptor number.
+
+If the C functions fgetpos() and fsetpos() are available, then
+C<FileHandle::getpos> returns an opaque value that represents the
+current position of the FileHandle, and C<FileHandle::setpos> uses
+that value to return to a previously visited position.
+
+If the C function setvbuf() is available, then C<FileHandle::setvbuf>
+sets the buffering policy for the FileHandle.  The calling sequence
+for the Perl function is the same as its C counterpart, including the
+macros C<_IOFBF>, C<_IOLBF>, and C<_IONBF>, except that the buffer
+parameter specifies a scalar variable to use as a buffer.  WARNING: A
+variable used as a buffer by C<FileHandle::setvbuf> must not be
+modified in any way until the FileHandle is closed or until
+C<FileHandle::setvbuf> is called again, or memory corruption may
+result!
+
+See L<perlfunc> for complete descriptions of each of the following
+supported C<FileHandle> methods, which are just front ends for the
+corresponding built-in functions:
+  
+    close
+    fileno
+    getc
+    gets
+    eof
+    clearerr
+    seek
+    tell
+
+See L<perlvar> for complete descriptions of each of the following
+supported C<FileHandle> 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
+
+Furthermore, for doing normal I/O you might need these:
+
+=over 
+
+=item $fh->print
+
+See L<perlfunc/print>.
+
+=item $fh->printf
+
+See L<perlfunc/printf>.
+
+=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.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc>, 
+L<perlop/"I/O Operators">,
+L<POSIX/"FileHandle">
+
+=head1 BUGS
+
+Due to backwards compatibility, all filehandles resemble objects
+of class C<FileHandle>, or actually classes derived from that class.
+They actually aren't.  Which means you can't derive your own 
+class from C<FileHandle> and inherit those methods.
+
+=cut
+
+require 5.000;
+use vars qw($VERSION @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use Symbol;
+use SelectSaver;
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+
+$VERSION = "1.00" ;
+
+@EXPORT = qw(_IOFBF _IOLBF _IONBF);
+
+@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
+
+    print
+    printf
+    getline
+    getlines
+);
+
+
+################################################
+## If the Fcntl extension is available,
+##  export its constants.
+##
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller;
+    Exporter::export $pkg, $callpkg;
+    eval {
+	require Fcntl;
+	Exporter::export 'Fcntl', $callpkg;
+    };
+};
+
+
+################################################
+## Interaction with the XS.
+##
+
+eval {
+    bootstrap FileHandle;
+};
+if ($@) {
+    *constant = sub { undef };
+}
+
+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 FileHandle macro";
+    *$AUTOLOAD = sub { $val };
+    goto &$AUTOLOAD;
+}
+
+
+################################################
+## Constructors, destructors.
+##
+
+sub new {
+    @_ >= 1 && @_ <= 3 or croak 'usage: new FileHandle [FILENAME [,MODE]]';
+    my $class = shift;
+    my $fh = gensym;
+    if (@_) {
+	FileHandle::open($fh, @_)
+	    or return undef;
+    }
+    bless $fh, $class;
+}
+
+sub new_from_fd {
+    @_ == 3 or croak 'usage: new_from_fd FileHandle FD, MODE';
+    my $class = shift;
+    my $fh = gensym;
+    FileHandle::fdopen($fh, @_)
+	or return undef;
+    bless $fh, $class;
+}
+
+sub DESTROY {
+    my ($fh) = @_;
+    close($fh);
+}
+
+################################################
+## Open and close.
+##
+
+sub pipe {
+    @_ and croak 'usage: FileHandle::pipe()';
+    my $readfh = new FileHandle;
+    my $writefh = new FileHandle;
+    pipe($readfh, $writefh)
+	or return undef;
+    ($readfh, $writefh);
+}
+
+sub _open_mode_string {
+    my ($mode) = @_;
+    $mode =~ /^\+?(<|>>?)$/
+      or $mode =~ s/^r(\+?)$/$1</
+      or $mode =~ s/^w(\+?)$/$1>/
+      or $mode =~ s/^a(\+?)$/$1>>/
+      or croak "FileHandle: bad open mode: $mode";
+    $mode;
+}
+
+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 unless $file =~ m#^/#;
+	$file = _open_mode_string($mode) . " $file\0";
+    }
+    open($fh, $file);
+}
+
+sub fdopen {
+    @_ == 3 or croak 'usage: $fh->fdopen(FD, MODE)';
+    my ($fh, $fd, $mode) = @_;
+    if (ref($fd) =~ /GLOB\(/) {
+	# It's a glob reference; remove the star from its name.
+	($fd = "".$$fd) =~ s/^\*//;
+    } elsif ($fd =~ m#^\d+$#) {
+	# It's an FD number; prefix with "=".
+	$fd = "=$fd";
+    }
+    open($fh, _open_mode_string($mode) . '&' . $fd);
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $fh->close()';
+    close($_[0]);
+}
+
+################################################
+## Normal I/O functions.
+##
+
+sub fileno {
+    @_ == 1 or croak 'usage: $fh->fileno()';
+    fileno($_[0]);
+}
+
+sub getc {
+    @_ == 1 or croak 'usage: $fh->getc()';
+    getc($_[0]);
+}
+
+sub gets {
+    @_ == 1 or croak 'usage: $fh->gets()';
+    my ($handle) = @_;
+    scalar <$handle>;
+}
+
+sub eof {
+    @_ == 1 or croak 'usage: $fh->eof()';
+    eof($_[0]);
+}
+
+sub clearerr {
+    @_ == 1 or croak 'usage: $fh->clearerr()';
+    seek($_[0], 0, 1);
+}
+
+sub seek {
+    @_ == 3 or croak 'usage: $fh->seek(POS, WHENCE)';
+    seek($_[0], $_[1], $_[2]);
+}
+
+sub tell {
+    @_ == 1 or croak 'usage: $fh->tell()';
+    tell($_[0]);
+}
+
+sub print {
+    @_ or croak 'usage: $fh->print([ARGS])';
+    my $this = shift;
+    print $this @_;
+}
+
+sub printf {
+    @_ or croak 'usage: $fh->printf([ARGS])';
+    my $this = shift;
+    printf $this @_;
+}
+
+sub getline {
+    @_ == 1 or croak 'usage: $fh->getline';
+    my $this = shift;
+    return scalar <$this>;
+} 
+
+sub getlines {
+    @_ == 1 or croak 'usage: $fh->getline()';
+    my $this = shift;
+    wantarray or croak "Can't call FileHandle::getlines in a scalar context";
+    return <$this>;
+}
+
+################################################
+## State modification functions.
+##
+
+sub autoflush {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $|;
+    $| = @_ > 1 ? $_[1] : 1;
+    $prev;
+}
+
+sub output_field_separator {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $,;
+    $, = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub output_record_separator {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $\;
+    $\ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_record_separator {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $/;
+    $/ = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub input_line_number {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $.;
+    $. = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_page_number {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $%;
+    $% = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_per_page {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $=;
+    $= = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_lines_left {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $-;
+    $- = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_name {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $~;
+    $~ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_top_name {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $^;
+    $^ = qualify($_[1], caller) if @_ > 1;
+    $prev;
+}
+
+sub format_line_break_characters {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $:;
+    $: = $_[1] if @_ > 1;
+    $prev;
+}
+
+sub format_formfeed {
+    my $old = new SelectSaver qualify($_[0], caller);
+    my $prev = $^L;
+    $^L = $_[1] if @_ > 1;
+    $prev;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/ext/FileHandle/FileHandle.xs b/gnu/usr.bin/perl/ext/FileHandle/FileHandle.xs
new file mode 100644
index 00000000000..3a99cf1dc88
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/FileHandle/FileHandle.xs
@@ -0,0 +1,177 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <stdio.h>
+
+typedef int SysRet;
+typedef FILE * InputStream;
+typedef FILE * OutputStream;
+
+static int
+not_here(s)
+char *s;
+{
+    croak("FileHandle::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static bool
+constant(name, pval)
+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;
+    }
+
+    return FALSE;
+}
+
+
+MODULE = FileHandle	PACKAGE = FileHandle	PREFIX = f
+
+SV *
+constant(name)
+	char *		name
+    CODE:
+	IV i;
+	if (constant(name, &i))
+	    RETVAL = newSViv(i);
+	else
+	    RETVAL = &sv_undef;
+    OUTPUT:
+	RETVAL
+
+SV *
+fgetpos(handle)
+	InputStream	handle
+    CODE:
+#ifdef HAS_FGETPOS
+	if (handle) {
+	    Fpos_t pos;
+	    fgetpos(handle, &pos);
+	    ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+	}
+	else {
+	    ST(0) = &sv_undef;
+	    errno = EINVAL;
+	}
+#else
+	ST(0) = (SV *) not_here("fgetpos");
+#endif
+
+SysRet
+fsetpos(handle, pos)
+	InputStream	handle
+	SV *		pos
+    CODE:
+#ifdef HAS_FSETPOS
+	if (handle)
+	    RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos));
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+#else
+	    RETVAL = (SysRet) not_here("fsetpos");
+#endif
+    OUTPUT:
+	RETVAL
+
+int
+ungetc(handle, c)
+	InputStream	handle
+	int		c
+    CODE:
+	if (handle)
+	    RETVAL = ungetc(c, handle);
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+OutputStream
+new_tmpfile(packname = "FileHandle")
+    char *		packname
+    CODE:
+	RETVAL = tmpfile();
+    OUTPUT:
+	RETVAL
+
+int
+ferror(handle)
+	InputStream	handle
+    CODE:
+	if (handle)
+	    RETVAL = ferror(handle);
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+    OUTPUT:
+	RETVAL
+
+SysRet
+fflush(handle)
+	OutputStream	handle
+    CODE:
+	if (handle)
+	    RETVAL = fflush(handle);
+	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)
+	    setbuf(handle, buf);
+
+
+
+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:
+#ifdef _IOFBF   /* Should be HAS_SETVBUF once Configure tests for that */
+	if (handle)
+	    RETVAL = setvbuf(handle, buf, type, size);
+	else {
+	    RETVAL = -1;
+	    errno = EINVAL;
+	}
+#else
+	    RETVAL = (SysRet) not_here("setvbuf");
+#endif /* _IOFBF */
+    OUTPUT:
+	RETVAL
+
diff --git a/gnu/usr.bin/perl/ext/FileHandle/Makefile.PL b/gnu/usr.bin/perl/ext/FileHandle/Makefile.PL
new file mode 100644
index 00000000000..7efd382043f
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/FileHandle/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'FileHandle',
+    MAN3PODS   => ' ',			# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 	# XXX remove later?
+    VERSION_FROM => 'FileHandle.pm',
+);
diff --git a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm
new file mode 100644
index 00000000000..3f1d83e0049
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs
new file mode 100644
index 00000000000..a423c88c705
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.xs
@@ -0,0 +1,246 @@
+#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(s)
+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(name, arg)
+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/gnu/usr.bin/perl/ext/GDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/GDBM_File/Makefile.PL
new file mode 100644
index 00000000000..d24461350b6
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/GDBM_File/typemap b/gnu/usr.bin/perl/ext/GDBM_File/typemap
new file mode 100644
index 00000000000..a6b0e5faa86
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/GDBM_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, na);
+	$var.dsize = (int)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/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL
new file mode 100644
index 00000000000..ca4c107c0d2
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm
new file mode 100644
index 00000000000..6072e651fcc
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm
@@ -0,0 +1,39 @@
+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.00";
+
+bootstrap NDBM_File $VERSION;
+
+1;
+
+__END__
+
+=head1 NAME
+
+NDBM_File - Tied access to ndbm files
+
+=head1 SYNOPSIS
+
+ use NDBM_File;
+
+ tie(%h,NDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640);
+
+ untie %h;
+
+=head1 DESCRIPTION
+
+See L<perlfunc/tie>
+
+=cut
diff --git a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.xs
new file mode 100644
index 00000000000..d129a9c4905
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/NDBM_File/hints/solaris.pl b/gnu/usr.bin/perl/ext/NDBM_File/hints/solaris.pl
new file mode 100644
index 00000000000..11310a972f5
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/NDBM_File/hints/svr4.pl b/gnu/usr.bin/perl/ext/NDBM_File/hints/svr4.pl
new file mode 100644
index 00000000000..3285d9a685f
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/NDBM_File/typemap b/gnu/usr.bin/perl/ext/NDBM_File/typemap
new file mode 100644
index 00000000000..a6b0e5faa86
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/NDBM_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, na);
+	$var.dsize = (int)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/gnu/usr.bin/perl/ext/ODBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/ODBM_File/Makefile.PL
new file mode 100644
index 00000000000..76a5d199990
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm
new file mode 100644
index 00000000000..e5386e853b7
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs
new file mode 100644
index 00000000000..c1b405ff89b
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.xs
@@ -0,0 +1,101 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#ifdef NULL
+#undef NULL
+#endif
+#ifdef I_DBM
+#  include <dbm.h>
+#else
+#  ifdef I_RPCSVC_DBM
+#    include <rpcsvc/dbm.h>
+#  endif
+#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_
+
+ODBM_File
+odbm_TIEHASH(dbtype, filename, flags, mode)
+	char *		dbtype
+	char *		filename
+	int		flags
+	int		mode
+	CODE:
+	{
+	    char tmpbuf[1025];
+	    if (dbmrefcnt++)
+		croak("Old dbm can only open one database");
+	    sprintf(tmpbuf,"%s.dir",filename);
+	    if (stat(tmpbuf, &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(&sv_undef);
+	    sv_setptrobj(ST(0), RETVAL, "ODBM_File");
+	}
+
+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/gnu/usr.bin/perl/ext/ODBM_File/hints/dec_osf.pl b/gnu/usr.bin/perl/ext/ODBM_File/hints/dec_osf.pl
new file mode 100644
index 00000000000..f041bf96c00
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/ODBM_File/hints/dec_osf.pl
@@ -0,0 +1,5 @@
+# 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//;
diff --git a/gnu/usr.bin/perl/ext/ODBM_File/hints/sco.pl b/gnu/usr.bin/perl/ext/ODBM_File/hints/sco.pl
new file mode 100644
index 00000000000..4664f2bee0f
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/ODBM_File/hints/solaris.pl b/gnu/usr.bin/perl/ext/ODBM_File/hints/solaris.pl
new file mode 100644
index 00000000000..ac573932cce
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/ODBM_File/hints/svr4.pl b/gnu/usr.bin/perl/ext/ODBM_File/hints/svr4.pl
new file mode 100644
index 00000000000..3285d9a685f
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/ODBM_File/typemap b/gnu/usr.bin/perl/ext/ODBM_File/typemap
new file mode 100644
index 00000000000..a6b0e5faa86
--- /dev/null
+++ b/gnu/usr.bin/perl/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, na);
+	$var.dsize = (int)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/gnu/usr.bin/perl/ext/POSIX/Makefile.PL b/gnu/usr.bin/perl/ext/POSIX/Makefile.PL
new file mode 100644
index 00000000000..3359d1742c3
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'POSIX',
+    LIBS	=> ["-lm -lposix -lcposix"],
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'POSIX.pm', 
+);
diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.pm b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm
new file mode 100644
index 00000000000..66b55c15651
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pm
@@ -0,0 +1,921 @@
+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.00" ;
+
+%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 EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM
+		EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE
+		EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK
+		ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO
+		EPERM EPIPE ERANGE EROFS ESPIPE ESRCH 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_STREADM_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 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 stroul 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
+);
+
+# 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]);
+    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]};
+}
+
+############################
+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 "FileHandle::clearerr()";
+}
+
+sub fclose {
+    redef "FileHandle::close()";
+}
+
+sub fdopen {
+    redef "FileHandle::new_from_fd()";
+}
+
+sub feof {
+    redef "FileHandle::eof()";
+}
+
+sub fgetc {
+    redef "FileHandle::getc()";
+}
+
+sub fgets {
+    redef "FileHandle::gets()";
+}
+
+sub fileno {
+    redef "FileHandle::fileno()";
+}
+
+sub fopen {
+    redef "FileHandle::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 "FileHandle::seek()";
+}
+
+sub ferror {
+    redef "FileHandle::error()";
+}
+
+sub fflush {
+    redef "FileHandle::flush()";
+}
+
+sub fgetpos {
+    redef "FileHandle::getpos()";
+}
+
+sub fsetpos {
+    redef "FileHandle::setpos()";
+}
+
+sub ftell {
+    redef "FileHandle::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 "FileHandle::new_tmpfile()";
+}
+
+sub ungetc {
+    redef "FileHandle::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 strtod {
+    unimpl "strtod() is C-specific, stopped";
+}
+
+sub strtol {
+    unimpl "strtol() is C-specific, stopped";
+}
+
+sub stroul {
+    unimpl "stroul() is C-specific, stopped";
+}
+
+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;
+    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/gnu/usr.bin/perl/ext/POSIX/POSIX.pod b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod
new file mode 100644
index 00000000000..4b7585117c6
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.pod
@@ -0,0 +1,1639 @@
+=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<FileHandle::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<FileHandle::close()> instead.
+
+=item fcntl
+
+This is identical to Perl's builtin C<fcntl()> function.
+
+=item fdopen
+
+Use method C<FileHandle::new_from_fd()> instead.
+
+=item feof
+
+Use method C<FileHandle::eof()> instead.
+
+=item ferror
+
+Use method C<FileHandle::error()> instead.
+
+=item fflush
+
+Use method C<FileHandle::flush()> instead.
+
+=item fgetc
+
+Use method C<FileHandle::getc()> instead.
+
+=item fgetpos
+
+Use method C<FileHandle::getpos()> instead.
+
+=item fgets
+
+Use method C<FileHandle::gets()> instead.
+
+=item fileno
+
+Use method C<FileHandle::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<FileHandle::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<FileHandle::seek()> instead.
+
+=item fsetpos
+
+Use method C<FileHandle::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<FileHandle::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 read/write file pointer.  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.
+
+	$loc = POSIX::setlocale( &POSIX::LC_ALL, "C" );
+
+=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
+
+strtod() is C-specific.
+
+=item strtok
+
+strtok() is C-specific.
+
+=item strtol
+
+strtol() is C-specific.
+
+=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<FileHandle::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<FileHandle::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.  The third parameter contains the C<sa_flags>.
+
+	$sigset = POSIX::SigSet->new;
+	$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.
+
+	$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( 1, &POSIX::VEOF );
+
+=item setcflag
+
+Set the c_cflag field of a termios object.
+
+	$termios->setcflag( &POSIX::CLOCAL );
+
+=item setiflag
+
+Set the c_iflag field of a termios object.
+
+	$termios->setiflag( &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( &POSIX::ECHO );
+
+=item setoflag
+
+Set the c_oflag field of a termios object.
+
+	$termios->setoflag( &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 EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO EPERM EPIPE ERANGE EROFS ESPIPE ESRCH 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 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/gnu/usr.bin/perl/ext/POSIX/POSIX.xs b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs
new file mode 100644
index 00000000000..3ba3c5b4269
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs
@@ -0,0 +1,3244 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#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>
+#ifdef I_STDARG
+#include <stdarg.h>
+#endif
+#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
+#include <stdio.h>
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <time.h>
+#include <unistd.h>
+#if defined(__VMS) && !defined(__POSIX_SOURCE)
+#  include <file.h>         /* == fcntl.h for DECC; no fcntl.h for VAXC */
+#  include <libdef.h>       /* LIB$_INVARG constant */
+#  include <lib$routines.h> /* prototype for lib$ediv() */
+#  include <starlet.h>      /* prototype for sys$gettim() */
+
+#  undef mkfifo  /* #defined in perl.h */
+#  define mkfifo(a,b) (not_here("mkfifo"),-1)
+#  define tzset() not_here("tzset")
+
+   /* The default VMS emulation of Unix signals isn't very POSIXish */
+   typedef int sigset_t;
+#  define sigpending(a) (not_here("sigpending"),0)
+
+   /* sigset_t is atomic under VMS, so these routines are easy */
+   int sigemptyset(sigset_t *set) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	*set = 0; return 0;
+   }
+   int sigfillset(sigset_t *set) {
+	int i;
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	for (i = 0; i < NSIG; i++) *set |= (1 << i);
+	return 0;
+   }
+   int sigaddset(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set |= (1 << (sig - 1));
+	return 0;
+   }
+   int sigdelset(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set &= ~(1 << (sig - 1));
+	return 0;
+   }
+   int sigismember(sigset_t *set, int sig) {
+	if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
+	if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
+	*set & (1 << (sig - 1));
+   }
+   /* The tools for sigprocmask() are there, just not the routine itself */
+#  ifndef SIG_UNBLOCK
+#    define SIG_UNBLOCK 1
+#  endif
+#  ifndef SIG_BLOCK
+#    define SIG_BLOCK 2
+#  endif
+#  ifndef SIG_SETMASK
+#    define SIG_SETMASK 3
+#  endif
+   int sigprocmask(int how, sigset_t *set, sigset_t *oset) {
+	if (!set || !oset) {
+	  set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
+	  return -1;
+	}
+	switch (how) {
+	  case SIG_SETMASK:
+	    *oset = sigsetmask(*set);
+	    break;
+	  case SIG_BLOCK:
+	    *oset = sigblock(*set);
+	    break;
+	  case SIG_UNBLOCK:
+	    *oset = sigblock(0);
+	    sigsetmask(*oset & ~*set);
+	    break;
+	  default:
+	    set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+	    return -1;
+	}
+	return 0;
+    }
+#  define sigaction sigvec
+#  define sa_flags sv_onstack
+#  define sa_handler sv_handler
+#  define sa_mask sv_mask
+#  define sigsuspend(set) sigpause(*set)
+
+   /* 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 *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 *)bufptr);
+	return (clock_t) retval;
+   }
+#  define times(t) vms_times(t)
+#else
+#  include <fcntl.h>
+#  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
+
+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 *));
+
+#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_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_FGETPOS
+#define fgetpos(a,b) not_here("fgetpos")
+#endif
+#ifndef HAS_FSETPOS
+#define fsetpos(a,b) not_here("fsetpos")
+#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
+extern char *tzname[];
+#else
+char *tzname[] = { "" , "" };
+#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 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
+
+
+#ifndef HAS_LONG_DOUBLE /* XXX What to do about long doubles? */
+#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(s)
+char *s;
+{
+    croak("POSIX::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+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, "EAGAIN"))
+#ifdef EAGAIN
+		return EAGAIN;
+#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
+	    break;
+	case 'D':
+	    if (strEQ(name, "EDEADLK"))
+#ifdef EDEADLK
+		return EDEADLK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EDOM"))
+#ifdef EDOM
+		return EDOM;
+#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 'I':
+	    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, "EISDIR"))
+#ifdef EISDIR
+		return EISDIR;
+#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
+	    break;
+	case 'N':
+	    if (strEQ(name, "ENOMEM"))
+#ifdef ENOMEM
+		return ENOMEM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOSPC"))
+#ifdef ENOSPC
+		return ENOSPC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOEXEC"))
+#ifdef ENOEXEC
+		return ENOEXEC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "ENOTTY"))
+#ifdef ENOTTY
+		return ENOTTY;
+#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, "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
+	    break;
+	case 'P':
+	    if (strEQ(name, "EPERM"))
+#ifdef EPERM
+		return EPERM;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EPIPE"))
+#ifdef EPIPE
+		return EPIPE;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'R':
+	    if (strEQ(name, "ERANGE"))
+#ifdef ERANGE
+		return ERANGE;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "EROFS"))
+#ifdef EROFS
+		return EROFS;
+#else
+		goto not_there;
+#endif
+	    break;
+	case 'S':
+	    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
+	    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 (int)SIG_DFL;
+#endif
+#ifdef SIG_ERR
+		if (strEQ(name, "SIG_ERR")) return (int)SIG_ERR;
+#endif
+#ifdef SIG_IGN
+		if (strEQ(name, "SIG_IGN")) return (int)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 (strEQ(name, "SA_NOCLDSTOP"))
+#ifdef SA_NOCLDSTOP
+	    return SA_NOCLDSTOP;
+#else
+	    goto not_there;
+#endif
+	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"))
+#ifdef _PC_CHOWN_RESTRICTED
+		return _PC_CHOWN_RESTRICTED;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_LINK_MAX"))
+#ifdef _PC_LINK_MAX
+		return _PC_LINK_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_MAX_CANON"))
+#ifdef _PC_MAX_CANON
+		return _PC_MAX_CANON;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_MAX_INPUT"))
+#ifdef _PC_MAX_INPUT
+		return _PC_MAX_INPUT;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_NAME_MAX"))
+#ifdef _PC_NAME_MAX
+		return _PC_NAME_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_NO_TRUNC"))
+#ifdef _PC_NO_TRUNC
+		return _PC_NO_TRUNC;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_PATH_MAX"))
+#ifdef _PC_PATH_MAX
+		return _PC_PATH_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_PIPE_BUF"))
+#ifdef _PC_PIPE_BUF
+		return _PC_PIPE_BUF;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_PC_VDISABLE"))
+#ifdef _PC_VDISABLE
+		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"))
+#ifdef _SC_ARG_MAX
+		return _SC_ARG_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_CHILD_MAX"))
+#ifdef _SC_CHILD_MAX
+		return _SC_CHILD_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_CLK_TCK"))
+#ifdef _SC_CLK_TCK
+		return _SC_CLK_TCK;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_JOB_CONTROL"))
+#ifdef _SC_JOB_CONTROL
+		return _SC_JOB_CONTROL;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_NGROUPS_MAX"))
+#ifdef _SC_NGROUPS_MAX
+		return _SC_NGROUPS_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_OPEN_MAX"))
+#ifdef _SC_OPEN_MAX
+		return _SC_OPEN_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_SAVED_IDS"))
+#ifdef _SC_SAVED_IDS
+		return _SC_SAVED_IDS;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_STREAM_MAX"))
+#ifdef _SC_STREAM_MAX
+		return _SC_STREAM_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_TZNAME_MAX"))
+#ifdef _SC_TZNAME_MAX
+		return _SC_TZNAME_MAX;
+#else
+		goto not_there;
+#endif
+	    if (strEQ(name, "_SC_VERSION"))
+#ifdef _SC_VERSION
+		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");
+#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");
+#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");
+#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");
+#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");
+#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");
+#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)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isalnum(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isalpha(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isalpha(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+iscntrl(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!iscntrl(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isdigit(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isdigit(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isgraph(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isgraph(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+islower(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!islower(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isprint(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isprint(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+ispunct(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!ispunct(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isspace(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isspace(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isupper(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; s++)
+	    if (!isupper(*s))
+		RETVAL = 0;
+    OUTPUT:
+	RETVAL
+
+int
+isxdigit(charstring)
+	char *		charstring
+    CODE:
+	char *s;
+	RETVAL = 1;
+	for (s = charstring; *s && RETVAL; 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);
+	    if (lcbuf->grouping && *lcbuf->grouping)
+		hv_store(RETVAL, "grouping", 8,
+		    newSVpv(lcbuf->grouping, 0), 0);
+	    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);
+	    if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
+		hv_store(RETVAL, "mon_thousands_sep", 17,
+		    newSVpv(lcbuf->mon_thousands_sep, 0), 0);
+	    if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
+		hv_store(RETVAL, "mon_grouping", 12,
+		    newSVpv(lcbuf->mon_grouping, 0), 0);
+	    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)
+	int		category
+	char *		locale
+
+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:
+
+# This code is really grody because we're trying to make the signal
+# interface look beautiful, which is hard.
+
+	if (!siggv)
+	    gv_fetchpv("SIG", TRUE, SVt_PVHV);
+
+	{
+	    struct sigaction act;
+	    struct sigaction oact;
+	    POSIX__SigSet sigset;
+	    SV** svp;
+	    SV** sigsvp = hv_fetch(GvHVn(siggv),
+				 sig_name[sig],
+				 strlen(sig_name[sig]),
+				 TRUE);
+
+	    /* Remember old handler name if desired. */
+	    if (oldaction) {
+		char *hand = SvPVx(*sigsvp, 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, 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);
+	    }
+	}
+    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';
+            if (tainting)
+                sv_magic(sv_buffer, 0, 't', 0, 0);
+        }
+
+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
+
+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( newSVnv( realtime ) ) );
+	PUSHs( sv_2mortal( newSVnv( tms.tms_utime ) ) );
+	PUSHs( sv_2mortal( newSVnv( tms.tms_stime ) ) );
+	PUSHs( sv_2mortal( newSVnv( tms.tms_cutime ) ) );
+	PUSHs( sv_2mortal( newSVnv( 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/gnu/usr.bin/perl/ext/POSIX/typemap b/gnu/usr.bin/perl/ext/POSIX/typemap
new file mode 100644
index 00000000000..45e0862ff0f
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/POSIX/typemap
@@ -0,0 +1,13 @@
+Mode_t			T_NV
+pid_t			T_NV
+Uid_t			T_NV
+Time_t			T_NV
+Gid_t			T_NV
+Off_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/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
new file mode 100644
index 00000000000..8fc9411768a
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
@@ -0,0 +1,23 @@
+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.
+
+WriteMakefile(
+    NAME	=> 'SDBM_File',
+    MYEXTLIB => 'sdbm/libsdbm$(LIB_EXT)',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'SDBM_File.pm',
+);
+
+
+sub MY::postamble {
+    '
+$(MYEXTLIB): sdbm/Makefile
+	cd sdbm; $(MAKE) all
+';
+}
+
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm
new file mode 100644
index 00000000000..9b7acc1e091
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.xs
new file mode 100644
index 00000000000..38eaebf5c5e
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/CHANGES b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/CHANGES
new file mode 100644
index 00000000000..f7296d1b3aa
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/COMPARE b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/COMPARE
new file mode 100644
index 00000000000..a595e831d26
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
new file mode 100644
index 00000000000..b4bd6f9549f
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
@@ -0,0 +1,29 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    'NAME'	=> 'SDBM_File',
+    'LINKTYPE'  => 'static',
+    'DEFINE'	=> '-DSDBM -DDUFF',
+    'SKIP'	=> [qw(static static_lib dynamic dynamic_lib)],
+    '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::top_targets {
+	'
+all :: static
+
+static ::	libsdbm$(LIB_EXT)
+
+config ::
+
+libsdbm$(LIB_EXT): $(O_FILES)
+	$(AR) cr libsdbm$(LIB_EXT) $(O_FILES)
+	$(RANLIB) libsdbm$(LIB_EXT)
+
+lint:
+	lint -abchx $(LIBSRCS)
+';
+}
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/README b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/README
new file mode 100644
index 00000000000..cd7312cc575
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/README.too b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/README.too
new file mode 100644
index 00000000000..c2d095944da
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/biblio b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/biblio
new file mode 100644
index 00000000000..0be09fa005b
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dba.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dba.c
new file mode 100644
index 00000000000..4f227e52456
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dba.c
@@ -0,0 +1,84 @@
+/*
+ * dba	dbm analysis/recovery
+ */
+
+#include <stdio.h>
+#include <sys/file.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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbd.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbd.c
new file mode 100644
index 00000000000..697a5475977
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbd.c
@@ -0,0 +1,110 @@
+/*
+ * dbd - dump a dbm data file
+ */
+
+#include <stdio.h>
+#include <sys/file.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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbe.1 b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbe.1
new file mode 100644
index 00000000000..3b32272684b
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbe.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbe.c
new file mode 100644
index 00000000000..2a306f276ec
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbm.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbm.c
new file mode 100644
index 00000000000..1388230e2d3
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbm.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbm.h
new file mode 100644
index 00000000000..1196953d965
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbu.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbu.c
new file mode 100644
index 00000000000..106262872e2
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/dbu.c
@@ -0,0 +1,250 @@
+#include <stdio.h>
+#include <sys/file.h>
+#ifdef SDBM
+#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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/grind b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/grind
new file mode 100644
index 00000000000..23728b7d494
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/hash.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/hash.c
new file mode 100644
index 00000000000..eb585ac1025
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/hash.c
@@ -0,0 +1,48 @@
+/*
+ * 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 "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(str, len)
+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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/linux.patches b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/linux.patches
new file mode 100644
index 00000000000..cb7b1b7d8eb
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/makefile.sdbm b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/makefile.sdbm
new file mode 100644
index 00000000000..c959c1fab55
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
new file mode 100644
index 00000000000..a02c73f28f6
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
@@ -0,0 +1,307 @@
+/*
+ * 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
+ */
+
+#ifndef lint
+static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $";
+#endif
+
+#include "config.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(pag, need)
+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(pag, key, val)
+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(pag, key)
+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(pag, key)
+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(pag, num)
+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(pag, key)
+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(pag, n, key, siz)
+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] &&
+		    memcmp(key, pag + ino[i], siz) == 0)
+			return i;
+		off = ino[i + 1];
+	}
+	return 0;
+}
+
+void
+splpage(pag, new, sbit)
+char *pag;
+char *new;
+long 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(pag)
+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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.h
new file mode 100644
index 00000000000..bd66d02fd24
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.h
@@ -0,0 +1,10 @@
+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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/readme.ms b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/readme.ms
new file mode 100644
index 00000000000..01ca17ccdfd
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/readme.ps b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/readme.ps
new file mode 100644
index 00000000000..da17e614383
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/readme.ps
@@ -0,0 +1,2225 @@
+%!PS-Adobe-1.0
+%%Creator: yetti:oz (Ozan Yigit)
+%%Title: stdin (ditroff)
+%%CreationDate: Thu Dec 13 15:56:08 1990
+%%EndComments
+% lib/psdit.pro -- prolog for psdit (ditroff) files
+% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved.
+% last edit: shore Sat Nov 23 20:28:03 1985
+% RCSID: $Header: /home/cvs/src/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Attic/readme.ps,v 1.1.1.1 1996/08/19 10:12:13 downsj Exp $
+
+/$DITroff 140 dict def $DITroff begin
+/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def
+/xi {0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto
+  /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F
+  /pagesave save def}def
+/PB{save /psv exch def currentpoint translate 
+  resolution 72 div dup neg scale 0 0 moveto}def
+/PE{psv restore}def
+/arctoobig 90 def /arctoosmall .05 def
+/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def
+/tan{dup sin exch cos div}def
+/point{resolution 72 div mul}def
+/dround	{transform round exch round exch itransform}def
+/xT{/devname exch def}def
+/xr{/mh exch def /my exch def /resolution exch def}def
+/xp{}def
+/xs{docsave restore end}def
+/xt{}def
+/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not
+ {fonts slotno fontname findfont put fontnames slotno fontname put}if}def
+/xH{/fontheight exch def F}def
+/xS{/fontslant exch def F}def
+/s{/fontsize exch def /fontheight fontsize def F}def
+/f{/fontnum exch def F}def
+/F{fontheight 0 le {/fontheight fontsize def}if
+   fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore
+   fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if
+   makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def
+/X{exch currentpoint exch pop moveto show}def
+/N{3 1 roll moveto show}def
+/Y{exch currentpoint pop exch moveto show}def
+/S{show}def
+/ditpush{}def/ditpop{}def
+/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def
+/AN{4 2 roll moveto 0 exch ashow}def
+/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def
+/AS{0 exch ashow}def
+/MX{currentpoint exch pop moveto}def
+/MY{currentpoint pop exch moveto}def
+/MXY{moveto}def
+/cb{pop}def	% action on unknown char -- nothing for now
+/n{}def/w{}def
+/p{pop showpage pagesave restore /pagesave save def}def
+/abspoint{currentpoint exch pop add exch currentpoint pop add exch}def
+/distance{dup mul exch dup mul add sqrt}def
+/dstroke{currentpoint stroke moveto}def
+/Dl{2 copy gsave rlineto stroke grestore rmoveto}def
+/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop
+ currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def
+ currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def
+/Dc{dup arcellipse dstroke}def
+/De{arcellipse dstroke}def
+/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def
+ /cradius centerv centerv mul centerh centerh mul add sqrt def
+ /eradius endv endv mul endh endh mul add sqrt def
+ /endang endv endh atan def
+ /startang centerv neg centerh neg atan def
+ /sweep startang endang sub dup 0 lt{360 add}if def
+ sweep arctoobig gt
+ {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def
+  /midh midang cos midrad mul def /midv midang sin midrad mul def
+  midh neg midv neg endh endv centerh centerv midh midv Da
+  currentpoint moveto Da}
+ {sweep arctoosmall ge
+  {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def
+  centerv neg controldelt mul centerh controldelt mul
+  endv neg controldelt mul centerh add endh add
+  endh controldelt mul centerv add endv add
+  centerh endh add centerv endv add rcurveto dstroke}
+ {centerh endh add centerv endv add rlineto dstroke}ifelse}ifelse}def
+
+/Barray 200 array def % 200 values in a wiggle
+/D~{mark}def
+/D~~{counttomark Barray exch 0 exch getinterval astore /Bcontrol exch def pop
+ /Blen Bcontrol length def Blen 4 ge Blen 2 mod 0 eq and
+ {Bcontrol 0 get Bcontrol 1 get abspoint /Ycont exch def /Xcont exch def
+  Bcontrol 0 2 copy get 2 mul put Bcontrol 1 2 copy get 2 mul put
+  Bcontrol Blen 2 sub 2 copy get 2 mul put
+  Bcontrol Blen 1 sub 2 copy get 2 mul put
+  /Ybi /Xbi currentpoint 3 1 roll def def 0 2 Blen 4 sub
+  {/i exch def
+   Bcontrol i get 3 div Bcontrol i 1 add get 3 div
+   Bcontrol i get 3 mul Bcontrol i 2 add get add 6 div
+   Bcontrol i 1 add get 3 mul Bcontrol i 3 add get add 6 div
+   /Xbi Xcont Bcontrol i 2 add get 2 div add def
+   /Ybi Ycont Bcontrol i 3 add get 2 div add def
+   /Xcont Xcont Bcontrol i 2 add get add def
+   /Ycont Ycont Bcontrol i 3 add get add def
+   Xbi currentpoint pop sub Ybi currentpoint exch pop sub rcurveto
+  }for dstroke}if}def
+end
+/ditstart{$DITroff begin
+ /nfonts 60 def			% NFONTS makedev/ditroff dependent!
+ /fonts[nfonts{0}repeat]def
+ /fontnames[nfonts{()}repeat]def
+/docsave save def
+}def
+
+% character outcalls
+/oc {/pswid exch def /cc exch def /name exch def
+   /ditwid pswid fontsize mul resolution mul 72000 div def
+   /ditsiz fontsize resolution mul 72 div def
+   ocprocs name known{ocprocs name get exec}{name cb}
+   ifelse}def
+/fractm [.65 0 0 .6 0 0] def
+/fraction
+ {/fden exch def /fnum exch def gsave /cf currentfont def
+  cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto
+  fnum show rmoveto currentfont cf setfont(\244)show setfont fden show 
+  grestore ditwid 0 rmoveto} def
+/oce {grestore ditwid 0 rmoveto}def
+/dm {ditsiz mul}def
+/ocprocs 50 dict def ocprocs begin
+(14){(1)(4)fraction}def
+(12){(1)(2)fraction}def
+(34){(3)(4)fraction}def
+(13){(1)(3)fraction}def
+(23){(2)(3)fraction}def
+(18){(1)(8)fraction}def
+(38){(3)(8)fraction}def
+(58){(5)(8)fraction}def
+(78){(7)(8)fraction}def
+(sr){gsave 0 .06 dm rmoveto(\326)show oce}def
+(is){gsave 0 .15 dm rmoveto(\362)show oce}def
+(->){gsave 0 .02 dm rmoveto(\256)show oce}def
+(<-){gsave 0 .02 dm rmoveto(\254)show oce}def
+(==){gsave 0 .05 dm rmoveto(\272)show oce}def
+end
+
+% an attempt at a PostScript FONT to implement ditroff special chars
+% this will enable us to 
+%	cache the little buggers
+%	generate faster, more compact PS out of psdit
+%	confuse everyone (including myself)!
+50 dict dup begin
+/FontType 3 def
+/FontName /DIThacks def
+/FontMatrix [.001 0 0 .001 0 0] def
+/FontBBox [-260 -260 900 900] def% a lie but ...
+/Encoding 256 array def
+0 1 255{Encoding exch /.notdef put}for
+Encoding
+ dup 8#040/space put %space
+ dup 8#110/rc put %right ceil
+ dup 8#111/lt put %left  top curl
+ dup 8#112/bv put %bold vert
+ dup 8#113/lk put %left  mid curl
+ dup 8#114/lb put %left  bot curl
+ dup 8#115/rt put %right top curl
+ dup 8#116/rk put %right mid curl
+ dup 8#117/rb put %right bot curl
+ dup 8#120/rf put %right floor
+ dup 8#121/lf put %left  floor
+ dup 8#122/lc put %left  ceil
+ dup 8#140/sq put %square
+ dup 8#141/bx put %box
+ dup 8#142/ci put %circle
+ dup 8#143/br put %box rule
+ dup 8#144/rn put %root extender
+ dup 8#145/vr put %vertical rule
+ dup 8#146/ob put %outline bullet
+ dup 8#147/bu put %bullet
+ dup 8#150/ru put %rule
+ dup 8#151/ul put %underline
+ pop
+/DITfd 100 dict def
+/BuildChar{0 begin
+ /cc exch def /fd exch def
+ /charname fd /Encoding get cc get def
+ /charwid fd /Metrics get charname get def
+ /charproc fd /CharProcs get charname get def
+ charwid 0 fd /FontBBox get aload pop setcachedevice
+ 2 setlinejoin 40 setlinewidth
+ newpath 0 0 moveto gsave charproc grestore
+ end}def
+/BuildChar load 0 DITfd put
+%/UniqueID 5 def
+/CharProcs 50 dict def
+CharProcs begin
+/space{}def
+/.notdef{}def
+/ru{500 0 rls}def
+/rn{0 840 moveto 500 0 rls}def
+/vr{0 800 moveto 0 -770 rls}def
+/bv{0 800 moveto 0 -1000 rls}def
+/br{0 750 moveto 0 -1000 rls}def
+/ul{0 -140 moveto 500 0 rls}def
+/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def
+/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def
+/sq{80 0 rmoveto currentpoint dround newpath moveto
+    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def
+/bx{80 0 rmoveto currentpoint dround newpath moveto
+    640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def
+/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc
+    50 setlinewidth stroke}def
+
+/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def
+/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def
+/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def
+/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def
+/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub
+    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
+/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub
+    0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def
+/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def
+/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def
+/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def
+/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def
+end
+
+/Metrics 50 dict def Metrics begin
+/.notdef 0 def
+/space 500 def
+/ru 500 def
+/br 0 def
+/lt 416 def
+/lb 416 def
+/rt 416 def
+/rb 416 def
+/lk 416 def
+/rk 416 def
+/rc 416 def
+/lc 416 def
+/rf 416 def
+/lf 416 def
+/bv 416 def
+/ob 350 def
+/bu 350 def
+/ci 750 def
+/bx 750 def
+/sq 750 def
+/rn 500 def
+/ul 500 def
+/vr 0 def
+end
+
+DITfd begin
+/s2 500 def /s4 250 def /s3 333 def
+/a4p{arcto pop pop pop pop}def
+/2cx{2 copy exch}def
+/rls{rlineto stroke}def
+/currx{currentpoint pop}def
+/dround{transform round exch round exch itransform} def
+end
+end
+/DIThacks exch definefont pop
+ditstart
+(psc)xT
+576 1 1 xr
+1(Times-Roman)xf 1 f
+2(Times-Italic)xf 2 f
+3(Times-Bold)xf 3 f
+4(Times-BoldItalic)xf 4 f
+5(Helvetica)xf 5 f
+6(Helvetica-Bold)xf 6 f
+7(Courier)xf 7 f
+8(Courier-Bold)xf 8 f
+9(Symbol)xf 9 f
+10(DIThacks)xf 10 f
+10 s
+1 f
+xi
+%%EndProlog
+
+%%Page: 1 1
+10 s 0 xH 0 xS 1 f
+8 s
+2 f
+12 s
+1778 672(sdbm)N
+3 f
+2004(\320)X
+2124(Substitute)X
+2563(DBM)X
+2237 768(or)N
+1331 864(Berkeley)N
+2 f
+1719(ndbm)X
+3 f
+1956(for)X
+2103(Every)X
+2373(UN*X)X
+1 f
+10 s
+2628 832(1)N
+3 f
+12 s
+2692 864(Made)N
+2951(Simple)X
+2 f
+10 s
+2041 1056(Ozan)N
+2230(\(oz\))X
+2375(Yigit)X
+1 f
+1658 1200(The)N
+1803(Guild)X
+2005(of)X
+2092(PD)X
+2214(Software)X
+2524(Toolmakers)X
+2000 1296(Toronto)N
+2278(-)X
+2325(Canada)X
+1965 1488(oz@nexus.yorku.ca)N
+2 f
+555 1804(Implementation)N
+1078(is)X
+1151(the)X
+1269(sincerest)X
+1574(form)X
+1745(of)X
+1827(\257attery.)X
+2094(\320)X
+2185(L.)X
+2269(Peter)X
+2463(Deutsch)X
+3 f
+555 1996(A)N
+633(The)X
+786(Clone)X
+1006(of)X
+1093(the)X
+2 f
+1220(ndbm)X
+3 f
+1418(library)X
+1 f
+755 2120(The)N
+903(sources)X
+1167(accompanying)X
+1658(this)X
+1796(notice)X
+2015(\320)X
+2 f
+2118(sdbm)X
+1 f
+2309(\320)X
+2411(constitute)X
+2744(the)X
+2864(\256rst)X
+3010(public)X
+3232(release)X
+3478(\(Dec.)X
+3677(1990\))X
+3886(of)X
+3975(a)X
+555 2216(complete)N
+874(clone)X
+1073(of)X
+1165(the)X
+1288(Berkeley)X
+1603(UN*X)X
+2 f
+1842(ndbm)X
+1 f
+2045(library.)X
+2304(The)X
+2 f
+2454(sdbm)X
+1 f
+2648(library)X
+2887(is)X
+2965(meant)X
+3186(to)X
+3273(clone)X
+3472(the)X
+3594(proven)X
+3841(func-)X
+555 2312(tionality)N
+846(of)X
+2 f
+938(ndbm)X
+1 f
+1141(as)X
+1233(closely)X
+1485(as)X
+1576(possible,)X
+1882(including)X
+2208(a)X
+2268(few)X
+2413(improvements.)X
+2915(It)X
+2988(is)X
+3065(practical,)X
+3386(easy)X
+3553(to)X
+3639(understand,)X
+555 2408(and)N
+691(compatible.)X
+1107(The)X
+2 f
+1252(sdbm)X
+1 f
+1441(library)X
+1675(is)X
+1748(not)X
+1870(derived)X
+2131(from)X
+2307(any)X
+2443(licensed,)X
+2746(proprietary)X
+3123(or)X
+3210(copyrighted)X
+3613(software.)X
+755 2532(The)N
+2 f
+910(sdbm)X
+1 f
+1109(implementation)X
+1641(is)X
+1723(based)X
+1935(on)X
+2044(a)X
+2109(1978)X
+2298(algorithm)X
+2638([Lar78])X
+2913(by)X
+3022(P.-A.)X
+3220(\(Paul\))X
+3445(Larson)X
+3697(known)X
+3944(as)X
+555 2628(``Dynamic)N
+934(Hashing''.)X
+1326(In)X
+1424(the)X
+1553(course)X
+1794(of)X
+1892(searching)X
+2231(for)X
+2355(a)X
+2421(substitute)X
+2757(for)X
+2 f
+2881(ndbm)X
+1 f
+3059(,)X
+3109(I)X
+3166(prototyped)X
+3543(three)X
+3734(different)X
+555 2724(external-hashing)N
+1119(algorithms)X
+1490([Lar78,)X
+1758(Fag79,)X
+2007(Lit80])X
+2236(and)X
+2381(ultimately)X
+2734(chose)X
+2946(Larson's)X
+3256(algorithm)X
+3596(as)X
+3692(a)X
+3756(basis)X
+3944(of)X
+555 2820(the)N
+2 f
+680(sdbm)X
+1 f
+875(implementation.)X
+1423(The)X
+1574(Bell)X
+1733(Labs)X
+2 f
+1915(dbm)X
+1 f
+2079(\(and)X
+2248(therefore)X
+2 f
+2565(ndbm)X
+1 f
+2743(\))X
+2796(is)X
+2875(based)X
+3084(on)X
+3190(an)X
+3292(algorithm)X
+3629(invented)X
+3931(by)X
+555 2916(Ken)N
+709(Thompson,)X
+1091([Tho90,)X
+1367(Tor87])X
+1610(and)X
+1746(predates)X
+2034(Larson's)X
+2335(work.)X
+755 3040(The)N
+2 f
+903(sdbm)X
+1 f
+1095(programming)X
+1553(interface)X
+1857(is)X
+1932(totally)X
+2158(compatible)X
+2536(with)X
+2 f
+2700(ndbm)X
+1 f
+2900(and)X
+3038(includes)X
+3327(a)X
+3385(slight)X
+3584(improvement)X
+555 3136(in)N
+641(database)X
+942(initialization.)X
+1410(It)X
+1483(is)X
+1560(also)X
+1713(expected)X
+2023(to)X
+2109(be)X
+2208(binary-compatible)X
+2819(under)X
+3025(most)X
+3203(UN*X)X
+3440(versions)X
+3730(that)X
+3873(sup-)X
+555 3232(port)N
+704(the)X
+2 f
+822(ndbm)X
+1 f
+1020(library.)X
+755 3356(The)N
+2 f
+909(sdbm)X
+1 f
+1107(implementation)X
+1638(shares)X
+1868(the)X
+1995(shortcomings)X
+2455(of)X
+2551(the)X
+2 f
+2678(ndbm)X
+1 f
+2885(library,)X
+3148(as)X
+3244(a)X
+3309(side)X
+3467(effect)X
+3680(of)X
+3775(various)X
+555 3452(simpli\256cations)N
+1046(to)X
+1129(the)X
+1248(original)X
+1518(Larson)X
+1762(algorithm.)X
+2114(It)X
+2183(does)X
+2350(produce)X
+2 f
+2629(holes)X
+1 f
+2818(in)X
+2900(the)X
+3018(page)X
+3190(\256le)X
+3312(as)X
+3399(it)X
+3463(writes)X
+3679(pages)X
+3882(past)X
+555 3548(the)N
+680(end)X
+823(of)X
+917(\256le.)X
+1066(\(Larson's)X
+1400(paper)X
+1605(include)X
+1867(a)X
+1929(clever)X
+2152(solution)X
+2435(to)X
+2523(this)X
+2664(problem)X
+2957(that)X
+3103(is)X
+3182(a)X
+3244(result)X
+3448(of)X
+3541(using)X
+3740(the)X
+3864(hash)X
+555 3644(value)N
+758(directly)X
+1032(as)X
+1128(a)X
+1193(block)X
+1400(address.\))X
+1717(On)X
+1844(the)X
+1971(other)X
+2165(hand,)X
+2370(extensive)X
+2702(tests)X
+2873(seem)X
+3067(to)X
+3158(indicate)X
+3441(that)X
+2 f
+3590(sdbm)X
+1 f
+3787(creates)X
+555 3740(fewer)N
+762(holes)X
+954(in)X
+1039(general,)X
+1318(and)X
+1456(the)X
+1576(resulting)X
+1878(page\256les)X
+2185(are)X
+2306(smaller.)X
+2584(The)X
+2 f
+2731(sdbm)X
+1 f
+2922(implementation)X
+3446(is)X
+3521(also)X
+3672(faster)X
+3873(than)X
+2 f
+555 3836(ndbm)N
+1 f
+757(in)X
+843(database)X
+1144(creation.)X
+1467(Unlike)X
+1709(the)X
+2 f
+1831(ndbm)X
+1 f
+2009(,)X
+2053(the)X
+2 f
+2175(sdbm)X
+7 f
+2396(store)X
+1 f
+2660(operation)X
+2987(will)X
+3134(not)X
+3259(``wander)X
+3573(away'')X
+3820(trying)X
+555 3932(to)N
+642(split)X
+804(its)X
+904(data)X
+1063(pages)X
+1271(to)X
+1358(insert)X
+1561(a)X
+1622(datum)X
+1847(that)X
+2 f
+1992(cannot)X
+1 f
+2235(\(due)X
+2403(to)X
+2490(elaborate)X
+2810(worst-case)X
+3179(situations\))X
+3537(be)X
+3637(inserted.)X
+3935(\(It)X
+555 4028(will)N
+699(fail)X
+826(after)X
+994(a)X
+1050(pre-de\256ned)X
+1436(number)X
+1701(of)X
+1788(attempts.\))X
+3 f
+555 4220(Important)N
+931(Compatibility)X
+1426(Warning)X
+1 f
+755 4344(The)N
+2 f
+904(sdbm)X
+1 f
+1097(and)X
+2 f
+1237(ndbm)X
+1 f
+1439(libraries)X
+2 f
+1726(cannot)X
+1 f
+1968(share)X
+2162(databases:)X
+2515(one)X
+2654(cannot)X
+2891(read)X
+3053(the)X
+3174(\(dir/pag\))X
+3478(database)X
+3778(created)X
+555 4440(by)N
+657(the)X
+777(other.)X
+984(This)X
+1148(is)X
+1222(due)X
+1359(to)X
+1442(the)X
+1561(differences)X
+1940(between)X
+2229(the)X
+2 f
+2348(ndbm)X
+1 f
+2547(and)X
+2 f
+2684(sdbm)X
+1 f
+2874(algorithms)X
+8 s
+3216 4415(2)N
+10 s
+4440(,)Y
+3289(and)X
+3426(the)X
+3545(hash)X
+3713(functions)X
+555 4536(used.)N
+769(It)X
+845(is)X
+925(easy)X
+1094(to)X
+1182(convert)X
+1449(between)X
+1743(the)X
+2 f
+1867(dbm/ndbm)X
+1 f
+2231(databases)X
+2565(and)X
+2 f
+2707(sdbm)X
+1 f
+2902(by)X
+3008(ignoring)X
+3305(the)X
+3429(index)X
+3633(completely:)X
+555 4632(see)N
+7 f
+706(dbd)X
+1 f
+(,)S
+7 f
+918(dbu)X
+1 f
+1082(etc.)X
+3 f
+555 4852(Notice)N
+794(of)X
+881(Intellectual)X
+1288(Property)X
+2 f
+555 4976(The)N
+696(entire)X
+1 f
+904(sdbm)X
+2 f
+1118(library)X
+1361(package,)X
+1670(as)X
+1762(authored)X
+2072(by)X
+2169(me,)X
+1 f
+2304(Ozan)X
+2495(S.)X
+2580(Yigit,)X
+2 f
+2785(is)X
+2858(hereby)X
+3097(placed)X
+3331(in)X
+3413(the)X
+3531(public)X
+3751(domain.)X
+1 f
+555 5072(As)N
+670(such,)X
+863(the)X
+987(author)X
+1218(is)X
+1297(not)X
+1425(responsible)X
+1816(for)X
+1936(the)X
+2060(consequences)X
+2528(of)X
+2621(use)X
+2754(of)X
+2847(this)X
+2988(software,)X
+3310(no)X
+3415(matter)X
+3645(how)X
+3808(awful,)X
+555 5168(even)N
+727(if)X
+796(they)X
+954(arise)X
+1126(from)X
+1302(defects)X
+1550(in)X
+1632(it.)X
+1716(There)X
+1924(is)X
+1997(no)X
+2097(expressed)X
+2434(or)X
+2521(implied)X
+2785(warranty)X
+3091(for)X
+3205(the)X
+2 f
+3323(sdbm)X
+1 f
+3512(library.)X
+8 s
+10 f
+555 5316(hhhhhhhhhhhhhhhhhh)N
+6 s
+1 f
+635 5391(1)N
+8 s
+691 5410(UN*X)N
+877(is)X
+936(not)X
+1034(a)X
+1078(trademark)X
+1352(of)X
+1421(any)X
+1529(\(dis\)organization.)X
+6 s
+635 5485(2)N
+8 s
+691 5504(Torek's)N
+908(discussion)X
+1194([Tor87])X
+1411(indicates)X
+1657(that)X
+2 f
+1772(dbm/ndbm)X
+1 f
+2061(implementations)X
+2506(use)X
+2609(the)X
+2705(hash)X
+2840(value)X
+2996(to)X
+3064(traverse)X
+3283(the)X
+3379(radix)X
+3528(trie)X
+3631(dif-)X
+555 5584(ferently)N
+772(than)X
+2 f
+901(sdbm)X
+1 f
+1055(and)X
+1166(as)X
+1238(a)X
+1285(result,)X
+1462(the)X
+1559(page)X
+1698(indexes)X
+1912(are)X
+2008(generated)X
+2274(in)X
+2 f
+2343(different)X
+1 f
+2579(order.)X
+2764(For)X
+2872(more)X
+3021(information,)X
+3357(send)X
+3492(e-mail)X
+3673(to)X
+555 5664(the)N
+649(author.)X
+
+2 p
+%%Page: 2 2
+8 s 0 xH 0 xS 1 f
+10 s
+2216 384(-)N
+2263(2)X
+2323(-)X
+755 672(Since)N
+971(the)X
+2 f
+1107(sdbm)X
+1 f
+1314(library)X
+1566(package)X
+1868(is)X
+1959(in)X
+2058(the)X
+2193(public)X
+2430(domain,)X
+2727(this)X
+2 f
+2879(original)X
+1 f
+3173(release)X
+3434(or)X
+3538(any)X
+3691(additional)X
+555 768(public-domain)N
+1045(releases)X
+1323(of)X
+1413(the)X
+1534(modi\256ed)X
+1841(original)X
+2112(cannot)X
+2348(possibly)X
+2636(\(by)X
+2765(de\256nition\))X
+3120(be)X
+3218(withheld)X
+3520(from)X
+3698(you.)X
+3860(Also)X
+555 864(by)N
+659(de\256nition,)X
+1009(You)X
+1170(\(singular\))X
+1505(have)X
+1680(all)X
+1783(the)X
+1904(rights)X
+2109(to)X
+2194(this)X
+2332(code)X
+2507(\(including)X
+2859(the)X
+2980(right)X
+3154(to)X
+3239(sell)X
+3373(without)X
+3640(permission,)X
+555 960(the)N
+679(right)X
+856(to)X
+944(hoard)X
+8 s
+1127 935(3)N
+10 s
+1185 960(and)N
+1327(the)X
+1451(right)X
+1628(to)X
+1716(do)X
+1821(other)X
+2011(icky)X
+2174(things)X
+2394(as)X
+2486(you)X
+2631(see)X
+2759(\256t\))X
+2877(but)X
+3004(those)X
+3198(rights)X
+3405(are)X
+3529(also)X
+3683(granted)X
+3949(to)X
+555 1056(everyone)N
+870(else.)X
+755 1180(Please)N
+997(note)X
+1172(that)X
+1329(all)X
+1446(previous)X
+1759(distributions)X
+2195(of)X
+2298(this)X
+2449(software)X
+2762(contained)X
+3110(a)X
+3182(copyright)X
+3525(\(which)X
+3784(is)X
+3873(now)X
+555 1276(dropped\))N
+868(to)X
+953(protect)X
+1199(its)X
+1297(origins)X
+1542(and)X
+1681(its)X
+1779(current)X
+2030(public)X
+2253(domain)X
+2516(status)X
+2721(against)X
+2970(any)X
+3108(possible)X
+3392(claims)X
+3623(and/or)X
+3850(chal-)X
+555 1372(lenges.)N
+3 f
+555 1564(Acknowledgments)N
+1 f
+755 1688(Many)N
+966(people)X
+1204(have)X
+1380(been)X
+1556(very)X
+1723(helpful)X
+1974(and)X
+2114(supportive.)X
+2515(A)X
+2596(partial)X
+2824(list)X
+2944(would)X
+3167(necessarily)X
+3547(include)X
+3806(Rayan)X
+555 1784(Zacherissen)N
+963(\(who)X
+1152(contributed)X
+1541(the)X
+1663(man)X
+1824(page,)X
+2019(and)X
+2158(also)X
+2310(hacked)X
+2561(a)X
+2620(MMAP)X
+2887(version)X
+3146(of)X
+2 f
+3236(sdbm)X
+1 f
+3405(\),)X
+3475(Arnold)X
+3725(Robbins,)X
+555 1880(Chris)N
+763(Lewis,)X
+1013(Bill)X
+1166(Davidsen,)X
+1523(Henry)X
+1758(Spencer,)X
+2071(Geoff)X
+2293(Collyer,)X
+2587(Rich)X
+2772(Salz)X
+2944(\(who)X
+3143(got)X
+3279(me)X
+3411(started)X
+3659(in)X
+3755(the)X
+3887(\256rst)X
+555 1976(place\),)N
+792(Johannes)X
+1106(Ruschein)X
+1424(\(who)X
+1609(did)X
+1731(the)X
+1849(minix)X
+2055(port\))X
+2231(and)X
+2367(David)X
+2583(Tilbrook.)X
+2903(I)X
+2950(thank)X
+3148(you)X
+3288(all.)X
+3 f
+555 2168(Distribution)N
+992(Manifest)X
+1315(and)X
+1463(Notes)X
+1 f
+555 2292(This)N
+717(distribution)X
+1105(of)X
+2 f
+1192(sdbm)X
+1 f
+1381(includes)X
+1668(\(at)X
+1773(least\))X
+1967(the)X
+2085(following:)X
+7 f
+747 2436(CHANGES)N
+1323(change)X
+1659(log)X
+747 2532(README)N
+1323(this)X
+1563(file.)X
+747 2628(biblio)N
+1323(a)X
+1419(small)X
+1707(bibliography)X
+2331(on)X
+2475(external)X
+2907(hashing)X
+747 2724(dba.c)N
+1323(a)X
+1419(crude)X
+1707(\(n/s\)dbm)X
+2139(page)X
+2379(file)X
+2619(analyzer)X
+747 2820(dbd.c)N
+1323(a)X
+1419(crude)X
+1707(\(n/s\)dbm)X
+2139(page)X
+2379(file)X
+2619(dumper)X
+2955(\(for)X
+3195(conversion\))X
+747 2916(dbe.1)N
+1323(man)X
+1515(page)X
+1755(for)X
+1947(dbe.c)X
+747 3012(dbe.c)N
+1323(Janick's)X
+1755(database)X
+2187(editor)X
+747 3108(dbm.c)N
+1323(a)X
+1419(dbm)X
+1611(library)X
+1995(emulation)X
+2475(wrapper)X
+2859(for)X
+3051(ndbm/sdbm)X
+747 3204(dbm.h)N
+1323(header)X
+1659(file)X
+1899(for)X
+2091(the)X
+2283(above)X
+747 3300(dbu.c)N
+1323(a)X
+1419(crude)X
+1707(db)X
+1851(management)X
+2379(utility)X
+747 3396(hash.c)N
+1323(hashing)X
+1707(function)X
+747 3492(makefile)N
+1323(guess.)X
+747 3588(pair.c)N
+1323(page-level)X
+1851(routines)X
+2283(\(posted)X
+2667(earlier\))X
+747 3684(pair.h)N
+1323(header)X
+1659(file)X
+1899(for)X
+2091(the)X
+2283(above)X
+747 3780(readme.ms)N
+1323(troff)X
+1611(source)X
+1947(for)X
+2139(the)X
+2331(README)X
+2667(file)X
+747 3876(sdbm.3)N
+1323(man)X
+1515(page)X
+747 3972(sdbm.c)N
+1323(the)X
+1515(real)X
+1755(thing)X
+747 4068(sdbm.h)N
+1323(header)X
+1659(file)X
+1899(for)X
+2091(the)X
+2283(above)X
+747 4164(tune.h)N
+1323(place)X
+1611(for)X
+1803(tuning)X
+2139(&)X
+2235(portability)X
+2811(thingies)X
+747 4260(util.c)N
+1323(miscellaneous)X
+755 4432(dbu)N
+1 f
+924(is)X
+1002(a)X
+1063(simple)X
+1301(database)X
+1603(manipulation)X
+2050(program)X
+8 s
+2322 4407(4)N
+10 s
+2379 4432(that)N
+2524(tries)X
+2687(to)X
+2774(look)X
+2941(like)X
+3086(Bell)X
+3244(Labs')X
+7 f
+3480(cbt)X
+1 f
+3649(utility.)X
+3884(It)X
+3958(is)X
+555 4528(currently)N
+867(incomplete)X
+1245(in)X
+1329(functionality.)X
+1800(I)X
+1849(use)X
+7 f
+2006(dbu)X
+1 f
+2172(to)X
+2255(test)X
+2387(out)X
+2510(the)X
+2629(routines:)X
+2930(it)X
+2995(takes)X
+3181(\(from)X
+3385(stdin\))X
+3588(tab)X
+3707(separated)X
+555 4624(key/value)N
+898(pairs)X
+1085(for)X
+1210(commands)X
+1587(like)X
+7 f
+1765(build)X
+1 f
+2035(or)X
+7 f
+2160(insert)X
+1 f
+2478(or)X
+2575(takes)X
+2770(keys)X
+2947(for)X
+3071(commands)X
+3448(like)X
+7 f
+3626(delete)X
+1 f
+3944(or)X
+7 f
+555 4720(look)N
+1 f
+(.)S
+7 f
+747 4864(dbu)N
+939(<build|creat|look|insert|cat|delete>)X
+2715(dbmfile)X
+755 5036(dba)N
+1 f
+927(is)X
+1008(a)X
+1072(crude)X
+1279(analyzer)X
+1580(of)X
+2 f
+1675(dbm/sdbm/ndbm)X
+1 f
+2232(page)X
+2412(\256les.)X
+2593(It)X
+2670(scans)X
+2872(the)X
+2998(entire)X
+3209(page)X
+3389(\256le,)X
+3538(reporting)X
+3859(page)X
+555 5132(level)N
+731(statistics,)X
+1046(and)X
+1182(totals)X
+1375(at)X
+1453(the)X
+1571(end.)X
+7 f
+755 5256(dbd)N
+1 f
+925(is)X
+1004(a)X
+1066(crude)X
+1271(dump)X
+1479(program)X
+1777(for)X
+2 f
+1897(dbm/ndbm/sdbm)X
+1 f
+2452(databases.)X
+2806(It)X
+2881(ignores)X
+3143(the)X
+3267(bitmap,)X
+3534(and)X
+3675(dumps)X
+3913(the)X
+555 5352(data)N
+717(pages)X
+928(in)X
+1018(sequence.)X
+1361(It)X
+1437(can)X
+1576(be)X
+1679(used)X
+1853(to)X
+1942(create)X
+2162(input)X
+2353(for)X
+2474(the)X
+7 f
+2627(dbu)X
+1 f
+2798(utility.)X
+3055(Note)X
+3238(that)X
+7 f
+3413(dbd)X
+1 f
+3584(will)X
+3735(skip)X
+3895(any)X
+8 s
+10 f
+555 5432(hhhhhhhhhhhhhhhhhh)N
+6 s
+1 f
+635 5507(3)N
+8 s
+691 5526(You)N
+817(cannot)X
+1003(really)X
+1164(hoard)X
+1325(something)X
+1608(that)X
+1720(is)X
+1779(available)X
+2025(to)X
+2091(the)X
+2185(public)X
+2361(at)X
+2423(large,)X
+2582(but)X
+2680(try)X
+2767(if)X
+2822(it)X
+2874(makes)X
+3053(you)X
+3165(feel)X
+3276(any)X
+3384(better.)X
+6 s
+635 5601(4)N
+8 s
+691 5620(The)N
+7 f
+829(dbd)X
+1 f
+943(,)X
+7 f
+998(dba)X
+1 f
+1112(,)X
+7 f
+1167(dbu)X
+1 f
+1298(utilities)X
+1508(are)X
+1602(quick)X
+1761(hacks)X
+1923(and)X
+2032(are)X
+2126(not)X
+2225(\256t)X
+2295(for)X
+2385(production)X
+2678(use.)X
+2795(They)X
+2942(were)X
+3081(developed)X
+3359(late)X
+3467(one)X
+3575(night,)X
+555 5700(just)N
+664(to)X
+730(test)X
+835(out)X
+2 f
+933(sdbm)X
+1 f
+1068(,)X
+1100(and)X
+1208(convert)X
+1415(some)X
+1566(databases.)X
+
+3 p
+%%Page: 3 3
+8 s 0 xH 0 xS 1 f
+10 s
+2216 384(-)N
+2263(3)X
+2323(-)X
+555 672(NULLs)N
+821(in)X
+903(the)X
+1021(key)X
+1157(and)X
+1293(data)X
+1447(\256elds,)X
+1660(thus)X
+1813(is)X
+1886(unsuitable)X
+2235(to)X
+2317(convert)X
+2578(some)X
+2767(peculiar)X
+3046(databases)X
+3374(that)X
+3514(insist)X
+3702(in)X
+3784(includ-)X
+555 768(ing)N
+677(the)X
+795(terminating)X
+1184(null.)X
+755 892(I)N
+841(have)X
+1052(also)X
+1240(included)X
+1575(a)X
+1670(copy)X
+1885(of)X
+2011(the)X
+7 f
+2195(dbe)X
+1 f
+2397(\()X
+2 f
+2424(ndbm)X
+1 f
+2660(DataBase)X
+3026(Editor\))X
+3311(by)X
+3449(Janick)X
+3712(Bergeron)X
+555 988([janick@bnr.ca])N
+1098(for)X
+1212(your)X
+1379(pleasure.)X
+1687(You)X
+1845(may)X
+2003(\256nd)X
+2147(it)X
+2211(more)X
+2396(useful)X
+2612(than)X
+2770(the)X
+2888(little)X
+7 f
+3082(dbu)X
+1 f
+3246(utility.)X
+7 f
+755 1112(dbm.[ch])N
+1 f
+1169(is)X
+1252(a)X
+2 f
+1318(dbm)X
+1 f
+1486(library)X
+1730(emulation)X
+2079(on)X
+2188(top)X
+2319(of)X
+2 f
+2415(ndbm)X
+1 f
+2622(\(and)X
+2794(hence)X
+3011(suitable)X
+3289(for)X
+2 f
+3412(sdbm)X
+1 f
+3581(\).)X
+3657(Written)X
+3931(by)X
+555 1208(Robert)N
+793(Elz.)X
+755 1332(The)N
+2 f
+901(sdbm)X
+1 f
+1090(library)X
+1324(has)X
+1451(been)X
+1623(around)X
+1866(in)X
+1948(beta)X
+2102(test)X
+2233(for)X
+2347(quite)X
+2527(a)X
+2583(long)X
+2745(time,)X
+2927(and)X
+3063(from)X
+3239(whatever)X
+3554(little)X
+3720(feedback)X
+555 1428(I)N
+609(received)X
+909(\(maybe)X
+1177(no)X
+1284(news)X
+1476(is)X
+1555(good)X
+1741(news\),)X
+1979(I)X
+2032(believe)X
+2290(it)X
+2360(has)X
+2493(been)X
+2671(functioning)X
+3066(without)X
+3336(any)X
+3478(signi\256cant)X
+3837(prob-)X
+555 1524(lems.)N
+752(I)X
+805(would,)X
+1051(of)X
+1144(course,)X
+1400(appreciate)X
+1757(all)X
+1863(\256xes)X
+2040(and/or)X
+2271(improvements.)X
+2774(Portability)X
+3136(enhancements)X
+3616(would)X
+3841(espe-)X
+555 1620(cially)N
+753(be)X
+849(useful.)X
+3 f
+555 1812(Implementation)N
+1122(Issues)X
+1 f
+755 1936(Hash)N
+944(functions:)X
+1288(The)X
+1437(algorithm)X
+1772(behind)X
+2 f
+2014(sdbm)X
+1 f
+2207(implementation)X
+2733(needs)X
+2939(a)X
+2998(good)X
+3181(bit-scrambling)X
+3671(hash)X
+3841(func-)X
+555 2032(tion)N
+702(to)X
+787(be)X
+886(effective.)X
+1211(I)X
+1261(ran)X
+1387(into)X
+1534(a)X
+1593(set)X
+1705(of)X
+1795(constants)X
+2116(for)X
+2233(a)X
+2292(simple)X
+2528(hash)X
+2698(function)X
+2988(that)X
+3130(seem)X
+3317(to)X
+3401(help)X
+2 f
+3561(sdbm)X
+1 f
+3752(perform)X
+555 2128(better)N
+758(than)X
+2 f
+916(ndbm)X
+1 f
+1114(for)X
+1228(various)X
+1484(inputs:)X
+7 f
+747 2272(/*)N
+795 2368(*)N
+891(polynomial)X
+1419(conversion)X
+1947(ignoring)X
+2379(overflows)X
+795 2464(*)N
+891(65599)X
+1179(nice.)X
+1467(65587)X
+1755(even)X
+1995(better.)X
+795 2560(*/)N
+747 2656(long)N
+747 2752(dbm_hash\(char)N
+1419(*str,)X
+1707(int)X
+1899(len\))X
+2139({)X
+939 2848(register)N
+1371(unsigned)X
+1803(long)X
+2043(n)X
+2139(=)X
+2235(0;)X
+939 3040(while)N
+1227(\(len--\))X
+1131 3136(n)N
+1227(=)X
+1323(n)X
+1419(*)X
+1515(65599)X
+1803(+)X
+1899(*str++;)X
+939 3232(return)N
+1275(n;)X
+747 3328(})N
+1 f
+755 3500(There)N
+975(may)X
+1145(be)X
+1253(better)X
+1467(hash)X
+1645(functions)X
+1974(for)X
+2099(the)X
+2228(purposes)X
+2544(of)X
+2642(dynamic)X
+2949(hashing.)X
+3269(Try)X
+3416(your)X
+3594(favorite,)X
+3895(and)X
+555 3596(check)N
+766(the)X
+887(page\256le.)X
+1184(If)X
+1261(it)X
+1328(contains)X
+1618(too)X
+1743(many)X
+1944(pages)X
+2150(with)X
+2315(too)X
+2440(many)X
+2641(holes,)X
+2853(\(in)X
+2965(relation)X
+3233(to)X
+3318(this)X
+3456(one)X
+3595(for)X
+3712(example\))X
+555 3692(or)N
+656(if)X
+2 f
+739(sdbm)X
+1 f
+942(simply)X
+1193(stops)X
+1391(working)X
+1692(\(fails)X
+1891(after)X
+7 f
+2101(SPLTMAX)X
+1 f
+2471(attempts)X
+2776(to)X
+2872(split\))X
+3070(when)X
+3278(you)X
+3432(feed)X
+3604(your)X
+3784(NEWS)X
+7 f
+555 3788(history)N
+1 f
+912(\256le)X
+1035(to)X
+1118(it,)X
+1203(you)X
+1344(probably)X
+1650(do)X
+1751(not)X
+1874(have)X
+2047(a)X
+2104(good)X
+2285(hashing)X
+2555(function.)X
+2883(If)X
+2958(you)X
+3099(do)X
+3200(better)X
+3404(\(for)X
+3545(different)X
+3842(types)X
+555 3884(of)N
+642(input\),)X
+873(I)X
+920(would)X
+1140(like)X
+1280(to)X
+1362(know)X
+1560(about)X
+1758(the)X
+1876(function)X
+2163(you)X
+2303(use.)X
+755 4008(Block)N
+967(sizes:)X
+1166(It)X
+1236(seems)X
+1453(\(from)X
+1657(various)X
+1914(tests)X
+2077(on)X
+2178(a)X
+2235(few)X
+2377(machines\))X
+2727(that)X
+2867(a)X
+2923(page)X
+3095(\256le)X
+3217(block)X
+3415(size)X
+7 f
+3588(PBLKSIZ)X
+1 f
+3944(of)X
+555 4104(1024)N
+738(is)X
+814(by)X
+917(far)X
+1030(the)X
+1150(best)X
+1301(for)X
+1417(performance,)X
+1866(but)X
+1990(this)X
+2127(also)X
+2278(happens)X
+2563(to)X
+2647(limit)X
+2819(the)X
+2939(size)X
+3086(of)X
+3175(a)X
+3233(key/value)X
+3567(pair.)X
+3734(Depend-)X
+555 4200(ing)N
+681(on)X
+785(your)X
+956(needs,)X
+1183(you)X
+1327(may)X
+1489(wish)X
+1663(to)X
+1748(increase)X
+2035(the)X
+2156(page)X
+2331(size,)X
+2499(and)X
+2638(also)X
+2790(adjust)X
+7 f
+3032(PAIRMAX)X
+1 f
+3391(\(the)X
+3539(maximum)X
+3886(size)X
+555 4296(of)N
+648(a)X
+710(key/value)X
+1048(pair)X
+1199(allowed:)X
+1501(should)X
+1740(always)X
+1989(be)X
+2090(at)X
+2173(least)X
+2345(three)X
+2531(words)X
+2752(smaller)X
+3013(than)X
+7 f
+3204(PBLKSIZ)X
+1 f
+(.\))S
+3612(accordingly.)X
+555 4392(The)N
+706(system-wide)X
+1137(version)X
+1399(of)X
+1492(the)X
+1616(library)X
+1856(should)X
+2095(probably)X
+2406(be)X
+2508(con\256gured)X
+2877(with)X
+3044(1024)X
+3229(\(distribution)X
+3649(default\),)X
+3944(as)X
+555 4488(this)N
+690(appears)X
+956(to)X
+1038(be)X
+1134(suf\256cient)X
+1452(for)X
+1566(most)X
+1741(common)X
+2041(uses)X
+2199(of)X
+2 f
+2286(sdbm)X
+1 f
+2455(.)X
+3 f
+555 4680(Portability)N
+1 f
+755 4804(This)N
+917(package)X
+1201(has)X
+1328(been)X
+1500(tested)X
+1707(in)X
+1789(many)X
+1987(different)X
+2284(UN*Xes)X
+2585(even)X
+2757(including)X
+3079(minix,)X
+3305(and)X
+3441(appears)X
+3707(to)X
+3789(be)X
+3885(rea-)X
+555 4900(sonably)N
+824(portable.)X
+1127(This)X
+1289(does)X
+1456(not)X
+1578(mean)X
+1772(it)X
+1836(will)X
+1980(port)X
+2129(easily)X
+2336(to)X
+2418(non-UN*X)X
+2799(systems.)X
+3 f
+555 5092(Notes)N
+767(and)X
+915(Miscellaneous)X
+1 f
+755 5216(The)N
+2 f
+913(sdbm)X
+1 f
+1115(is)X
+1201(not)X
+1336(a)X
+1405(very)X
+1581(complicated)X
+2006(package,)X
+2323(at)X
+2414(least)X
+2594(not)X
+2729(after)X
+2910(you)X
+3063(familiarize)X
+3444(yourself)X
+3739(with)X
+3913(the)X
+555 5312(literature)N
+879(on)X
+993(external)X
+1286(hashing.)X
+1589(There)X
+1811(are)X
+1944(other)X
+2143(interesting)X
+2514(algorithms)X
+2889(in)X
+2984(existence)X
+3316(that)X
+3469(ensure)X
+3712(\(approxi-)X
+555 5408(mately\))N
+825(single-read)X
+1207(access)X
+1438(to)X
+1525(a)X
+1586(data)X
+1745(value)X
+1944(associated)X
+2299(with)X
+2466(any)X
+2607(key.)X
+2768(These)X
+2984(are)X
+3107(directory-less)X
+3568(schemes)X
+3864(such)X
+555 5504(as)N
+2 f
+644(linear)X
+857(hashing)X
+1 f
+1132([Lit80])X
+1381(\(+)X
+1475(Larson)X
+1720(variations\),)X
+2 f
+2105(spiral)X
+2313(storage)X
+1 f
+2575([Mar79])X
+2865(or)X
+2954(directory)X
+3265(schemes)X
+3558(such)X
+3726(as)X
+2 f
+3814(exten-)X
+555 5600(sible)N
+731(hashing)X
+1 f
+1009([Fag79])X
+1288(by)X
+1393(Fagin)X
+1600(et)X
+1683(al.)X
+1786(I)X
+1838(do)X
+1943(hope)X
+2124(these)X
+2314(sources)X
+2579(provide)X
+2848(a)X
+2908(reasonable)X
+3276(playground)X
+3665(for)X
+3783(experi-)X
+555 5696(mentation)N
+907(with)X
+1081(other)X
+1277(algorithms.)X
+1690(See)X
+1837(the)X
+1966(June)X
+2144(1988)X
+2335(issue)X
+2526(of)X
+2624(ACM)X
+2837(Computing)X
+3227(Surveys)X
+3516([Enb88])X
+3810(for)X
+3935(an)X
+555 5792(excellent)N
+865(overview)X
+1184(of)X
+1271(the)X
+1389(\256eld.)X
+
+4 p
+%%Page: 4 4
+10 s 0 xH 0 xS 1 f
+2216 384(-)N
+2263(4)X
+2323(-)X
+3 f
+555 672(References)N
+1 f
+555 824([Lar78])N
+875(P.-A.)X
+1064(Larson,)X
+1327(``Dynamic)X
+1695(Hashing'',)X
+2 f
+2056(BIT)X
+1 f
+(,)S
+2216(vol.)X
+2378(18,)X
+2518(pp.)X
+2638(184-201,)X
+2945(1978.)X
+555 948([Tho90])N
+875(Ken)X
+1029(Thompson,)X
+2 f
+1411(private)X
+1658(communication)X
+1 f
+2152(,)X
+2192(Nov.)X
+2370(1990)X
+555 1072([Lit80])N
+875(W.)X
+992(Litwin,)X
+1246(``)X
+1321(Linear)X
+1552(Hashing:)X
+1862(A)X
+1941(new)X
+2096(tool)X
+2261(for)X
+2396(\256le)X
+2539(and)X
+2675(table)X
+2851(addressing'',)X
+2 f
+3288(Proceedings)X
+3709(of)X
+3791(the)X
+3909(6th)X
+875 1168(Conference)N
+1269(on)X
+1373(Very)X
+1548(Large)X
+1782(Dabatases)X
+2163(\(Montreal\))X
+1 f
+2515(,)X
+2558(pp.)X
+2701(212-223,)X
+3031(Very)X
+3215(Large)X
+3426(Database)X
+3744(Founda-)X
+875 1264(tion,)N
+1039(Saratoga,)X
+1360(Calif.,)X
+1580(1980.)X
+555 1388([Fag79])N
+875(R.)X
+969(Fagin,)X
+1192(J.)X
+1284(Nievergelt,)X
+1684(N.)X
+1803(Pippinger,)X
+2175(and)X
+2332(H.)X
+2451(R.)X
+2544(Strong,)X
+2797(``Extendible)X
+3218(Hashing)X
+3505(-)X
+3552(A)X
+3630(Fast)X
+3783(Access)X
+875 1484(Method)N
+1144(for)X
+1258(Dynamic)X
+1572(Files'',)X
+2 f
+1821(ACM)X
+2010(Trans.)X
+2236(Database)X
+2563(Syst.)X
+1 f
+2712(,)X
+2752(vol.)X
+2894(4,)X
+2994(no.3,)X
+3174(pp.)X
+3294(315-344,)X
+3601(Sept.)X
+3783(1979.)X
+555 1608([Wal84])N
+875(Rich)X
+1055(Wales,)X
+1305(``Discussion)X
+1739(of)X
+1835("dbm")X
+2072(data)X
+2235(base)X
+2406(system'',)X
+2 f
+2730(USENET)X
+3051(newsgroup)X
+3430(unix.wizards)X
+1 f
+3836(,)X
+3884(Jan.)X
+875 1704(1984.)N
+555 1828([Tor87])N
+875(Chris)X
+1068(Torek,)X
+1300(``Re:)X
+1505(dbm.a)X
+1743(and)X
+1899(ndbm.a)X
+2177(archives'',)X
+2 f
+2539(USENET)X
+2852(newsgroup)X
+3223(comp.unix)X
+1 f
+3555(,)X
+3595(1987.)X
+555 1952([Mar79])N
+875(G.)X
+974(N.)X
+1073(Martin,)X
+1332(``Spiral)X
+1598(Storage:)X
+1885(Incrementally)X
+2371(Augmentable)X
+2843(Hash)X
+3048(Addressed)X
+3427(Storage'',)X
+2 f
+3766(Techni-)X
+875 2048(cal)N
+993(Report)X
+1231(#27)X
+1 f
+(,)S
+1391(University)X
+1749(of)X
+1836(Varwick,)X
+2153(Coventry,)X
+2491(U.K.,)X
+2687(1979.)X
+555 2172([Enb88])N
+875(R.)X
+977(J.)X
+1057(Enbody)X
+1335(and)X
+1480(H.)X
+1586(C.)X
+1687(Du,)X
+1833(``Dynamic)X
+2209(Hashing)X
+2524(Schemes'',)X
+2 f
+2883(ACM)X
+3080(Computing)X
+3463(Surveys)X
+1 f
+3713(,)X
+3761(vol.)X
+3911(20,)X
+875 2268(no.)N
+995(2,)X
+1075(pp.)X
+1195(85-113,)X
+1462(June)X
+1629(1988.)X
+
+4 p
+%%Trailer
+xt
+
+xs
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.3 b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.3
new file mode 100644
index 00000000000..f0f2d07c841
--- /dev/null
+++ b/gnu/usr.bin/perl/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, dbm_open, dbm_prep, dbm_close, dbm_fetch, dbm_store, dbm_delete, dbm_firstkey, dbm_nextkey, dbm_hash, dbm_rdonly, dbm_error, dbm_clearerr, dbm_dirfno, dbm_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 *dbm_open(char *file, int flags, int mode)
+.sp
+\s-1DBM\s0 *dbm_prep(char *dirname, char *pagname, int flags, int mode)
+.sp
+void dbm_close(\s-1DBM\s0 *db)
+.sp
+datum dbm_fetch(\s-1DBM\s0 *db, key)
+.sp
+int dbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags)
+.sp
+int dbm_delete(\s-1DBM\s0 *db, datum key)
+.sp
+datum dbm_firstkey(\s-1DBM\s0 *db)
+.sp
+datum dbm_nextkey(\s-1DBM\s0 *db)
+.sp
+long dbm_hash(char *string, int len)
+.sp
+int dbm_rdonly(\s-1DBM\s0 *db)
+int dbm_error(\s-1DBM\s0 *db)
+dbm_clearerr(\s-1DBM\s0 *db)
+int dbm_dirfno(\s-1DBM\s0 *db)
+int dbm_pagfno(\s-1DBM\s0 *db)
+.ft R
+.fi
+.SH DESCRIPTION
+.IX "database library" sdbm "" "\fLsdbm\fR"
+.IX dbm_open "" "\fLdbm_open\fR \(em open \fLsdbm\fR database"
+.IX dbm_prep "" "\fLdbm_prep\fR \(em prepare \fLsdbm\fR database"
+.IX dbm_close "" "\fLdbm_close\fR \(em close \fLsdbm\fR routine"
+.IX dbm_fetch "" "\fLdbm_fetch\fR \(em fetch \fLsdbm\fR database data"
+.IX dbm_store "" "\fLdbm_store\fR \(em add data to \fLsdbm\fR database"
+.IX dbm_delete "" "\fLdbm_delete\fR \(em remove data from \fLsdbm\fR database"
+.IX dbm_firstkey "" "\fLdbm_firstkey\fR \(em access \fLsdbm\fR database"
+.IX dbm_nextkey "" "\fLdbm_nextkey\fR \(em access \fLsdbm\fR database"
+.IX dbm_hash "" "\fLdbm_hash\fR \(em string hash for \fLsdbm\fR database"
+.IX dbm_rdonly "" "\fLdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode"
+.IX dbm_error "" "\fLdbm_error\fR \(em return \fLsdbm\fR database error condition"
+.IX dbm_clearerr "" "\fLdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition"
+.IX dbm_dirfno "" "\fLdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor"
+.IX dbm_pagfno "" "\fLdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor"
+.IX "database functions \(em \fLsdbm\fR"  dbm_open  ""  \fLdbm_open\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_prep  ""  \fLdbm_prep\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_close  ""  \fLdbm_close\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_fetch  ""  \fLdbm_fetch\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_store  ""  \fLdbm_store\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_delete  ""  \fLdbm_delete\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_firstkey  ""  \fLdbm_firstkey\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_nextkey  ""  \fLdbm_nextkey\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_rdonly  ""  \fLdbm_rdonly\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_error  ""  \fLdbm_error\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_clearerr  ""  \fLdbm_clearerr\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_dirfno  ""  \fLdbm_dirfno\fP
+.IX "database functions \(em \fLsdbm\fR"  dbm_pagfno  ""  \fLdbm_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 dbm_open (\|)
+or
+.BR dbm_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 dbm_open (\|)
+will take a base file name and call
+.BR dbm_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 dbm_close (\|).
+.LP
+Given a handle, one can retrieve data associated with a key by using the
+.BR dbm_fetch (\|)
+routine, and associate data with a key by using the
+.BR dbm_store (\|)
+routine.
+.LP
+The values of the
+.I flags
+parameter for
+.BR dbm_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 dbm_delete (\|)
+routine.
+.LP
+To retrieve every key in the database, use a loop like:
+.sp
+.nf
+.ft B
+for (key = dbm_firstkey(db); key.dptr != NULL; key = dbm_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 dbm_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 dbm_rdonly (\|)
+returns true if the database has been opened read\-only.
+.IP
+.BR dbm_error (\|)
+returns true if an I/O error has occurred.
+.IP
+.BR dbm_clearerr (\|)
+allows you to clear the error flag if you think you know what the error
+was and insist on ignoring it.
+.IP
+.BR dbm_dirfno (\|)
+returns the file descriptor associated with the bitmap file.
+.IP
+.BR dbm_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 dbm_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 dbm_prep (\|),
+.BR dbm_hash (\|),
+.BR dbm_rdonly (\|),
+.BR dbm_dirfno (\|),
+and
+.BR dbm_pagfno (\|)
+functions are unique to this package.
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
new file mode 100644
index 00000000000..d4836be6710
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
@@ -0,0 +1,523 @@
+/*
+ * 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
+ */
+
+#ifndef lint
+static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $";
+#endif
+
+#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 sun
+extern int errno;
+#endif
+
+extern Malloc_t malloc proto((MEM_SIZE));
+extern Free_t free proto((Malloc_t));
+extern Off_t lseek();
+
+/*
+ * 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
+};
+
+datum nullitem = {NULL, 0};
+
+DBM *
+sdbm_open(file, flags, mode)
+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 = 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(dirname, pagname, flags, mode)
+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.
+ */
+#	ifdef OS2
+	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(db)
+register DBM *db;
+{
+	if (db == NULL)
+		errno = EINVAL;
+	else {
+		(void) close(db->dirf);
+		(void) close(db->pagf);
+		free((char *) db);
+	}
+}
+
+datum
+sdbm_fetch(db, key)
+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(db, key)
+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(db, key, val, flags)
+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(db, hash, need)
+register DBM *db;
+long 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(db)
+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(db)
+register DBM *db;
+{
+	if (db == NULL)
+		return errno = EINVAL, nullitem;
+	return getnext(db);
+}
+
+/*
+ * all important binary trie traversal
+ */
+static int
+getpage(db, hash)
+register DBM *db;
+register long 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(db, dbit)
+register DBM *db;
+register long 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(db, dbit)
+register DBM *db;
+register long 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(db)
+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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
new file mode 100644
index 00000000000..4d6c8448902
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
@@ -0,0 +1,234 @@
+/*
+ * 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 */
+#define DIRFEXT	".dir"
+#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;
+
+extern datum nullitem;
+
+#ifdef __STDC__
+#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
+
+#ifdef MYMALLOC
+#   ifdef HIDEMYMALLOC
+#	define malloc Mymalloc
+#	define realloc Myremalloc
+#	define free Myfree
+#   endif
+#   define safemalloc malloc
+#   define saferealloc realloc
+#   define safefree free
+#endif
+
+#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <setjmp.h>
+
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+
+#ifndef MSDOS
+#   ifdef PARAM_NEEDS_TYPES
+#	include <sys/types.h>
+#   endif
+#   include <sys/param.h>
+#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
+
+#ifdef I_STRING
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+
+#ifdef I_MEMORY
+#include <memory.h>
+#endif
+
+#if defined(mips) && defined(ultrix) && !defined(__STDC__)
+#   undef HAS_MEMCMP
+#endif
+
+#ifdef HAS_MEMCPY
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcpy
+        extern char * memcpy _((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 _((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 */
+
+#ifdef HAS_MEMCMP
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcmp
+	extern int memcmp _((char*, char*, int));
+#    endif
+#  endif
+#else
+#   ifndef memcmp
+#	define memcmp 	my_memcmp
+#   endif
+#endif /* HAS_MEMCMP */
+
+/* we prefer bcmp slightly for comparisons that don't care about ordering */
+#ifndef HAS_BCMP
+#   ifndef bcmp
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   endif
+#endif /* HAS_BCMP */
+
+#ifdef I_NETINET_IN
+#   include <netinet/in.h>
+#endif
+
+#endif /* Include guard */
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/tune.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/tune.h
new file mode 100644
index 00000000000..b95c8c8634a
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/SDBM_File/sdbm/util.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/util.c
new file mode 100644
index 00000000000..4b03d89f09a
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/util.c
@@ -0,0 +1,50 @@
+#include <stdio.h>
+#ifdef SDBM
+#include "sdbm.h"
+#else
+#include "ndbm.h"
+#endif
+
+void
+oops(s1, s2)
+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(pag)
+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/gnu/usr.bin/perl/ext/SDBM_File/typemap b/gnu/usr.bin/perl/ext/SDBM_File/typemap
new file mode 100644
index 00000000000..a6b0e5faa86
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/SDBM_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, na);
+	$var.dsize = (int)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/gnu/usr.bin/perl/ext/Safe/Makefile.PL b/gnu/usr.bin/perl/ext/Safe/Makefile.PL
new file mode 100644
index 00000000000..108109f61d4
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Safe/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME	=> 'Safe',
+    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
+    XSPROTOARG => '-noprototypes', 		# XXX remove later?
+    VERSION_FROM => 'Safe.pm',
+);
diff --git a/gnu/usr.bin/perl/ext/Safe/Safe.pm b/gnu/usr.bin/perl/ext/Safe/Safe.pm
new file mode 100644
index 00000000000..0fafcbe7411
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Safe/Safe.pm
@@ -0,0 +1,670 @@
+package Safe;
+
+use vars qw($VERSION @ISA @EXPORT_OK);
+
+require Exporter;
+require DynaLoader;
+use Carp;
+$VERSION = "1.00";
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname opdesc
+		MAXO emptymask fullmask);
+
+=head1 NAME
+
+Safe - Safe extension module for Perl
+
+=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 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 much 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.
+
+By default, the operator mask for a newly created compartment masks
+out all operations which give "access to the system" in some sense.
+This includes masking off operators such as I<system>, I<open>,
+I<chown>, and I<shmget> but does not mask off operators such as
+I<print>, I<sysread> and I<E<lt>HANDLE<gt>>. Those file operators
+are allowed since for the code in the compartment to have access
+to a filehandle, the code outside the compartment must have explicitly
+placed the filehandle variable inside the compartment.
+
+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
+
+=head2 Operator masks
+
+An operator mask exists at user-level as a string of bytes of length
+MAXO, each of which is either 0x00 or 0x01. Here, MAXO is the number
+of operators in the current version of perl. The subroutine MAXO()
+(available for export by package Safe) returns the number of operators
+in the current version of perl. Note that, unlike the beta versions of
+the Safe extension, this is a reliable count of the number of
+operators in the currently running perl executable. The presence of a
+0x01 byte at offset B<n> of the string indicates that operator number
+B<n> should be masked (i.e. disallowed).  The Safe extension makes
+available routines for converting from operator names to operator
+numbers (and I<vice versa>) and for converting from a list of operator
+names to the corresponding mask (and I<vice versa>).
+
+=head2 Methods in class Safe
+
+To create a new compartment, use
+
+    $cpt = new Safe;
+
+Optional arguments are (NAMESPACE, MASK), where
+
+=over 8
+
+=item NAMESPACE
+
+is the root namespace to use for the compartment (defaults to
+"Safe::Root000000000", auto-incremented for each new compartment); and
+
+=item MASK
+
+is the operator mask to use (defaults to a fairly restrictive set).
+
+=back
+
+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 root (NAMESPACE)
+
+This is a get-or-set method for the compartment's namespace. With the
+NAMESPACE argument present, it sets the root namespace for the
+compartment. With no NAMESPACE argument present, it returns the
+current root namespace of the compartment.
+
+=item mask (MASK)
+
+This is a get-or-set method for the compartment's operator mask.
+With the MASK argument present, it sets the operator mask for the
+compartment. With no MASK argument present, it returns the
+current operator mask of the compartment.
+
+=item trap (OP, ...)
+
+This sets bits in the compartment's operator mask corresponding
+to each operator named in the list of arguments. Each OP can be
+either the name of an operation or its number. See opcode.h or
+opcode.pl in the main perl distribution for a canonical list of
+operator names.
+
+=item untrap (OP, ...)
+
+This resets bits in the compartment's operator mask corresponding
+to each operator named in the list of arguments. Each OP can be
+either the name of an operation or its number. See opcode.h or
+opcode.pl in the main perl distribution for a canonical list of
+operator names.
+
+=item share (VARNAME, ...)
+
+This shares the variable(s) in the argument list with the compartment.
+Each VARNAME must be the B<name> of a variable with a leading type
+identifier included. Examples of legal variable names are '$foo' for
+a scalar, '@foo' for an array, '%foo' for a hash, '&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).
+
+=item varglob (VARNAME)
+
+This returns a glob 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). Any attempt by code in STRING to use an operator which is
+in the compartment's mask 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()>. Note that 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.
+
+=item rdo (FILENAME)
+
+This evaluates the contents of file FILENAME inside the compartment.
+See above documentation on the B<reval> method for further details.
+
+=back
+
+=head2 Subroutines in package Safe
+
+The Safe package contains subroutines for manipulating operator
+names and operator masks. All are available for export by the package.
+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.
+
+=over 8
+
+=item ops_to_mask (OP, ...)
+
+This takes a list of operator names and returns an operator mask
+with precisely those operators masked.
+
+=item mask_to_ops (MASK)
+
+This takes an operator mask and returns a list of operator names
+corresponding to those operators which are masked in MASK.
+
+=item opcode (OP, ...)
+
+This takes a list of operator names and returns the corresponding
+list of opcodes (which can then be used as byte offsets into a mask).
+
+=item opname (OP, ...)
+
+This takes a list of opcodes and returns the corresponding list of
+operator names.
+
+=item fullmask
+
+This just returns a mask which has all operators masked.
+It returns the string "\1" x MAXO().
+
+=item emptymask
+
+This just returns a mask which has all operators unmasked.
+It returns the string "\0" x MAXO(). This is useful if you
+want a compartment to make use of the namespace protection
+features but do not want the default restrictive mask.
+
+=item MAXO
+
+This returns the number of operators (and hence the length of an
+operator mask). Note that, unlike the beta distributions of the
+Safe extension, this is derived from a genuine integer variable
+in the perl executable and not from a preprocessor constant.
+This means that the Safe extension is more robust in the presence
+of mismatched versions of the perl executable and the Safe extension.
+
+=item op_mask
+
+This returns the operator mask which is actually in effect at the
+time the invocation to the subroutine is compiled. In general,
+this is probably not terribly useful.
+
+=back
+
+=head2 AUTHOR
+
+Malcolm Beattie, mbeattie@sable.ox.ac.uk.
+
+=cut
+
+my $default_root = 'Root000000000';
+
+my $default_mask;
+
+sub new {
+    my($class, $root, $mask) = @_;
+    my $obj = {};
+    bless $obj, $class;
+    $obj->root(defined($root) ? $root : ("Safe::".$default_root++));
+    $obj->mask(defined($mask) ? $mask : $default_mask);
+    # 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->root . "::_"} = *_;
+    return $obj;
+}
+
+sub DESTROY {
+    my($obj) = @_;
+    my $root = $obj->root();
+    if ($root =~ /^Safe::(Root\d+)$/){
+	$root = $1;
+	delete $ {"Safe::"}{"$root\::"};
+    }
+}
+
+sub root {
+    my $obj = shift;
+    if (@_) {
+	$obj->{Root} = $_[0];
+    } else {
+	return $obj->{Root};
+    }
+}
+
+sub mask {
+    my $obj = shift;
+    if (@_) {
+	$obj->{Mask} = verify_mask($_[0]);
+    } else {
+	return $obj->{Mask};
+    }
+}
+
+sub verify_mask {
+    my($mask) = @_;
+    if (length($mask) != MAXO() || $mask !~ /^[\0\1]+$/) {
+	croak("argument is not a mask");
+    }
+    return $mask;
+}
+
+sub trap {
+    my $obj = shift;
+    $obj->setmaskel("\1", @_);
+}
+
+sub untrap {
+    my $obj = shift;
+    $obj->setmaskel("\0", @_);
+}
+
+sub emptymask { "\0" x MAXO() }
+sub fullmask { "\1" x MAXO() }
+
+sub setmaskel {
+    my $obj = shift;
+    my $val = shift;
+    croak("bad value for mask element") unless $val eq "\0" || $val eq "\1";
+    my $maskref = \$obj->{Mask};
+    my ($op, $opcode);
+    foreach $op (@_) {
+	$opcode = ($op =~ /^\d/) ? $op : opcode($op);
+	substr($$maskref, $opcode, 1) = $val;
+    }
+}
+
+sub share {
+    my $obj = shift;
+    my $root = $obj->root();
+    my ($arg);
+    foreach $arg (@_) {
+	my $var;
+	($var = $arg) =~ s/^(.)//;
+	my $caller = caller;
+	*{$root."::$var"} = ($1 eq '$') ? \${$caller."::$var"}
+			  : ($1 eq '@') ? \@{$caller."::$var"}
+			  : ($1 eq '%') ? \%{$caller."::$var"}
+			  : ($1 eq '*') ? *{$caller."::$var"}
+			  : ($1 eq '&') ? \&{$caller."::$var"}
+			  : croak(qq(No such variable type for "$1$var"));
+    }
+}
+
+sub varglob {
+    my ($obj, $var) = @_;
+    return *{$obj->root()."::$var"};
+}
+
+sub reval {
+    my ($obj, $expr) = @_;
+    my $root = $obj->{Root};
+    my $mask = $obj->{Mask};
+    verify_mask($mask);
+
+    my $evalsub = eval sprintf(<<'EOT', $root);
+	package %s;
+	sub {
+	    eval $expr;
+	}
+EOT
+    return safe_call_sv($root, $mask, $evalsub);
+}
+
+sub rdo {
+    my ($obj, $file) = @_;
+    my $root = $obj->{Root};
+    my $mask = $obj->{Mask};
+    verify_mask($mask);
+
+    $file =~ s/"/\\"/g; # just in case the filename contains any double quotes
+    my $evalsub = eval sprintf(<<'EOT', $root, $file);
+	package %s;
+	sub {
+	    do "%s";
+	}
+EOT
+    return safe_call_sv($root, $mask, $evalsub);
+}
+
+bootstrap Safe $VERSION;
+
+$default_mask = fullmask;
+my $name;
+while (defined ($name = <DATA>)) {
+    chomp $name;
+    next if $name =~ /^#/;
+    my $code = opcode($name);
+    substr($default_mask, $code, 1) = "\0";
+}
+
+1;
+
+__DATA__
+null
+stub
+scalar
+pushmark
+wantarray
+const
+gvsv
+gv
+gelem
+padsv
+padav
+padhv
+padany
+pushre
+rv2gv
+rv2sv
+av2arylen
+rv2cv
+anoncode
+prototype
+refgen
+srefgen
+ref
+bless
+glob
+readline
+rcatline
+regcmaybe
+regcomp
+match
+subst
+substcont
+trans
+sassign
+aassign
+chop
+schop
+chomp
+schomp
+defined
+undef
+study
+pos
+preinc
+i_preinc
+predec
+i_predec
+postinc
+i_postinc
+postdec
+i_postdec
+pow
+multiply
+i_multiply
+divide
+i_divide
+modulo
+i_modulo
+repeat
+add
+i_add
+subtract
+i_subtract
+concat
+stringify
+left_shift
+right_shift
+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
+bit_and
+bit_xor
+bit_or
+negate
+i_negate
+not
+complement
+atan2
+sin
+cos
+rand
+srand
+exp
+log
+sqrt
+int
+hex
+oct
+abs
+length
+substr
+vec
+index
+rindex
+sprintf
+formline
+ord
+chr
+crypt
+ucfirst
+lcfirst
+uc
+lc
+quotemeta
+rv2av
+aelemfast
+aelem
+aslice
+each
+values
+keys
+delete
+exists
+rv2hv
+helem
+hslice
+split
+join
+list
+lslice
+anonlist
+anonhash
+splice
+push
+pop
+shift
+unshift
+reverse
+grepstart
+grepwhile
+mapstart
+mapwhile
+range
+flip
+flop
+and
+or
+xor
+cond_expr
+andassign
+orassign
+method
+entersub
+leavesub
+caller
+warn
+die
+reset
+lineseq
+nextstate
+dbstate
+unstack
+enter
+leave
+scope
+enteriter
+iter
+enterloop
+leaveloop
+return
+last
+next
+redo
+goto
+close
+fileno
+tie
+untie
+dbmopen
+dbmclose
+sselect
+select
+getc
+read
+enterwrite
+leavewrite
+prtf
+print
+sysread
+syswrite
+send
+recv
+eof
+tell
+seek
+truncate
+fcntl
+ioctl
+sockpair
+bind
+connect
+listen
+accept
+shutdown
+gsockopt
+ssockopt
+getsockname
+ftrwrite
+ftsvtx
+open_dir
+readdir
+telldir
+seekdir
+rewinddir
+kill
+getppid
+getpgrp
+setpgrp
+getpriority
+setpriority
+time
+tms
+localtime
+alarm
+dofile
+entereval
+leaveeval
+entertry
+leavetry
+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
diff --git a/gnu/usr.bin/perl/ext/Safe/Safe.xs b/gnu/usr.bin/perl/ext/Safe/Safe.xs
new file mode 100644
index 00000000000..6b25924a334
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Safe/Safe.xs
@@ -0,0 +1,131 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* maxo should never differ from MAXO but leave some room anyway */
+#define OP_MASK_BUF_SIZE (MAXO + 100)
+
+MODULE = Safe	PACKAGE = Safe
+
+void
+safe_call_sv(package, mask, codesv)
+	char *	package
+	SV *	mask
+	SV *	codesv
+    CODE:
+	int i;
+	char *str;
+	STRLEN len;
+	char op_mask_buf[OP_MASK_BUF_SIZE];
+
+	assert(maxo < OP_MASK_BUF_SIZE);
+	ENTER;
+	SAVETMPS;
+	save_hptr(&defstash);
+	save_aptr(&endav);
+	SAVEPPTR(op_mask);
+	op_mask = &op_mask_buf[0];
+	str = SvPV(mask, len);
+	if (maxo != len)
+	    croak("Bad mask length");
+	for (i = 0; i < maxo; i++)
+	    op_mask[i] = str[i];
+	defstash = gv_stashpv(package, TRUE);
+	endav = (AV*)sv_2mortal((SV*)newAV()); /* Ignore END blocks for now */
+	GvHV(gv_fetchpv("main::", TRUE, SVt_PVHV)) = defstash;
+	PUSHMARK(sp);
+	i = perl_call_sv(codesv, G_SCALAR|G_EVAL|G_KEEPERR);
+	SPAGAIN;
+	ST(0) = i ? newSVsv(POPs) : &sv_undef;
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+	sv_2mortal(ST(0));
+
+void
+op_mask()
+    CODE:
+	ST(0) = sv_newmortal();
+	if (op_mask)
+	    sv_setpvn(ST(0), op_mask, maxo);
+
+void
+mask_to_ops(mask)
+	SV *	mask
+    PPCODE:
+	STRLEN len;
+	char *maskstr = SvPV(mask, len);
+	int i;
+	if (maxo != len)
+	    croak("Bad mask length");
+	for (i = 0; i < maxo; i++)
+	    if (maskstr[i])
+		XPUSHs(sv_2mortal(newSVpv(op_name[i], 0)));
+
+void
+ops_to_mask(...)
+    CODE:
+	int i, j;
+	char mask[OP_MASK_BUF_SIZE], *op;
+	Zero(mask, sizeof mask, char);
+	for (i = 0; i < items; i++)
+	{
+	    op = SvPV(ST(i), na);
+	    for (j = 0; j < maxo && strNE(op, op_name[j]); j++) /* nothing */ ;
+	    if (j < maxo)
+		mask[j] = 1;
+	    else
+	    {
+		Safefree(mask);
+		croak("bad op name \"%s\" in mask", op);
+	    }
+	}
+	ST(0) = sv_2mortal(newSVpv(mask,maxo));
+
+void
+opname(...)
+    PPCODE:
+	int i, myopcode;
+	for (i = 0; i < items; i++)
+	{
+	    myopcode = SvIV(ST(i));
+	    if (myopcode < 0 || myopcode >= maxo)
+		croak("opcode out of range");
+	    XPUSHs(sv_2mortal(newSVpv(op_name[myopcode], 0)));
+	}
+
+void
+opdesc(...)
+    PPCODE:
+	int i, myopcode;
+	for (i = 0; i < items; i++)
+	{
+	    myopcode = SvIV(ST(i));
+	    if (myopcode < 0 || myopcode >= maxo)
+		croak("opcode out of range");
+	    XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0)));
+	}
+
+void
+opcode(...)
+    PPCODE:
+	int i, j;
+	char *op;
+	for (i = 0; i < items; i++)
+	{
+	    op = SvPV(ST(i), na);
+	    for (j = 0; j < maxo; j++) {
+		if (strEQ(op, op_name[j]) || strEQ(op, op_desc[j]))
+		    break;
+	    }
+	    if (j == maxo)
+		croak("bad op name \"%s\"", op);
+	    XPUSHs(sv_2mortal(newSViv(j)));
+	}
+
+int
+MAXO()
+    CODE:
+	RETVAL = maxo;
+    OUTPUT:
+	RETVAL
diff --git a/gnu/usr.bin/perl/ext/Socket/Makefile.PL b/gnu/usr.bin/perl/ext/Socket/Makefile.PL
new file mode 100644
index 00000000000..7b9469a728e
--- /dev/null
+++ b/gnu/usr.bin/perl/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/gnu/usr.bin/perl/ext/Socket/Socket.pm b/gnu/usr.bin/perl/ext/Socket/Socket.pm
new file mode 100644
index 00000000000..43c3c404bc4
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Socket/Socket.pm
@@ -0,0 +1,278 @@
+package Socket;
+
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = "1.5";
+
+=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');
+    $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.
+
+In addition, some structure manipulation functions are available:
+
+=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.
+
+=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_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 PATHANE
+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 <sys/un.h>.
+
+=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.
+
+=cut
+
+use Carp;
+
+require Exporter;
+use AutoLoader;
+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_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
+);
+
+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) {
+	if ($! =~ /Invalid/) {
+	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+	    my ($pack,$file,$line) = caller;
+	    croak "Your vendor has not defined Socket macro $constname, used";
+	}
+    }
+    eval "sub $AUTOLOAD { $val }";
+    goto &$AUTOLOAD;
+}
+
+bootstrap Socket $VERSION;
+
+# Preloaded methods go here.  Autoload methods go after __END__, and are
+# processed by the autosplit program.
+
+1;
+__END__
diff --git a/gnu/usr.bin/perl/ext/Socket/Socket.xs b/gnu/usr.bin/perl/ext/Socket/Socket.xs
new file mode 100644
index 00000000000..378824f42d4
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/Socket/Socket.xs
@@ -0,0 +1,750 @@
+#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 I_SYS_UN
+#include <sys/un.h>
+#endif
+# ifdef I_NETINET_IN
+#  include <netinet/in.h>
+# endif
+#include <netdb.h>
+#include <arpa/inet.h>
+#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_LOOPBACK
+#define INADDR_LOOPBACK         0x7F000001
+#endif /* INADDR_LOOPBACK */
+
+
+static int
+not_here(s)
+char *s;
+{
+    croak("Socket::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+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_DONTROUTE"))
+#ifdef MSG_DONTROUTE
+	    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"))
+#ifdef MSG_OOB
+	    return MSG_OOB;
+#else
+	    goto not_there;
+#endif
+	if (strEQ(name, "MSG_PEEK"))
+#ifdef MSG_PEEK
+	    return MSG_PEEK;
+#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;
+
+	if (phe = gethostbyname(host)) {
+		Copy( phe->h_addr, &ip_address, phe->h_length, char );
+	} else {
+        	ip_address.s_addr = inet_addr(host);
+	}
+
+	ST(0) = sv_newmortal();
+	if(ip_address.s_addr != INADDR_NONE) {
+		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 */
+	Zero( &sun_ad, sizeof sun_ad, char );
+	sun_ad.sun_family = AF_UNIX;
+	Copy( pathname, sun_ad.sun_path, sizeof sun_ad.sun_path, 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
+	PPCODE:
+	{
+#ifdef I_SYS_UN
+	STRLEN sockaddrlen;
+	struct sockaddr_un addr;
+	char *	sun_ad = SvPV(sun_sv,sockaddrlen);
+
+	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);
+	} 
+	ST(0) = sv_2mortal(newSVpv(addr.sun_path, strlen(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));
+	}
diff --git a/gnu/usr.bin/perl/ext/util/extliblist b/gnu/usr.bin/perl/ext/util/extliblist
new file mode 100644
index 00000000000..2351ddfd0ec
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/util/extliblist
@@ -0,0 +1,155 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: extliblist
+:
+: Author:  Andy Dougherty    doughera@lafcol.lafayette.edu
+:
+: This utility was only used by the old Makefile.SH extension
+: mechanism.  It is now obsolete and may be removed in a future
+: release.
+:
+: This utility takes a list of libraries in the form
+: -llib1 -llib2 -llib3
+: and prints out lines suitable for inclusion in an extension
+: Makefile.  
+: Extra library paths may be included with the form -L/another/path
+: this will affect the searches for all subsequent libraries.
+:
+: It is intended to be "dotted" from within an extension Makefile.SH.
+: see ext/POSIX/Makefile.SH for an example.
+: Prior to calling this, the variable potential_libs should be set 
+: to the potential list of libraries
+:
+: It sets the following
+: extralibs = full list of libraries needed for static linking.
+:		Only those libraries that actually exist are included.
+: dynaloadlibs = full path names of those libraries that are needed 
+:		but can be linked in dynamically on this platform.  On 
+:		SunOS, for example, this would be .so* libraries, 
+:		but not archive libraries.
+:		Eventually, this list can be used to write a bootstrap file.
+: statloadlibs = list of those libraries which must be statically
+:		linked into the shared library.  On SunOS 4.1.3, 
+:		for example,  I have only an archive version of
+:		-lm, and it must be linked in statically.
+:
+:  This script uses config.sh variables libs, libpth, and so.  It is mostly
+:  taken from the metaconfig libs.U unit.
+extralibs=''
+dynaloadlibs=''
+statloadlibs=''
+Llibpth=''
+for thislib in `echo "XXX $potential_libs " | $sed 's/ -l/ /g'` ; do
+	case "$thislib" in
+	XXX)
+		: Handle case where potential_libs is empty.
+		;;
+	-L*)
+		: Handle possible linker path arguments.
+		newpath=`echo $thislib | $sed 's/^-L//'`
+		if $test -d $newpath; then
+			Llibpth="$Llibpth $newpath"
+			extralibs="$extralibs $thislib"
+			statloadlibs="$statloadlibs $thislib"
+		fi
+		;;
+	*)
+		: Handle possible library arguments.
+		for thispth in $Llibpth $libpth; do
+			: Loop over possible wildcards and take the last one.
+			for fullname in $thispth/lib$thislib.$so.[0-9]* ; do
+				:
+			done
+			if $test -f $fullname; then
+				break
+			elif fullname=$thispth/lib$thislib.$so && $test -f $fullname; then
+				break
+			elif fullname=$thispth/lib${thislib}_s.a && $test -f $fullname; then
+				thislib=${thislib}_s
+				break
+			elif fullname=$thispth/lib${thislib}.a && $test -f $fullname; then
+				break
+			elif fullname=$thispth/Slib${thislib}.a && $test -f $fullname; then
+				break
+			else
+				fullname=''
+			fi
+		done
+		: Now update library lists
+		case "$fullname" in
+		'') 
+			: Skip nonexistent files
+			;;
+		*)
+			: Do not add it into the extralibs if it is already linked in
+			: with the main perl executable.
+			case " $libs " in
+			*" -l$thislib "*|*" -l${thislib}_s "*) ;;
+			*)	extralibs="$extralibs -l$thislib" ;;
+			esac
+			:
+			: For NeXT and DLD, put files into DYNALOADLIBS to be
+			: converted into a boostrap file.  For other systems,
+			: we will use ld with what I have misnamed STATLOADLIBS
+			: to assemble the shared object.
+			case "$dlsrc" in
+			dl_dld*|dl_next*)
+				dynaloadlibs="$dynaloadlibs $fullname"   ;;
+			*)
+				case "$fullname" in
+				*.a)
+					statloadlibs="$statloadlibs -l$thislib" 
+					;;
+				*)   
+					: For SunOS4, do not add in this shared library
+					: if it is already linked in the main
+					: perl executable
+					case "$osname" in
+					sunos)
+						case " $libs " in
+						*" -l$thislib "*) ;;
+						*)	statloadlibs="$statloadlibs -l$thislib" ;;
+						esac
+						;;
+					*)
+						statloadlibs="$statloadlibs -l$thislib" 
+						;;
+					esac
+					;;
+				esac
+				;;
+			esac
+			;;
+		esac
+		;;
+	esac
+done
+
+case "$dlsrc" in
+dl_next*)
+	extralibs=`echo " $extralibs "| $sed -e 's/ -lm / /'` ;;
+esac
+
+set X $extralibs
+shift
+extralibs="$*"
+
+set X $dynaloadlibs
+shift
+dynaloadlibs="$*"
+
+set X $statloadlibs
+shift
+statloadlibs="$*"
+
diff --git a/gnu/usr.bin/perl/ext/util/make_ext b/gnu/usr.bin/perl/ext/util/make_ext
new file mode 100644
index 00000000000..8c1abbbc013
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/util/make_ext
@@ -0,0 +1,117 @@
+#!/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
+#        ext/util/make_ext dynamic $@
+#
+# 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
+passthru="$*" # allow extra macro=value to be passed through
+echo ""
+
+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 is nested)
+# A user wishing to run make_ext might use
+#	X (or X/Y or X::Y is 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:/[^/]*\.[^/]*$::' ` ;;
+*::*)	# 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'`
+make=${altmake-make}
+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
+	    ;;
+
+*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/gnu/usr.bin/perl/ext/util/mkbootstrap b/gnu/usr.bin/perl/ext/util/mkbootstrap
new file mode 100644
index 00000000000..6c3a7e10edb
--- /dev/null
+++ b/gnu/usr.bin/perl/ext/util/mkbootstrap
@@ -0,0 +1,5 @@
+#!../../miniperl -w -I../../lib
+
+use ExtUtils::MakeMaker;
+&mkbootstrap(join(" ",@ARGV));
+exit;
diff --git a/gnu/usr.bin/perl/form.h b/gnu/usr.bin/perl/form.h
new file mode 100644
index 00000000000..531cc72294a
--- /dev/null
+++ b/gnu/usr.bin/perl/form.h
@@ -0,0 +1,26 @@
+/*    form.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#define FF_END		0
+#define FF_LINEMARK	1
+#define FF_LITERAL	2
+#define FF_SKIP		3
+#define FF_FETCH	4
+#define FF_CHECKNL	5
+#define FF_CHECKCHOP	6
+#define FF_SPACE	7
+#define FF_HALFSPACE	8
+#define FF_ITEM		9
+#define FF_CHOP		10
+#define FF_LINEGLOB	11
+#define FF_DECIMAL	12
+#define FF_NEWLINE	13
+#define FF_BLANK	14
+#define FF_MORE		15
+
diff --git a/gnu/usr.bin/perl/global.sym b/gnu/usr.bin/perl/global.sym
new file mode 100644
index 00000000000..70d07c0034e
--- /dev/null
+++ b/gnu/usr.bin/perl/global.sym
@@ -0,0 +1,1065 @@
+# Global symbols that need to be hidden in embedded applications.
+
+# Variables
+
+AMG_names
+No
+Sv
+Xpv
+Yes
+abs_amg
+add_amg
+add_ass_amg
+additem
+amagic_generation
+an
+atan2_amg
+band_amg
+bool__amg
+bor_amg
+buf
+bufend
+bufptr
+bxor_amg
+check
+compiling
+compl_amg
+compcv
+comppad
+comppad_name
+comppad_name_fill
+concat_amg
+concat_ass_amg
+cop_seqmax
+cos_amg
+cryptseen
+cshlen
+cshname
+curcop
+curinterp
+curpad
+dc
+dec_amg
+di
+div_amg
+div_ass_amg
+ds
+egid
+envgv
+eq_amg
+error_count
+euid
+evalseq
+exp_amg
+expect
+expectterm
+fallback_amg
+filter_add
+filter_del
+filter_read
+fold
+freq
+ge_amg
+gid
+gt_amg
+hexdigit
+hints
+in_my
+inc_amg
+io_close
+know_next
+last_lop
+last_lop_op
+last_uni
+le_amg
+lex_state
+lex_defer
+lex_expect
+lex_brackets
+lex_formbrack
+lex_fakebrack
+lex_casemods
+lex_dojoin
+lex_starts
+lex_stuff
+lex_repl
+lex_op
+lex_inpat
+lex_inwhat
+lex_brackstack
+lex_casestack
+linestr
+log_amg
+lshift_amg
+lshift_ass_amg
+lt_amg
+markstack
+markstack_max
+markstack_ptr
+maxo
+max_intro_pending
+min_intro_pending
+mod_amg
+mod_ass_amg
+mult_amg
+mult_ass_amg
+multi_close
+multi_end
+multi_open
+multi_start
+na
+ncmp_amg
+nextval
+nexttype
+nexttoke
+ne_amg
+neg_amg
+nexttype
+nextval
+no_aelem
+no_dir_func
+no_func
+no_helem
+no_mem
+no_modify
+no_security
+no_sock_func
+no_usym
+nointrp
+nomem
+nomemok
+nomethod_amg
+not_amg
+numer_amg
+oldbufptr
+oldoldbufptr
+op
+op_desc
+op_name
+op_seqmax
+opargs
+origalen
+origenviron
+osname
+padix
+patleave
+pow_amg
+pow_ass_amg
+ppaddr
+profiledata
+provide_ref
+qrt_amg
+rcsid
+reall_srchlen
+regarglen
+regbol
+regcode
+regdummy
+regendp
+regeol
+regfold
+reginput
+regkind
+reglastparen
+regmyendp
+regmyp_size
+regmystartp
+regnarrate
+regnaughty
+regnpar
+regparse
+regprecomp
+regprev
+regsawback
+regsize
+regstartp
+regtill
+regxend
+repeat_amg
+repeat_ass_amg
+retstack
+retstack_ix
+retstack_max
+rsfp
+rsfp_filters
+rshift_amg
+rshift_ass_amg
+save_pptr
+savestack
+savestack_ix
+savestack_max
+saw_return
+scmp_amg
+scopestack
+scopestack_ix
+scopestack_max
+scrgv
+seq_amg
+sge_amg
+sgt_amg
+sig_name
+sig_num
+siggv
+sighandler
+simple
+sin_amg
+sle_amg
+slt_amg
+sne_amg
+stack
+stack_base
+stack_max
+stack_sp
+statbuf
+string_amg
+sub_generation
+subline
+subname
+subtr_amg
+subtr_ass_amg
+sv_no
+sv_undef
+sv_yes
+tainting
+thisexpr
+timesbuf
+tokenbuf
+uid
+varies
+vert
+vtbl_amagic
+vtbl_amagicelem
+vtbl_arylen
+vtbl_bm
+vtbl_dbline
+vtbl_env
+vtbl_envelem
+vtbl_glob
+vtbl_isa
+vtbl_isaelem
+vtbl_mglob
+vtbl_pack
+vtbl_packelem
+vtbl_pos
+vtbl_sig
+vtbl_sigelem
+vtbl_substr
+vtbl_sv
+vtbl_taint
+vtbl_uvar
+vtbl_vec
+warn_nl
+warn_nosemi
+warn_reserved
+watchaddr
+watchok
+yychar
+yycheck
+yydebug
+yydefred
+yydgoto
+yyerrflag
+yygindex
+yylen
+yylhs
+yylval
+yyname
+yynerrs
+yyrindex
+yyrule
+yysindex
+yytable
+yyval
+
+# Functions
+
+Gv_AMupdate
+amagic_call
+append_elem
+append_list
+apply
+assertref
+av_clear
+av_extend
+av_fake
+av_fetch
+av_fill
+av_len
+av_make
+av_pop
+av_push
+av_shift
+av_store
+av_undef
+av_unshift
+bind_match
+block_end
+block_start
+calllist
+cando
+cast_ulong
+check_uni
+checkcomma
+chsize
+ck_aelem
+ck_concat
+ck_delete
+ck_eof
+ck_eval
+ck_exec
+ck_formline
+ck_ftst
+ck_fun
+ck_glob
+ck_grep
+ck_gvconst
+ck_index
+ck_lengthconst
+ck_lfun
+ck_listiob
+ck_match
+ck_null
+ck_repeat
+ck_require
+ck_retarget
+ck_rfun
+ck_rvconst
+ck_select
+ck_shift
+ck_sort
+ck_spair
+ck_split
+ck_subr
+ck_svconst
+ck_trunc
+convert
+cpytill
+croak
+cv_clone
+cv_undef
+cx_dump
+cxinc
+deb
+deb_growlevel
+debop
+debprofdump
+debstack
+debstackptrs
+deprecate
+die
+die_where
+do_aexec
+do_chomp
+do_chop
+do_close
+do_eof
+do_exec
+do_execfree
+do_ipcctl
+do_ipcget
+do_join
+do_kv
+do_msgrcv
+do_msgsnd
+do_open
+do_pipe
+do_print
+do_readline
+do_seek
+do_semop
+do_shmio
+do_sprintf
+do_tell
+do_trans
+do_vecset
+do_vop
+doeval
+dofindlabel
+dopoptoeval
+dounwind
+dowantarray
+dump_all
+dump_eval
+dump_fds
+dump_form
+dump_gv
+dump_mstats
+dump_op
+dump_packsubs
+dump_pm
+dump_sub
+fbm_compile
+fbm_instr
+fetch_gv
+fetch_io
+filter_add
+filter_del
+filter_read
+fold_constants
+force_ident
+force_list
+force_next
+force_word
+free_tmps
+gen_constant_list
+gp_free
+gp_ref
+gv_AVadd
+gv_HVadd
+gv_IOadd
+gv_check
+gv_efullname
+gv_fetchfile
+gv_fetchmeth
+gv_fetchmethod
+gv_fetchpv
+gv_fullname
+gv_init
+gv_stashpv
+gv_stashsv
+he_delayfree
+he_free
+he_root
+hoistmust
+hv_clear
+hv_delete
+hv_exists
+hv_fetch
+hv_iterinit
+hv_iterkey
+hv_iternext
+hv_iternextsv
+hv_iterval
+hv_magic
+hv_stashpv
+hv_store
+hv_undef
+ibcmp
+ingroup
+instr
+intuit_more
+invert
+jmaybe
+keyword
+leave_scope
+lex_end
+lex_start
+linklist
+list
+listkids
+localize
+looks_like_number
+magic_clearenv
+magic_clearpack
+magic_existspack
+magic_get
+magic_getarylen
+magic_getglob
+magic_getpack
+magic_getpos
+magic_gettaint
+magic_getuvar
+magic_len
+magic_nextpack
+magic_set
+magic_setamagic
+magic_setarylen
+magic_setbm
+magic_setdbline
+magic_setenv
+magic_setglob
+magic_setisa
+magic_setmglob
+magic_setpack
+magic_setpos
+magic_setsig
+magic_setsubstr
+magic_settaint
+magic_setuvar
+magic_setvec
+magic_wipepack
+magicname
+markstack_grow
+mess
+mg_clear
+mg_copy
+mg_find
+mg_free
+mg_get
+mg_len
+mg_magical
+mg_set
+mod
+modkids
+moreswitches
+mstats
+my
+my_bcopy
+my_bzero
+my_exit
+my_htonl
+my_lstat
+my_memcmp
+my_ntohl
+my_pclose
+my_popen
+my_setenv
+my_stat
+my_swap
+my_unexec
+newANONHASH
+newANONLIST
+newANONSUB
+newASSIGNOP
+newAV
+newAVREF
+newBINOP
+newCONDOP
+newCVREF
+newFORM
+newFOROP
+newGVOP
+newGVREF
+newGVgen
+newHV
+newHVREF
+newIO
+newLISTOP
+newLOGOP
+newLOOPEX
+newLOOPOP
+newNULLLIST
+newOP
+newPMOP
+newPROG
+newPVOP
+newRANGE
+newRV
+newSLICEOP
+newSTATEOP
+newSUB
+newSV
+newSVOP
+newSVREF
+newSViv
+newSVnv
+newSVpv
+newSVrv
+newSVsv
+newUNOP
+newWHILEOP
+newXS
+newXSUB
+nextargv
+ninstr
+no_fh_allowed
+no_op
+oopsAV
+oopsCV
+oopsHV
+op_free
+package
+pad_alloc
+pad_allocmy
+pad_findmy
+pad_free
+pad_leavemy
+pad_reset
+pad_sv
+pad_swipe
+peep
+pidgone
+pmflag
+pmruntime
+pmtrans
+pop_return
+pop_scope
+pp_aassign
+pp_abs
+pp_accept
+pp_add
+pp_aelem
+pp_aelemfast
+pp_alarm
+pp_and
+pp_andassign
+pp_anoncode
+pp_anonhash
+pp_anonlist
+pp_aslice
+pp_atan2
+pp_av2arylen
+pp_backtick
+pp_bind
+pp_binmode
+pp_bit_and
+pp_bit_or
+pp_bit_xor
+pp_bless
+pp_caller
+pp_chdir
+pp_chmod
+pp_chomp
+pp_chop
+pp_chown
+pp_chr
+pp_chroot
+pp_close
+pp_closedir
+pp_complement
+pp_concat
+pp_cond_expr
+pp_connect
+pp_const
+pp_cos
+pp_crypt
+pp_cswitch
+pp_dbmclose
+pp_dbmopen
+pp_dbstate
+pp_defined
+pp_delete
+pp_die
+pp_divide
+pp_dofile
+pp_dump
+pp_each
+pp_egrent
+pp_ehostent
+pp_enetent
+pp_enter
+pp_entereval
+pp_enteriter
+pp_enterloop
+pp_entersub
+pp_entersubr
+pp_entertry
+pp_enterwrite
+pp_eof
+pp_eprotoent
+pp_epwent
+pp_eq
+pp_eservent
+pp_evalonce
+pp_exec
+pp_exists
+pp_exit
+pp_exp
+pp_fcntl
+pp_fileno
+pp_flip
+pp_flock
+pp_flop
+pp_fork
+pp_formline
+pp_ftatime
+pp_ftbinary
+pp_ftblk
+pp_ftchr
+pp_ftctime
+pp_ftdir
+pp_fteexec
+pp_fteowned
+pp_fteread
+pp_ftewrite
+pp_ftfile
+pp_ftis
+pp_ftlink
+pp_ftmtime
+pp_ftpipe
+pp_ftrexec
+pp_ftrowned
+pp_ftrread
+pp_ftrwrite
+pp_ftsgid
+pp_ftsize
+pp_ftsock
+pp_ftsuid
+pp_ftsvtx
+pp_fttext
+pp_fttty
+pp_ftzero
+pp_ge
+pp_gelem
+pp_getc
+pp_getlogin
+pp_getpeername
+pp_getpgrp
+pp_getppid
+pp_getpriority
+pp_getsockname
+pp_ggrent
+pp_ggrgid
+pp_ggrnam
+pp_ghbyaddr
+pp_ghbyname
+pp_ghostent
+pp_glob
+pp_gmtime
+pp_gnbyaddr
+pp_gnbyname
+pp_gnetent
+pp_goto
+pp_gpbyname
+pp_gpbynumber
+pp_gprotoent
+pp_gpwent
+pp_gpwnam
+pp_gpwuid
+pp_grepstart
+pp_grepwhile
+pp_gsbyname
+pp_gsbyport
+pp_gservent
+pp_gsockopt
+pp_gt
+pp_gv
+pp_gvsv
+pp_helem
+pp_hex
+pp_hslice
+pp_i_add
+pp_i_divide
+pp_i_eq
+pp_i_ge
+pp_i_gt
+pp_i_le
+pp_i_lt
+pp_i_modulo
+pp_i_multiply
+pp_i_ncmp
+pp_i_ne
+pp_i_negate
+pp_i_subtract
+pp_index
+pp_indread
+pp_int
+pp_interp
+pp_ioctl
+pp_iter
+pp_join
+pp_keys
+pp_kill
+pp_last
+pp_lc
+pp_lcfirst
+pp_le
+pp_leave
+pp_leaveeval
+pp_leaveloop
+pp_leavesub
+pp_leavetry
+pp_leavewrite
+pp_left_shift
+pp_length
+pp_lineseq
+pp_link
+pp_list
+pp_listen
+pp_localtime
+pp_log
+pp_lslice
+pp_lstat
+pp_lt
+pp_map
+pp_mapstart
+pp_mapwhile
+pp_match
+pp_method
+pp_mkdir
+pp_modulo
+pp_msgctl
+pp_msgget
+pp_msgrcv
+pp_msgsnd
+pp_multiply
+pp_ncmp
+pp_ne
+pp_negate
+pp_next
+pp_nextstate
+pp_not
+pp_nswitch
+pp_null
+pp_oct
+pp_open
+pp_open_dir
+pp_or
+pp_orassign
+pp_ord
+pp_pack
+pp_padany
+pp_padav
+pp_padhv
+pp_padsv
+pp_pipe_op
+pp_pop
+pp_pos
+pp_postdec
+pp_postinc
+pp_pow
+pp_predec
+pp_preinc
+pp_print
+pp_prototype
+pp_prtf
+pp_push
+pp_pushmark
+pp_pushre
+pp_quotemeta
+pp_rand
+pp_range
+pp_rcatline
+pp_read
+pp_readdir
+pp_readline
+pp_readlink
+pp_recv
+pp_redo
+pp_ref
+pp_refgen
+pp_regcmaybe
+pp_regcomp
+pp_rename
+pp_repeat
+pp_require
+pp_reset
+pp_return
+pp_reverse
+pp_rewinddir
+pp_right_shift
+pp_rindex
+pp_rmdir
+pp_rv2av
+pp_rv2cv
+pp_rv2gv
+pp_rv2hv
+pp_rv2sv
+pp_sassign
+pp_scalar
+pp_schomp
+pp_schop
+pp_scmp
+pp_scope
+pp_seek
+pp_seekdir
+pp_select
+pp_semctl
+pp_semget
+pp_semop
+pp_send
+pp_seq
+pp_setpgrp
+pp_setpriority
+pp_sge
+pp_sgrent
+pp_sgt
+pp_shift
+pp_shmctl
+pp_shmget
+pp_shmread
+pp_shmwrite
+pp_shostent
+pp_shutdown
+pp_sin
+pp_sle
+pp_sleep
+pp_slt
+pp_sne
+pp_snetent
+pp_socket
+pp_sockpair
+pp_sort
+pp_splice
+pp_split
+pp_sprintf
+pp_sprotoent
+pp_spwent
+pp_sqrt
+pp_srand
+pp_srefgen
+pp_sselect
+pp_sservent
+pp_ssockopt
+pp_stat
+pp_stringify
+pp_stub
+pp_study
+pp_subst
+pp_substcont
+pp_substr
+pp_subtract
+pp_symlink
+pp_syscall
+pp_sysopen
+pp_sysread
+pp_system
+pp_syswrite
+pp_tell
+pp_telldir
+pp_tie
+pp_tied
+pp_time
+pp_tms
+pp_trans
+pp_truncate
+pp_uc
+pp_ucfirst
+pp_umask
+pp_undef
+pp_unlink
+pp_unpack
+pp_unshift
+pp_unstack
+pp_untie
+pp_utime
+pp_values
+pp_vec
+pp_wait
+pp_waitpid
+pp_wantarray
+pp_warn
+pp_xor
+pregcomp
+pregexec
+pregfree
+prepend_elem
+push_return
+push_scope
+q
+ref
+refkids
+regdump
+regnext
+regprop
+repeatcpy
+rninstr
+runops
+same_dirent
+save_I32
+save_aptr
+save_ary
+save_clearsv
+save_delete
+save_destructor
+save_freeop
+save_freepv
+save_freesv
+save_hash
+save_hptr
+save_int
+save_item
+save_list
+save_long
+save_nogv
+save_pptr
+save_scalar
+save_sptr
+save_svref
+savepv
+savepvn
+savestack_grow
+sawparens
+scalar
+scalarkids
+scalarseq
+scalarvoid
+scan_const
+scan_formline
+scan_heredoc
+scan_hex
+scan_ident
+scan_inputsymbol
+scan_num
+scan_oct
+scan_pat
+scan_prefix
+scan_str
+scan_subst
+scan_trans
+scan_word
+scope
+screaminstr
+setdefout
+setenv_getix
+sighandler
+skipspace
+stack_grow
+start_subparse
+sublex_done
+sublex_start
+sv_2bool
+sv_2cv
+sv_2io
+sv_2iv
+sv_2mortal
+sv_2nv
+sv_2pv
+sv_add_arena
+sv_backoff
+sv_bless
+sv_catpv
+sv_catpvn
+sv_catsv
+sv_chop
+sv_clean_all
+sv_clean_objs
+sv_clear
+sv_cmp
+sv_dec
+sv_dump
+sv_eq
+sv_free
+sv_free_arenas
+sv_gets
+sv_grow
+sv_inc
+sv_insert
+sv_isa
+sv_isobject
+sv_len
+sv_magic
+sv_mortalcopy
+sv_newmortal
+sv_newref
+sv_peek
+sv_pvn_force
+sv_ref
+sv_reftype
+sv_replace
+sv_report_used
+sv_reset
+sv_setiv
+sv_setnv
+sv_setptrobj
+sv_setpv
+sv_setpvn
+sv_setref_iv
+sv_setref_nv
+sv_setref_pv
+sv_setref_pvn
+sv_setsv
+sv_unmagic
+sv_unref
+sv_upgrade
+sv_usepvn
+taint_env
+taint_not
+taint_proper
+too_few_arguments
+too_many_arguments
+unlnk
+utilize
+wait4pid
+warn
+watch
+whichsig
+xiv_arenaroot
+xiv_root
+xnv_root
+xpv_root
+xrv_root
+yyerror
+yylex
+yyparse
+yywarn
diff --git a/gnu/usr.bin/perl/globals.c b/gnu/usr.bin/perl/globals.c
new file mode 100644
index 00000000000..0550a5ac416
--- /dev/null
+++ b/gnu/usr.bin/perl/globals.c
@@ -0,0 +1,2 @@
+#include "INTERN.h"
+#include "perl.h"
diff --git a/gnu/usr.bin/perl/gv.c b/gnu/usr.bin/perl/gv.c
new file mode 100644
index 00000000000..dc6d2e5a919
--- /dev/null
+++ b/gnu/usr.bin/perl/gv.c
@@ -0,0 +1,1197 @@
+/*    gv.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ *   'Mercy!' cried Gandalf.  'If the giving of information is to be the cure
+ * of your inquisitiveness, I shall spend all the rest of my days answering
+ * you.  What more do you want to know?'
+ *   'The names of all the stars, and of all living things, and the whole
+ * history of Middle-earth and Over-heaven and of the Sundering Seas,'
+ * laughed Pippin.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+extern char rcsid[];
+
+GV *
+gv_AVadd(gv)
+register GV *gv;
+{
+    if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+	croak("Bad symbol for array");
+    if (!GvAV(gv))
+	GvAV(gv) = newAV();
+    return gv;
+}
+
+GV *
+gv_HVadd(gv)
+register GV *gv;
+{
+    if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+	croak("Bad symbol for hash");
+    if (!GvHV(gv))
+	GvHV(gv) = newHV();
+    return gv;
+}
+
+GV *
+gv_IOadd(gv)
+register GV *gv;
+{
+    if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
+	croak("Bad symbol for filehandle");
+    if (!GvIOp(gv))
+	GvIOp(gv) = newIO();
+    return gv;
+}
+
+GV *
+gv_fetchfile(name)
+char *name;
+{
+    char tmpbuf[1200];
+    GV *gv;
+
+    sprintf(tmpbuf,"::_<%s", name);
+    gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
+    sv_setpv(GvSV(gv), name);
+    if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
+	GvMULTI_on(gv);
+    if (perldb)
+	hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
+    return gv;
+}
+
+void
+gv_init(gv, stash, name, len, multi)
+GV *gv;
+HV *stash;
+char *name;
+STRLEN len;
+int multi;
+{
+    register GP *gp;
+
+    sv_upgrade(gv, SVt_PVGV);
+    if (SvLEN(gv))
+	Safefree(SvPVX(gv));
+    Newz(602,gp, 1, GP);
+    GvGP(gv) = gp_ref(gp);
+    GvREFCNT(gv) = 1;
+    GvSV(gv) = NEWSV(72,0);
+    GvLINE(gv) = curcop->cop_line;
+    GvFILEGV(gv) = curcop->cop_filegv;
+    GvEGV(gv) = gv;
+    sv_magic((SV*)gv, (SV*)gv, '*', name, len);
+    GvSTASH(gv) = stash;
+    GvNAME(gv) = savepvn(name, len);
+    GvNAMELEN(gv) = len;
+    if (multi)
+	GvMULTI_on(gv);
+}
+
+static void
+gv_init_sv(gv, sv_type)
+GV* gv;
+I32 sv_type;
+{
+    switch (sv_type) {
+    case SVt_PVIO:
+	(void)GvIOn(gv);
+	break;
+    case SVt_PVAV:
+	(void)GvAVn(gv);
+	break;
+    case SVt_PVHV:
+	(void)GvHVn(gv);
+	break;
+    }
+}
+
+GV *
+gv_fetchmeth(stash, name, len, level)
+HV* stash;
+char* name;
+STRLEN len;
+I32 level;
+{
+    AV* av;
+    GV* topgv;
+    GV* gv;
+    GV** gvp;
+    HV* lastchance;
+    CV* cv;
+
+    if (!stash)
+	return 0;
+    if (level > 100)
+	croak("Recursive inheritance detected");
+
+    gvp = (GV**)hv_fetch(stash, name, len, TRUE);
+
+    DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
+    topgv = *gvp;
+    if (SvTYPE(topgv) != SVt_PVGV)
+	gv_init(topgv, stash, name, len, TRUE);
+
+    if (cv=GvCV(topgv)) {
+	if (GvCVGEN(topgv) >= sub_generation)
+	    return topgv;	/* valid cached inheritance */
+	if (!GvCVGEN(topgv)) {	/* not an inheritance cache */
+	    return topgv;
+	}
+	else {
+	    /* stale cached entry, just junk it */
+	    GvCV(topgv) = cv = 0;
+	    GvCVGEN(topgv) = 0;
+	}
+    }
+    /* if cv is still set, we have to free it if we find something to cache */
+
+    gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
+    if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+	SV** svp = AvARRAY(av);
+	I32 items = AvFILL(av) + 1;
+	while (items--) {
+	    SV* sv = *svp++;
+	    HV* basestash = gv_stashsv(sv, FALSE);
+	    if (!basestash) {
+		if (dowarn)
+		    warn("Can't locate package %s for @%s::ISA",
+			SvPVX(sv), HvNAME(stash));
+		continue;
+	    }
+	    gv = gv_fetchmeth(basestash, name, len, level + 1);
+	    if (gv) {
+		if (cv) {				/* junk old undef */
+		    assert(SvREFCNT(topgv) > 1);
+		    SvREFCNT_dec(topgv);
+		    SvREFCNT_dec(cv);
+		}
+		GvCV(topgv) = GvCV(gv);			/* cache the CV */
+		GvCVGEN(topgv) = sub_generation;	/* valid for now */
+		return gv;
+	    }
+	}
+    }
+
+    if (!level) {
+	if (lastchance = gv_stashpv("UNIVERSAL", FALSE)) {
+	    if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
+		if (cv) {				/* junk old undef */
+		    assert(SvREFCNT(topgv) > 1);
+		    SvREFCNT_dec(topgv);
+		    SvREFCNT_dec(cv);
+		}
+		GvCV(topgv) = GvCV(gv);			/* cache the CV */
+		GvCVGEN(topgv) = sub_generation;	/* valid for now */
+		return gv;
+	    }
+	}
+    }
+
+    return 0;
+}
+
+GV *
+gv_fetchmethod(stash, name)
+HV* stash;
+char* name;
+{
+    register char *nend;
+    char *nsplit = 0;
+    GV* gv;
+    
+    for (nend = name; *nend; nend++) {
+	if (*nend == ':' || *nend == '\'')
+	    nsplit = nend;
+    }
+    if (nsplit) {
+	char ch;
+	char *origname = name;
+	name = nsplit + 1;
+	ch = *nsplit;
+	if (*nsplit == ':')
+	    --nsplit;
+	*nsplit = '\0';
+	if (strEQ(origname,"SUPER")) {
+	    /* Degenerate case ->SUPER::method should really lookup in original stash */
+	    SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
+	    sv_catpvn(tmpstr, "::SUPER", 7);
+	    stash = gv_stashpv(SvPV(tmpstr,na),TRUE);
+	    *nsplit = ch;
+	    DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) );
+	} else {
+	    stash = gv_stashpv(origname,TRUE);
+	    *nsplit = ch;
+	}
+    }
+    gv = gv_fetchmeth(stash, name, nend - name, 0);
+
+    if (!gv) {
+	/* Failed obvious case - look for SUPER as last element of stash's name */
+	char *packname = HvNAME(stash);
+	STRLEN len     = strlen(packname);
+	if (len >= 7 && strEQ(packname+len-7,"::SUPER")) {
+	    /* Now look for @.*::SUPER::ISA */
+	    GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
+	    if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) {
+		/* No @ISA in package ending in ::SUPER - drop suffix
+		   and see if there is an @ISA there
+		 */
+		HV *basestash;
+		char ch = packname[len-7];
+		AV *av;
+		packname[len-7] = '\0';
+		basestash = gv_stashpv(packname, TRUE);
+		packname[len-7] = ch;
+		gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE);
+		if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+		     /* Okay found @ISA after dropping the SUPER, alias it */
+	             SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+	             sv_catpvn(tmpstr, "::ISA", 5);
+		     gv  = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
+                     if (gv) {
+			GvAV(gv) = (AV*)SvREFCNT_inc(av);
+			/* ... and re-try lookup */
+			gv = gv_fetchmeth(stash, name, nend - name, 0);
+		     } else {
+			croak("Cannot create %s::ISA",HvNAME(stash));
+		     }
+		}
+	    }
+	}     
+    }
+
+    if (!gv) {
+	CV* cv;
+
+	if (strEQ(name,"import") || strEQ(name,"unimport"))
+	    gv = &sv_yes;
+	else if (strNE(name, "AUTOLOAD")) {
+	    gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0);
+	    if (gv && (cv = GvCV(gv))) { /* One more chance... */
+		SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+		sv_catpvn(tmpstr,"::", 2);
+		sv_catpvn(tmpstr, name, nend - name);
+		sv_setsv(GvSV(CvGV(cv)), tmpstr);
+		if (tainting)
+		    sv_unmagic(GvSV(CvGV(cv)), 't');
+	    }
+	}
+    }
+    return gv;
+}
+
+HV*
+gv_stashpv(name,create)
+char *name;
+I32 create;
+{
+    char tmpbuf[1234];
+    HV *stash;
+    GV *tmpgv;
+    /* Use strncpy to avoid bug in VMS sprintf */
+    /* sprintf(tmpbuf,"%.*s::",1200,name); */
+    strncpy(tmpbuf, name, 1200);
+    tmpbuf[1200] = '\0';  /* just in case . . . */
+    strcat(tmpbuf, "::");
+    tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
+    if (!tmpgv)
+	return 0;
+    if (!GvHV(tmpgv))
+	GvHV(tmpgv) = newHV();
+    stash = GvHV(tmpgv);
+    if (!HvNAME(stash))
+	HvNAME(stash) = savepv(name);
+    return stash;
+}
+
+HV*
+gv_stashsv(sv,create)
+SV *sv;
+I32 create;
+{
+    return gv_stashpv(SvPV(sv,na), create);
+}
+
+
+GV *
+gv_fetchpv(nambeg,add,sv_type)
+char *nambeg;
+I32 add;
+I32 sv_type;
+{
+    register char *name = nambeg;
+    register GV *gv = 0;
+    GV**gvp;
+    I32 len;
+    register char *namend;
+    HV *stash = 0;
+    bool global = FALSE;
+    char *tmpbuf;
+
+    if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+	name++;
+
+    for (namend = name; *namend; namend++) {
+	if ((*namend == '\'' && namend[1]) ||
+	    (*namend == ':' && namend[1] == ':'))
+	{
+	    if (!stash)
+		stash = defstash;
+	    if (!SvREFCNT(stash))	/* symbol table under destruction */
+		return Nullgv;
+
+	    len = namend - name;
+	    if (len > 0) {
+		New(601, tmpbuf, len+3, char);
+		Copy(name, tmpbuf, len, char);
+		tmpbuf[len++] = ':';
+		tmpbuf[len++] = ':';
+		tmpbuf[len] = '\0';
+		gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
+		Safefree(tmpbuf);
+		if (!gvp || *gvp == (GV*)&sv_undef)
+		    return Nullgv;
+		gv = *gvp;
+
+		if (SvTYPE(gv) == SVt_PVGV)
+		    GvMULTI_on(gv);
+		else if (!add)
+		    return Nullgv;
+		else
+		    gv_init(gv, stash, nambeg, namend - nambeg, (add & 2));
+
+		if (!(stash = GvHV(gv)))
+		    stash = GvHV(gv) = newHV();
+
+		if (!HvNAME(stash))
+		    HvNAME(stash) = savepvn(nambeg, namend - nambeg);
+	    }
+
+	    if (*namend == ':')
+		namend++;
+	    namend++;
+	    name = namend;
+	    if (!*name)
+		return gv ? gv : *hv_fetch(defstash, "main::", 6, TRUE);
+	}
+    }
+    len = namend - name;
+    if (!len)
+	len = 1;
+
+    /* No stash in name, so see how we can default */
+
+    if (!stash) {
+	if (isIDFIRST(*name)) {
+	    if (isUPPER(*name)) {
+		if (*name > 'I') {
+		    if (*name == 'S' && (
+		      strEQ(name, "SIG") ||
+		      strEQ(name, "STDIN") ||
+		      strEQ(name, "STDOUT") ||
+		      strEQ(name, "STDERR") ))
+			global = TRUE;
+		}
+		else if (*name > 'E') {
+		    if (*name == 'I' && strEQ(name, "INC"))
+			global = TRUE;
+		}
+		else if (*name > 'A') {
+		    if (*name == 'E' && strEQ(name, "ENV"))
+			global = TRUE;
+		}
+		else if (*name == 'A' && (
+		  strEQ(name, "ARGV") ||
+		  strEQ(name, "ARGVOUT") ))
+		    global = TRUE;
+	    }
+	    else if (*name == '_' && !name[1])
+		global = TRUE;
+	    if (global)
+		stash = defstash;
+	    else if ((COP*)curcop == &compiling) {
+		stash = curstash;
+		if (add && (hints & HINT_STRICT_VARS) &&
+		    sv_type != SVt_PVCV &&
+		    sv_type != SVt_PVGV &&
+		    sv_type != SVt_PVFM &&
+		    sv_type != SVt_PVIO &&
+		    !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
+		{
+		    gvp = (GV**)hv_fetch(stash,name,len,0);
+		    if (!gvp ||
+			*gvp == (GV*)&sv_undef ||
+			SvTYPE(*gvp) != SVt_PVGV)
+		    {
+			stash = 0;
+		    }
+		    else if (sv_type == SVt_PV   && !GvIMPORTED_SV(*gvp) ||
+			     sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
+			     sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
+		    {
+			warn("Variable \"%c%s\" is not imported",
+			    sv_type == SVt_PVAV ? '@' :
+			    sv_type == SVt_PVHV ? '%' : '$',
+			    name);
+			if (GvCV(*gvp))
+			    warn("(Did you mean &%s instead?)\n", name);
+			stash = 0;
+		    }
+		}
+	    }
+	    else
+		stash = curcop->cop_stash;
+	}
+	else
+	    stash = defstash;
+    }
+
+    /* By this point we should have a stash and a name */
+
+    if (!stash) {
+	if (add) {
+	    warn("Global symbol \"%s\" requires explicit package name", name);
+	    ++error_count;
+	    stash = curstash ? curstash : defstash;	/* avoid core dumps */
+	}
+	else
+	    return Nullgv;
+    }
+
+    if (!SvREFCNT(stash))	/* symbol table under destruction */
+	return Nullgv;
+
+    gvp = (GV**)hv_fetch(stash,name,len,add);
+    if (!gvp || *gvp == (GV*)&sv_undef)
+	return Nullgv;
+    gv = *gvp;
+    if (SvTYPE(gv) == SVt_PVGV) {
+	if (add) {
+	    GvMULTI_on(gv);
+	    gv_init_sv(gv, sv_type);
+	}
+	return gv;
+    }
+
+    /* Adding a new symbol */
+
+    if (add & 4)
+	warn("Had to create %s unexpectedly", nambeg);
+    gv_init(gv, stash, name, len, add & 2);
+    gv_init_sv(gv, sv_type);
+
+    /* set up magic where warranted */
+    switch (*name) {
+    case 'A':
+	if (strEQ(name, "ARGV")) {
+	    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
+	}
+	break;
+
+    case 'a':
+    case 'b':
+	if (len == 1)
+	    GvMULTI_on(gv);
+	break;
+    case 'E':
+	if (strnEQ(name, "EXPORT", 6))
+	    GvMULTI_on(gv);
+	break;
+    case 'I':
+	if (strEQ(name, "ISA")) {
+	    AV* av = GvAVn(gv);
+	    GvMULTI_on(gv);
+	    sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
+	    if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
+	    {
+		char *pname;
+		av_push(av, newSVpv(pname = "NDBM_File",0));
+		gv_stashpv(pname, TRUE);
+		av_push(av, newSVpv(pname = "DB_File",0));
+		gv_stashpv(pname, TRUE);
+		av_push(av, newSVpv(pname = "GDBM_File",0));
+		gv_stashpv(pname, TRUE);
+		av_push(av, newSVpv(pname = "SDBM_File",0));
+		gv_stashpv(pname, TRUE);
+		av_push(av, newSVpv(pname = "ODBM_File",0));
+		gv_stashpv(pname, TRUE);
+	    }
+	}
+	break;
+#ifdef OVERLOAD
+    case 'O':
+        if (strEQ(name, "OVERLOAD")) {
+            HV* hv = GvHVn(gv);
+            GvMULTI_on(gv);
+            sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
+        }
+        break;
+#endif /* OVERLOAD */
+    case 'S':
+	if (strEQ(name, "SIG")) {
+	    HV *hv;
+	    siggv = gv;
+	    GvMULTI_on(siggv);
+	    hv = GvHVn(siggv);
+	    hv_magic(hv, siggv, 'S');
+
+	    /* initialize signal stack */
+	    signalstack = newAV();
+	    AvREAL_off(signalstack);
+	    av_extend(signalstack, 30);
+	    av_fill(signalstack, 0);
+	}
+	break;
+
+    case '&':
+	if (len > 1)
+	    break;
+	ampergv = gv;
+	sawampersand = TRUE;
+	goto ro_magicalize;
+
+    case '`':
+	if (len > 1)
+	    break;
+	leftgv = gv;
+	sawampersand = TRUE;
+	goto ro_magicalize;
+
+    case '\'':
+	if (len > 1)
+	    break;
+	rightgv = gv;
+	sawampersand = TRUE;
+	goto ro_magicalize;
+
+    case ':':
+	if (len > 1)
+	    break;
+	sv_setpv(GvSV(gv),chopset);
+	goto magicalize;
+
+    case '#':
+    case '*':
+	if (dowarn && len == 1 && sv_type == SVt_PV)
+	    warn("Use of $%s is deprecated", name);
+	/* FALL THROUGH */
+    case '[':
+    case '!':
+    case '?':
+    case '^':
+    case '~':
+    case '=':
+    case '-':
+    case '%':
+    case '.':
+    case '(':
+    case ')':
+    case '<':
+    case '>':
+    case ',':
+    case '\\':
+    case '/':
+    case '|':
+    case '\001':
+    case '\004':
+    case '\005':
+    case '\006':
+    case '\010':
+    case '\017':
+    case '\t':
+    case '\020':
+    case '\024':
+    case '\027':
+	if (len > 1)
+	    break;
+	goto magicalize;
+
+    case '+':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      ro_magicalize:
+	SvREADONLY_on(GvSV(gv));
+      magicalize:
+	sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
+	break;
+
+    case '\014':
+	if (len > 1)
+	    break;
+	sv_setpv(GvSV(gv),"\f");
+	formfeed = GvSV(gv);
+	break;
+    case ';':
+	if (len > 1)
+	    break;
+	sv_setpv(GvSV(gv),"\034");
+	break;
+    case ']':
+	if (len == 1) {
+	    SV *sv;
+	    sv = GvSV(gv);
+	    sv_upgrade(sv, SVt_PVNV);
+	    sv_setpv(sv, patchlevel);
+	}
+	break;
+    }
+    return gv;
+}
+
+void
+gv_fullname(sv,gv)
+SV *sv;
+GV *gv;
+{
+    HV *hv = GvSTASH(gv);
+
+    if (!hv)
+	return;
+    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
+    sv_catpv(sv,HvNAME(hv));
+    sv_catpvn(sv,"::", 2);
+    sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
+}
+
+void
+gv_efullname(sv,gv)
+SV *sv;
+GV *gv;
+{
+    GV* egv = GvEGV(gv);
+    HV *hv;
+    
+    if (!egv)
+	egv = gv;
+    hv = GvSTASH(egv);
+    if (!hv)
+	return;
+
+    sv_setpv(sv, sv == (SV*)gv ? "*" : "");
+    sv_catpv(sv,HvNAME(hv));
+    sv_catpvn(sv,"::", 2);
+    sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv));
+}
+
+IO *
+newIO()
+{
+    IO *io;
+    GV *iogv;
+
+    io = (IO*)NEWSV(0,0);
+    sv_upgrade((SV *)io,SVt_PVIO);
+    SvREFCNT(io) = 1;
+    SvOBJECT_on(io);
+    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVHV);
+    SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
+    return io;
+}
+
+void
+gv_check(stash)
+HV* stash;
+{
+    register HE *entry;
+    register I32 i;
+    register GV *gv;
+    HV *hv;
+    GV *filegv;
+
+    if (!HvARRAY(stash))
+	return;
+    for (i = 0; i <= (I32) HvMAX(stash); i++) {
+	for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
+	    if (entry->hent_key[entry->hent_klen-1] == ':' &&
+		(gv = (GV*)entry->hent_val) && (hv = GvHV(gv)) && HvNAME(hv))
+	    {
+		if (hv != defstash)
+		     gv_check(hv);              /* nested package */
+	    }
+	    else if (isALPHA(*entry->hent_key)) {
+		gv = (GV*)entry->hent_val;
+		if (GvMULTI(gv))
+		    continue;
+		curcop->cop_line = GvLINE(gv);
+		filegv = GvFILEGV(gv);
+		curcop->cop_filegv = filegv;
+		if (filegv && GvMULTI(filegv))	/* Filename began with slash */
+		    continue;
+		warn("Identifier \"%s::%s\" used only once: possible typo",
+			HvNAME(stash), GvNAME(gv));
+	    }
+	}
+    }
+}
+
+GV *
+newGVgen(pack)
+char *pack;
+{
+    (void)sprintf(tokenbuf,"%s::_GEN_%ld",pack,(long)gensym++);
+    return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV);
+}
+
+/* hopefully this is only called on local symbol table entries */
+
+GP*
+gp_ref(gp)
+GP* gp;
+{
+    gp->gp_refcnt++;
+    return gp;
+
+}
+
+void
+gp_free(gv)
+GV* gv;
+{
+    GP* gp;
+    CV* cv;
+
+    if (!gv || !(gp = GvGP(gv)))
+	return;
+    if (gp->gp_refcnt == 0) {
+        warn("Attempt to free unreferenced glob pointers");
+        return;
+    }
+    if (--gp->gp_refcnt > 0) {
+	if (gp->gp_egv == gv)
+	    gp->gp_egv = 0;
+        return;
+    }
+
+    SvREFCNT_dec(gp->gp_sv);
+    SvREFCNT_dec(gp->gp_av);
+    SvREFCNT_dec(gp->gp_hv);
+    SvREFCNT_dec(gp->gp_io);
+    if ((cv = gp->gp_cv) && !GvCVGEN(gv))
+	SvREFCNT_dec(cv);
+    SvREFCNT_dec(gp->gp_form);
+
+    Safefree(gp);
+    GvGP(gv) = 0;
+}
+
+#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+#define MICROPORT
+#endif
+
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+AV *GvAVn(gv)
+register GV *gv;
+{
+    if (GvGP(gv)->gp_av) 
+	return GvGP(gv)->gp_av;
+    else
+	return GvGP(gv_AVadd(gv))->gp_av;
+}
+
+HV *GvHVn(gv)
+register GV *gv;
+{
+    if (GvGP(gv)->gp_hv)
+	return GvGP(gv)->gp_hv;
+    else
+	return GvGP(gv_HVadd(gv))->gp_hv;
+}
+#endif			/* Microport 2.4 hack */
+
+#ifdef OVERLOAD
+/* Updates and caches the CV's */
+
+bool
+Gv_AMupdate(stash)
+HV* stash;
+{
+  GV** gvp;
+  HV* hv;
+  GV* gv;
+  CV* cv;
+  MAGIC* mg=mg_find((SV*)stash,'c');
+  AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
+
+  if (mg && (amtp=((AMT*)(mg->mg_ptr)))->was_ok_am == amagic_generation &&
+             amtp->was_ok_sub == sub_generation)
+      return HV_AMAGIC(stash)? TRUE: FALSE;
+  gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE);
+  if (amtp && amtp->table) {
+    int i;
+    for (i=1;i<NofAMmeth*2;i++) {
+      if (amtp->table[i]) {
+	SvREFCNT_dec(amtp->table[i]);
+      }
+    }
+  }
+  sv_unmagic((SV*)stash, 'c');
+
+  DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
+
+  if (gvp && ((gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv)))) {
+    int filled=0;
+    int i;
+    char *cp;
+    AMT amt;
+    SV* sv;
+    SV** svp;
+
+/*  if (*(svp)==(SV*)amagic_generation && *(svp+1)==(SV*)sub_generation) {
+      DEBUG_o( deb("Overload magic in package %s up-to-date\n",HvNAME(stash))
+);
+      return HV_AMAGIC(stash)? TRUE: FALSE;
+    }*/
+
+    amt.was_ok_am=amagic_generation;
+    amt.was_ok_sub=sub_generation;
+    amt.fallback=AMGfallNO;
+
+    /* Work with "fallback" key, which we assume to be first in AMG_names */
+
+    if ((cp=((char**)(*AMG_names))[0]) &&
+	(svp=(SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) {
+      if (SvTRUE(sv)) amt.fallback=AMGfallYES;
+      else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
+    }
+
+    for (i=1;i<NofAMmeth*2;i++) {
+      cv=0;
+
+      if ( (cp=((char**)(*AMG_names))[i]) ) {
+        svp=(SV**)hv_fetch(hv,cp,strlen(cp),FALSE);
+        if (svp && ((sv = *svp) != (GV*)&sv_undef)) {
+          switch (SvTYPE(sv)) {
+            default:
+              if (!SvROK(sv)) {
+                if (!SvOK(sv)) break;
+		gv = gv_fetchmethod(stash, SvPV(sv, na));
+                if (gv) cv = GvCV(gv);
+                break;
+              }
+              cv = (CV*)SvRV(sv);
+              if (SvTYPE(cv) == SVt_PVCV)
+                  break;
+                /* FALL THROUGH */
+            case SVt_PVHV:
+            case SVt_PVAV:
+	      die("Not a subroutine reference in %%OVERLOAD");
+	      return FALSE;
+            case SVt_PVCV:
+                cv = (CV*)sv;
+                break;
+            case SVt_PVGV:
+                if (!(cv = GvCV((GV*)sv)))
+                    cv = sv_2cv(sv, &stash, &gv, TRUE);
+                break;
+          }
+          if (cv) filled=1;
+	  else {
+	    die("Method for operation %s not found in package %.256s during blessing\n",
+		cp,HvNAME(stash));
+	    return FALSE;
+	  }
+        }
+      }
+      amt.table[i]=(CV*)SvREFCNT_inc(cv);
+    }
+    sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(amt));
+    if (filled) {
+/*    HV_badAMAGIC_off(stash);*/
+      HV_AMAGIC_on(stash);
+      return TRUE;
+    }
+  }
+/*HV_badAMAGIC_off(stash);*/
+  HV_AMAGIC_off(stash);
+  return FALSE;
+}
+
+/* During call to this subroutine stack can be reallocated. It is
+ * advised to call SPAGAIN macro in your code after call */
+
+SV*
+amagic_call(left,right,method,flags)
+SV* left;
+SV* right;
+int method;
+int flags; 
+{
+  MAGIC *mg; 
+  CV *cv; 
+  CV **cvp=NULL, **ocvp=NULL;
+  AMT *amtp, *oamtp;
+  int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
+  int postpr=0, inc_dec_ass=0, assignshift=assign?1:0;
+  HV* stash;
+  if (!(AMGf_noleft & flags) && SvAMAGIC(left)
+      && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
+      && (ocvp = cvp = ((oamtp=amtp=(AMT*)mg->mg_ptr)->table))
+      && ((cv = cvp[off=method+assignshift]) 
+	  || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
+						          * usual method */
+		  (fl = 1, cv = cvp[off=method])))) {
+    lr = -1;			/* Call method for left argument */
+  } else {
+    if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
+      int logic;
+
+      /* look for substituted methods */
+	 switch (method) {
+	 case inc_amg:
+	   if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1))
+	       || ((cv = cvp[off=add_amg]) && (postpr=1))) {
+	     right = &sv_yes; lr = -1; assign = 1;
+	   }
+	   break;
+	 case dec_amg:
+	   if (((cv = cvp[off=subtr_ass_amg])  && (inc_dec_ass=1))
+	       || ((cv = cvp[off=subtr_amg]) && (postpr=1))) {
+	     right = &sv_yes; lr = -1; assign = 1;
+	   }
+	   break;
+	 case bool__amg:
+	   (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg]));
+	   break;
+	 case numer_amg:
+	   (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg]));
+	   break;
+	 case string_amg:
+	   (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
+	   break;
+	 case copy_amg:
+	   {
+	     SV* ref=SvRV(left);
+	     if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { /* Just to be
+						      * extra
+						      * causious,
+						      * maybe in some
+						      * additional
+						      * cases sv_setsv
+						      * is safe too */
+		SV* newref = newSVsv(ref);
+		SvOBJECT_on(newref);
+		SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+		return newref;
+	     }
+	   }
+	   break;
+	 case abs_amg:
+	   if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) 
+	       && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
+	     SV* nullsv=sv_2mortal(newSViv(0));
+	     if (off1==lt_amg) {
+	       SV* lessp = amagic_call(left,nullsv,
+				       lt_amg,AMGf_noright);
+	       logic = SvTRUE(lessp);
+	     } else {
+	       SV* lessp = amagic_call(left,nullsv,
+				       ncmp_amg,AMGf_noright);
+	       logic = (SvNV(lessp) < 0);
+	     }
+	     if (logic) {
+	       if (off==subtr_amg) {
+		 right = left;
+		 left = nullsv;
+		 lr = 1;
+	       }
+	     } else {
+	       return left;
+	     }
+	   }
+	   break;
+	 case neg_amg:
+	   if (cv = cvp[off=subtr_amg]) {
+	     right = left;
+	     left = sv_2mortal(newSViv(0));
+	     lr = 1;
+	   }
+	   break;
+	 default:
+	   goto not_found;
+	 }
+	 if (!cv) goto not_found;
+    } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
+	       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
+	       && (cvp = ((amtp=(AMT*)mg->mg_ptr)->table))
+	       && (cv = cvp[off=method])) { /* Method for right
+					     * argument found */
+      lr=1;
+    } else if (((ocvp && oamtp->fallback > AMGfallNEVER 
+		 && (cvp=ocvp) && (lr = -1)) 
+		|| (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
+	       && !(flags & AMGf_unary)) {
+				/* We look for substitution for
+				 * comparison operations and
+				 * concatendation */
+      if (method==concat_amg || method==concat_ass_amg
+	  || method==repeat_amg || method==repeat_ass_amg) {
+	return NULL;		/* Delegate operation to string conversion */
+      }
+      off = -1;
+      switch (method) {
+	 case lt_amg:
+	 case le_amg:
+	 case gt_amg:
+	 case ge_amg:
+	 case eq_amg:
+	 case ne_amg:
+	   postpr = 1; off=ncmp_amg; break;
+	 case slt_amg:
+	 case sle_amg:
+	 case sgt_amg:
+	 case sge_amg:
+	 case seq_amg:
+	 case sne_amg:
+	   postpr = 1; off=scmp_amg; break;
+	 }
+      if (off != -1) cv = cvp[off];
+      if (!cv) {
+	goto not_found;
+      }
+    } else {
+    not_found:			/* No method found, either report or die */
+      if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */
+	notfound = 1; lr = -1;
+      } else if (cvp && (cv=cvp[nomethod_amg])) {
+	notfound = 1; lr = 1;
+      } else {
+        if (off==-1) off=method;
+	sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
+		      ((char**)AMG_names)[method + assignshift],
+		      SvAMAGIC(left)? 
+		        "in overloaded package ":
+		        "has no overloaded magic",
+		      SvAMAGIC(left)? 
+		        HvNAME(SvSTASH(SvRV(left))):
+		        "",
+		      SvAMAGIC(right)? 
+		        "in overloaded package ":
+		        "has no overloaded magic",
+		      SvAMAGIC(right)? 
+		        HvNAME(SvSTASH(SvRV(right))):
+		        "");
+	if (amtp && amtp->fallback >= AMGfallYES) {
+	  DEBUG_o( deb(buf) );
+	} else {
+	  die(buf);
+	}
+	return NULL;
+      }
+    }
+  }
+  if (!notfound) {
+    DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
+		 ((char**)AMG_names)[off],
+		 method+assignshift==off? "" :
+		             " (initially `",
+		 method+assignshift==off? "" :
+		             ((char**)AMG_names)[method+assignshift],
+		 method+assignshift==off? "" : "')",
+		 flags & AMGf_unary? "" :
+		   lr==1 ? " for right argument": " for left argument",
+		 flags & AMGf_unary? " for argument" : "",
+		 HvNAME(stash), 
+		 fl? ",\n\tassignment variant used": "") );
+    /* Since we use shallow copy during assignment, we need
+     * to dublicate the contents, probably calling user-supplied
+     * version of copy operator
+     */
+    if ((method + assignshift==off 
+	 && (assign || method==inc_amg || method==dec_amg))
+	|| inc_dec_ass) RvDEEPCP(left);
+  }
+  {
+    dSP;
+    BINOP myop;
+    SV* res;
+
+    Zero(&myop, 1, BINOP);
+    myop.op_last = (OP *) &myop;
+    myop.op_next = Nullop;
+    myop.op_flags = OPf_KNOW|OPf_STACKED;
+
+    ENTER;
+    SAVESPTR(op);
+    op = (OP *) &myop;
+    PUTBACK;
+    pp_pushmark();
+
+    EXTEND(sp, notfound + 5);
+    PUSHs(lr>0? right: left);
+    PUSHs(lr>0? left: right);
+    PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
+    if (notfound) {
+      PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[method + assignshift],0)) );
+    }
+    PUSHs((SV*)cv);
+    PUTBACK;
+
+    if (op = pp_entersub())
+      runops();
+    LEAVE;
+    SPAGAIN;
+
+    res=POPs;
+    PUTBACK;
+
+    if (notfound) {
+      /* sv_2mortal(res); */
+      return NULL;
+    }
+
+    if (postpr) {
+      int ans;
+      switch (method) {
+      case le_amg:
+      case sle_amg:
+	ans=SvIV(res)<=0; break;
+      case lt_amg:
+      case slt_amg:
+	ans=SvIV(res)<0; break;
+      case ge_amg:
+      case sge_amg:
+	ans=SvIV(res)>=0; break;
+      case gt_amg:
+      case sgt_amg:
+	ans=SvIV(res)>0; break;
+      case eq_amg:
+      case seq_amg:
+	ans=SvIV(res)==0; break;
+      case ne_amg:
+      case sne_amg:
+	ans=SvIV(res)!=0; break;
+      case inc_amg:
+      case dec_amg:
+	SvSetSV(left,res); return res; break;
+      }
+      return ans? &sv_yes: &sv_no;
+    } else if (method==copy_amg) {
+      if (!SvROK(res)) {
+	die("Copy method did not return a reference");
+      }
+      return SvREFCNT_inc(SvRV(res));
+    } else {
+      return res;
+    }
+  }
+}
+#endif /* OVERLOAD */
diff --git a/gnu/usr.bin/perl/gv.h b/gnu/usr.bin/perl/gv.h
new file mode 100644
index 00000000000..b823fa59474
--- /dev/null
+++ b/gnu/usr.bin/perl/gv.h
@@ -0,0 +1,128 @@
+/*    gv.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+struct gp {
+    SV *	gp_sv;		/* scalar value */
+    U32		gp_refcnt;	/* how many globs point to this? */
+    struct io *	gp_io;		/* filehandle value */
+    CV *	gp_form;	/* format value */
+    AV *	gp_av;		/* array value */
+    HV *	gp_hv;		/* associative array value */
+    GV *	gp_egv;		/* effective gv, if *glob */
+    CV *	gp_cv;		/* subroutine value */
+    U32		gp_cvgen;	/* generational validity of cached gv_cv */
+    I32		gp_lastexpr;	/* used by nothing_in_common() */
+    line_t	gp_line;	/* line first declared at (for -w) */
+    GV *	gp_filegv;	/* file first declared in (for -w) */
+};
+
+#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+#define MICROPORT
+#endif
+
+#define GvXPVGV(gv)	((XPVGV*)SvANY(gv))
+
+#define GvGP(gv)	(GvXPVGV(gv)->xgv_gp)
+#define GvNAME(gv)	(GvXPVGV(gv)->xgv_name)
+#define GvNAMELEN(gv)	(GvXPVGV(gv)->xgv_namelen)
+#define GvSTASH(gv)	(GvXPVGV(gv)->xgv_stash)
+#define GvFLAGS(gv)	(GvXPVGV(gv)->xgv_flags)
+
+#define GvSV(gv)	(GvGP(gv)->gp_sv)
+#define GvREFCNT(gv)	(GvGP(gv)->gp_refcnt)
+#define GvIO(gv)	((gv) && SvTYPE((SV*)gv) == SVt_PVGV ? GvIOp(gv) : 0)
+#define GvIOp(gv)	(GvGP(gv)->gp_io)
+#define GvIOn(gv)	(GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv)))
+
+#define GvFORM(gv)	(GvGP(gv)->gp_form)
+#define GvAV(gv)	(GvGP(gv)->gp_av)
+
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+AV *GvAVn();
+#else
+#define GvAVn(gv)	(GvGP(gv)->gp_av ? \
+			 GvGP(gv)->gp_av : \
+			 GvGP(gv_AVadd(gv))->gp_av)
+#endif
+#define GvHV(gv)	((GvGP(gv))->gp_hv)
+
+#ifdef	MICROPORT	/* Microport 2.4 hack */
+HV *GvHVn();
+#else
+#define GvHVn(gv)	(GvGP(gv)->gp_hv ? \
+			 GvGP(gv)->gp_hv : \
+			 GvGP(gv_HVadd(gv))->gp_hv)
+#endif			/* Microport 2.4 hack */
+
+#define GvCV(gv)	(GvGP(gv)->gp_cv)
+#define GvCVGEN(gv)	(GvGP(gv)->gp_cvgen)
+
+#define GvLASTEXPR(gv)	(GvGP(gv)->gp_lastexpr)
+
+#define GvLINE(gv)	(GvGP(gv)->gp_line)
+#define GvFILEGV(gv)	(GvGP(gv)->gp_filegv)
+
+#define GvEGV(gv)	(GvGP(gv)->gp_egv)
+#define GvENAME(gv)	GvNAME(GvEGV(gv) ? GvEGV(gv) : gv)
+#define GvESTASH(gv)	GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv)
+
+#define GVf_INTRO	0x01
+#define GVf_MULTI	0x02
+#define GVf_ASSUMECV	0x04
+#define GVf_IMPORTED	0xF0
+#define GVf_IMPORTED_SV	  0x10
+#define GVf_IMPORTED_AV	  0x20
+#define GVf_IMPORTED_HV	  0x40
+#define GVf_IMPORTED_CV	  0x80
+
+#define GvINTRO(gv)		(GvFLAGS(gv) & GVf_INTRO)
+#define GvINTRO_on(gv)		(GvFLAGS(gv) |= GVf_INTRO)
+#define GvINTRO_off(gv)		(GvFLAGS(gv) &= ~GVf_INTRO)
+
+#define GvMULTI(gv)		(GvFLAGS(gv) & GVf_MULTI)
+#define GvMULTI_on(gv)		(GvFLAGS(gv) |= GVf_MULTI)
+#define GvMULTI_off(gv)		(GvFLAGS(gv) &= ~GVf_MULTI)
+
+#define GvASSUMECV(gv)		(GvFLAGS(gv) & GVf_ASSUMECV)
+#define GvASSUMECV_on(gv)	(GvFLAGS(gv) |= GVf_ASSUMECV)
+#define GvASSUMECV_off(gv)	(GvFLAGS(gv) &= ~GVf_ASSUMECV)
+
+#define GvIMPORTED(gv)		(GvFLAGS(gv) & GVf_IMPORTED)
+#define GvIMPORTED_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED)
+#define GvIMPORTED_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED)
+
+#define GvIMPORTED_SV(gv)	(GvFLAGS(gv) & GVf_IMPORTED_SV)
+#define GvIMPORTED_SV_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED_SV)
+#define GvIMPORTED_SV_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED_SV)
+
+#define GvIMPORTED_AV(gv)	(GvFLAGS(gv) & GVf_IMPORTED_AV)
+#define GvIMPORTED_AV_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED_AV)
+#define GvIMPORTED_AV_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED_AV)
+
+#define GvIMPORTED_HV(gv)	(GvFLAGS(gv) & GVf_IMPORTED_HV)
+#define GvIMPORTED_HV_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED_HV)
+#define GvIMPORTED_HV_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED_HV)
+
+#define GvIMPORTED_CV(gv)	(GvFLAGS(gv) & GVf_IMPORTED_CV)
+#define GvIMPORTED_CV_on(gv)	(GvFLAGS(gv) |= GVf_IMPORTED_CV)
+#define GvIMPORTED_CV_off(gv)	(GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
+
+#define Nullgv Null(GV*)
+
+#define DM_UID   0x003
+#define DM_RUID   0x001
+#define DM_EUID   0x002
+#define DM_GID   0x030
+#define DM_RGID   0x010
+#define DM_EGID   0x020
+#define DM_DELAY 0x100
+
+#define GV_ADD		0x01
+#define GV_ADDMULTI	0x02
+#define GV_ADDWARN	0x04
diff --git a/gnu/usr.bin/perl/h2pl/README b/gnu/usr.bin/perl/h2pl/README
new file mode 100644
index 00000000000..5fe8ae7aa33
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/README
@@ -0,0 +1,71 @@
+[This file of Tom Christiansen's has been edited to change makelib to h2ph
+and .h to .ph where appropriate--law.]
+
+This directory contains files to help you convert the *.ph files generated my
+h2ph out of the perl source directory into *.pl files with all the
+indirection of the subroutine calls removed.  The .ph version will be more
+safely portable, because if something isn't defined on the new system, like
+&TIOCGETP, then you'll get a fatal run-time error on the system lacking that
+function.  Using the .pl version means that the subsequent scripts will give
+you a 0 $TIOCGETP and God only knows what may then happen.   Still, I like the
+.pl stuff because they're faster to load.
+
+FIrst, you need to run h2ph on things like sys/ioctl.h to get stuff
+into the perl library directory, often /usr/local/lib/perl.  For example,
+    # h2ph sys/ioctl.h
+takes /usr/include/sys/ioctl.h as input and writes (without i/o redirection)
+the file /usr/local/lib/perl/sys/ioctl.ph, which looks like this
+
+    eval 'sub TIOCM_RTS {0004;}';
+    eval 'sub TIOCM_ST {0010;}';
+    eval 'sub TIOCM_SR {0020;}';
+    eval 'sub TIOCM_CTS {0040;}';
+    eval 'sub TIOCM_CAR {0100;}';
+
+and much worse, rather than what Larry's ioctl.pl from the perl source dir has, 
+which is:
+
+    $TIOCM_RTS = 0004;
+    $TIOCM_ST = 0010;
+    $TIOCM_SR = 0020;
+    $TIOCM_CTS = 0040;
+    $TIOCM_CAR = 0100;
+
+[Workaround for fixed bug in makedir/h2ph deleted--law.]
+
+The more complicated ioctl subs look like this:
+
+    eval 'sub TIOCGSIZE {&TIOCGWINSZ;}';
+    eval 'sub TIOCGWINSZ {&_IOR("t", 104, \'struct winsize\');}';
+    eval 'sub TIOCSETD {&_IOW("t", 1, \'int\');}';
+    eval 'sub TIOCGETP {&_IOR("t", 8,\'struct sgttyb\');}';
+
+The _IO[RW] routines use a %sizeof array, which (presumably) 
+is keyed on the type name with the value being the size in bytes.  
+
+To build %sizeof, try running this in this directory:
+
+    % ./getioctlsizes 
+
+Which will tell you which things the %sizeof array needs
+to hold.  You can try to build a sizeof.ph file with:
+
+    % ./getioctlsizes | ./mksizes > sizeof.ph
+
+Note that mksizes hardcodes the #include files for all the types, so it will
+probably require customization.  Once you have sizeof.ph, install it in the
+perl library directory.  Run my tcbreak script to see whether you can do
+ioctls in perl now.  You'll get some kind of fatal run-time error if you
+can't.  That script should be included in this directory.
+
+If this works well, now you can try to convert the *.ph files into
+*.pl files.  Try this:
+
+    foreach file ( sysexits.ph sys/{errno.ph,ioctl.ph} )
+	./mkvars $file > t/$file:r.pl
+    end
+
+The last one will be the hardest.  If it works, should be able to 
+run tcbreak2 and have it work the same as tcbreak.
+
+Good luck.
diff --git a/gnu/usr.bin/perl/h2pl/cbreak.pl b/gnu/usr.bin/perl/h2pl/cbreak.pl
new file mode 100644
index 00000000000..422185eb7b4
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/cbreak.pl
@@ -0,0 +1,34 @@
+$sgttyb_t   = 'C4 S';
+
+sub cbreak {
+    &set_cbreak(1);
+}
+
+sub cooked {
+    &set_cbreak(0);
+}
+
+sub set_cbreak {
+    local($on) = @_;
+
+    require 'sizeof.ph';
+    require 'sys/ioctl.ph';
+
+    ioctl(STDIN,&TIOCGETP,$sgttyb)
+        || die "Can't ioctl TIOCGETP: $!";
+
+    @ary = unpack($sgttyb_t,$sgttyb);
+    if ($on) {
+        $ary[4] |= &CBREAK;
+        $ary[4] &= ~&ECHO;
+    } else {
+        $ary[4] &= ~&CBREAK;
+        $ary[4] |= &ECHO;
+    }
+    $sgttyb = pack($sgttyb_t,@ary);
+    ioctl(STDIN,&TIOCSETP,$sgttyb)
+            || die "Can't ioctl TIOCSETP: $!";
+
+}
+
+1;
diff --git a/gnu/usr.bin/perl/h2pl/cbreak2.pl b/gnu/usr.bin/perl/h2pl/cbreak2.pl
new file mode 100644
index 00000000000..8ac55a34975
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/cbreak2.pl
@@ -0,0 +1,33 @@
+$sgttyb_t   = 'C4 S';
+
+sub cbreak {
+    &set_cbreak(1);
+}
+
+sub cooked {
+    &set_cbreak(0);
+}
+
+sub set_cbreak {
+    local($on) = @_;
+
+    require 'sys/ioctl.pl';
+
+    ioctl(STDIN,$TIOCGETP,$sgttyb)
+        || die "Can't ioctl TIOCGETP: $!";
+
+    @ary = unpack($sgttyb_t,$sgttyb);
+    if ($on) {
+        $ary[4] |= $CBREAK;
+        $ary[4] &= ~$ECHO;
+    } else {
+        $ary[4] &= ~$CBREAK;
+        $ary[4] |= $ECHO;
+    }
+    $sgttyb = pack($sgttyb_t,@ary);
+    ioctl(STDIN,$TIOCSETP,$sgttyb)
+            || die "Can't ioctl TIOCSETP: $!";
+
+}
+
+1;
diff --git a/gnu/usr.bin/perl/h2pl/eg/sizeof.ph b/gnu/usr.bin/perl/h2pl/eg/sizeof.ph
new file mode 100644
index 00000000000..285bff18591
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/eg/sizeof.ph
@@ -0,0 +1,14 @@
+$sizeof{'char'} = 1;
+$sizeof{'int'} = 4;
+$sizeof{'long'} = 4;
+$sizeof{'struct arpreq'} = 36;
+$sizeof{'struct ifconf'} = 8;
+$sizeof{'struct ifreq'} = 32;
+$sizeof{'struct ltchars'} = 6;
+$sizeof{'struct pcntl'} = 116;
+$sizeof{'struct rtentry'} = 52;
+$sizeof{'struct sgttyb'} = 6;
+$sizeof{'struct tchars'} = 6;
+$sizeof{'struct ttychars'} = 14;
+$sizeof{'struct winsize'} = 8;
+$sizeof{'struct termios'} = 132;
diff --git a/gnu/usr.bin/perl/h2pl/eg/sys/errno.pl b/gnu/usr.bin/perl/h2pl/eg/sys/errno.pl
new file mode 100644
index 00000000000..d9ba3be190f
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/eg/sys/errno.pl
@@ -0,0 +1,92 @@
+$EPERM = 0x1;
+$ENOENT = 0x2;
+$ESRCH = 0x3;
+$EINTR = 0x4;
+$EIO = 0x5;
+$ENXIO = 0x6;
+$E2BIG = 0x7;
+$ENOEXEC = 0x8;
+$EBADF = 0x9;
+$ECHILD = 0xA;
+$EAGAIN = 0xB;
+$ENOMEM = 0xC;
+$EACCES = 0xD;
+$EFAULT = 0xE;
+$ENOTBLK = 0xF;
+$EBUSY = 0x10;
+$EEXIST = 0x11;
+$EXDEV = 0x12;
+$ENODEV = 0x13;
+$ENOTDIR = 0x14;
+$EISDIR = 0x15;
+$EINVAL = 0x16;
+$ENFILE = 0x17;
+$EMFILE = 0x18;
+$ENOTTY = 0x19;
+$ETXTBSY = 0x1A;
+$EFBIG = 0x1B;
+$ENOSPC = 0x1C;
+$ESPIPE = 0x1D;
+$EROFS = 0x1E;
+$EMLINK = 0x1F;
+$EPIPE = 0x20;
+$EDOM = 0x21;
+$ERANGE = 0x22;
+$EWOULDBLOCK = 0x23;
+$EINPROGRESS = 0x24;
+$EALREADY = 0x25;
+$ENOTSOCK = 0x26;
+$EDESTADDRREQ = 0x27;
+$EMSGSIZE = 0x28;
+$EPROTOTYPE = 0x29;
+$ENOPROTOOPT = 0x2A;
+$EPROTONOSUPPORT = 0x2B;
+$ESOCKTNOSUPPORT = 0x2C;
+$EOPNOTSUPP = 0x2D;
+$EPFNOSUPPORT = 0x2E;
+$EAFNOSUPPORT = 0x2F;
+$EADDRINUSE = 0x30;
+$EADDRNOTAVAIL = 0x31;
+$ENETDOWN = 0x32;
+$ENETUNREACH = 0x33;
+$ENETRESET = 0x34;
+$ECONNABORTED = 0x35;
+$ECONNRESET = 0x36;
+$ENOBUFS = 0x37;
+$EISCONN = 0x38;
+$ENOTCONN = 0x39;
+$ESHUTDOWN = 0x3A;
+$ETOOMANYREFS = 0x3B;
+$ETIMEDOUT = 0x3C;
+$ECONNREFUSED = 0x3D;
+$ELOOP = 0x3E;
+$ENAMETOOLONG = 0x3F;
+$EHOSTDOWN = 0x40;
+$EHOSTUNREACH = 0x41;
+$ENOTEMPTY = 0x42;
+$EPROCLIM = 0x43;
+$EUSERS = 0x44;
+$EDQUOT = 0x45;
+$ESTALE = 0x46;
+$EREMOTE = 0x47;
+$EDEADLK = 0x48;
+$ENOLCK = 0x49;
+$MTH_UNDEF_SQRT = 0x12C;
+$MTH_OVF_EXP = 0x12D;
+$MTH_UNDEF_LOG = 0x12E;
+$MTH_NEG_BASE = 0x12F;
+$MTH_ZERO_BASE = 0x130;
+$MTH_OVF_POW = 0x131;
+$MTH_LRG_SIN = 0x132;
+$MTH_LRG_COS = 0x133;
+$MTH_LRG_TAN = 0x134;
+$MTH_LRG_COT = 0x135;
+$MTH_OVF_TAN = 0x136;
+$MTH_OVF_COT = 0x137;
+$MTH_UNDEF_ASIN = 0x138;
+$MTH_UNDEF_ACOS = 0x139;
+$MTH_UNDEF_ATAN2 = 0x13A;
+$MTH_OVF_SINH = 0x13B;
+$MTH_OVF_COSH = 0x13C;
+$MTH_UNDEF_ZLOG = 0x13D;
+$MTH_UNDEF_ZDIV = 0x13E;
diff --git a/gnu/usr.bin/perl/h2pl/eg/sys/ioctl.pl b/gnu/usr.bin/perl/h2pl/eg/sys/ioctl.pl
new file mode 100644
index 00000000000..0b552caa00e
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/eg/sys/ioctl.pl
@@ -0,0 +1,186 @@
+$_IOCTL_ = 0x1;
+$TIOCGSIZE = 0x40087468;
+$TIOCSSIZE = 0x80087467;
+$IOCPARM_MASK = 0x7F;
+$IOC_VOID = 0x20000000;
+$IOC_OUT = 0x40000000;
+$IOC_IN = 0x80000000;
+$IOC_INOUT = 0xC0000000;
+$TIOCGETD = 0x40047400;
+$TIOCSETD = 0x80047401;
+$TIOCHPCL = 0x20007402;
+$TIOCMODG = 0x40047403;
+$TIOCMODS = 0x80047404;
+$TIOCM_LE = 0x1;
+$TIOCM_DTR = 0x2;
+$TIOCM_RTS = 0x4;
+$TIOCM_ST = 0x8;
+$TIOCM_SR = 0x10;
+$TIOCM_CTS = 0x20;
+$TIOCM_CAR = 0x40;
+$TIOCM_CD = 0x40;
+$TIOCM_RNG = 0x80;
+$TIOCM_RI = 0x80;
+$TIOCM_DSR = 0x100;
+$TIOCGETP = 0x40067408;
+$TIOCSETP = 0x80067409;
+$TIOCSETN = 0x8006740A;
+$TIOCEXCL = 0x2000740D;
+$TIOCNXCL = 0x2000740E;
+$TIOCFLUSH = 0x80047410;
+$TIOCSETC = 0x80067411;
+$TIOCGETC = 0x40067412;
+$TIOCSET = 0x80047413;
+$TIOCBIS = 0x80047414;
+$TIOCBIC = 0x80047415;
+$TIOCGET = 0x40047416;
+$TANDEM = 0x1;
+$CBREAK = 0x2;
+$LCASE = 0x4;
+$ECHO = 0x8;
+$CRMOD = 0x10;
+$RAW = 0x20;
+$ODDP = 0x40;
+$EVENP = 0x80;
+$ANYP = 0xC0;
+$NLDELAY = 0x300;
+$NL0 = 0x0;
+$NL1 = 0x100;
+$NL2 = 0x200;
+$NL3 = 0x300;
+$TBDELAY = 0xC00;
+$TAB0 = 0x0;
+$TAB1 = 0x400;
+$TAB2 = 0x800;
+$XTABS = 0xC00;
+$CRDELAY = 0x3000;
+$CR0 = 0x0;
+$CR1 = 0x1000;
+$CR2 = 0x2000;
+$CR3 = 0x3000;
+$VTDELAY = 0x4000;
+$FF0 = 0x0;
+$FF1 = 0x4000;
+$BSDELAY = 0x8000;
+$BS0 = 0x0;
+$BS1 = 0x8000;
+$ALLDELAY = 0xFF00;
+$CRTBS = 0x10000;
+$PRTERA = 0x20000;
+$CRTERA = 0x40000;
+$TILDE = 0x80000;
+$MDMBUF = 0x100000;
+$LITOUT = 0x200000;
+$TOSTOP = 0x400000;
+$FLUSHO = 0x800000;
+$NOHANG = 0x1000000;
+$L001000 = 0x2000000;
+$CRTKIL = 0x4000000;
+$L004000 = 0x8000000;
+$CTLECH = 0x10000000;
+$PENDIN = 0x20000000;
+$DECCTQ = 0x40000000;
+$NOFLSH = 0x80000000;
+$TIOCCSET = 0x800E7417;
+$TIOCCGET = 0x400E7418;
+$TIOCLBIS = 0x8004747F;
+$TIOCLBIC = 0x8004747E;
+$TIOCLSET = 0x8004747D;
+$TIOCLGET = 0x4004747C;
+$LCRTBS = 0x1;
+$LPRTERA = 0x2;
+$LCRTERA = 0x4;
+$LTILDE = 0x8;
+$LMDMBUF = 0x10;
+$LLITOUT = 0x20;
+$LTOSTOP = 0x40;
+$LFLUSHO = 0x80;
+$LNOHANG = 0x100;
+$LCRTKIL = 0x400;
+$LCTLECH = 0x1000;
+$LPENDIN = 0x2000;
+$LDECCTQ = 0x4000;
+$LNOFLSH = 0x8000;
+$TIOCSBRK = 0x2000747B;
+$TIOCCBRK = 0x2000747A;
+$TIOCSDTR = 0x20007479;
+$TIOCCDTR = 0x20007478;
+$TIOCGPGRP = 0x40047477;
+$TIOCSPGRP = 0x80047476;
+$TIOCSLTC = 0x80067475;
+$TIOCGLTC = 0x40067474;
+$TIOCOUTQ = 0x40047473;
+$TIOCSTI = 0x80017472;
+$TIOCNOTTY = 0x20007471;
+$TIOCPKT = 0x80047470;
+$TIOCPKT_DATA = 0x0;
+$TIOCPKT_FLUSHREAD = 0x1;
+$TIOCPKT_FLUSHWRITE = 0x2;
+$TIOCPKT_STOP = 0x4;
+$TIOCPKT_START = 0x8;
+$TIOCPKT_NOSTOP = 0x10;
+$TIOCPKT_DOSTOP = 0x20;
+$TIOCSTOP = 0x2000746F;
+$TIOCSTART = 0x2000746E;
+$TIOCREMOTE = 0x20007469;
+$TIOCGWINSZ = 0x40087468;
+$TIOCSWINSZ = 0x80087467;
+$TIOCRESET = 0x20007466;
+$OTTYDISC = 0x0;
+$NETLDISC = 0x1;
+$NTTYDISC = 0x2;
+$FIOCLEX = 0x20006601;
+$FIONCLEX = 0x20006602;
+$FIONREAD = 0x4004667F;
+$FIONBIO = 0x8004667E;
+$FIOASYNC = 0x8004667D;
+$FIOSETOWN = 0x8004667C;
+$FIOGETOWN = 0x4004667B;
+$STPUTTABLE = 0x8004667A;
+$STGETTABLE = 0x80046679;
+$SIOCSHIWAT = 0x80047300;
+$SIOCGHIWAT = 0x40047301;
+$SIOCSLOWAT = 0x80047302;
+$SIOCGLOWAT = 0x40047303;
+$SIOCATMARK = 0x40047307;
+$SIOCSPGRP = 0x80047308;
+$SIOCGPGRP = 0x40047309;
+$SIOCADDRT = 0x8034720A;
+$SIOCDELRT = 0x8034720B;
+$SIOCSIFADDR = 0x8020690C;
+$SIOCGIFADDR = 0xC020690D;
+$SIOCSIFDSTADDR = 0x8020690E;
+$SIOCGIFDSTADDR = 0xC020690F;
+$SIOCSIFFLAGS = 0x80206910;
+$SIOCGIFFLAGS = 0xC0206911;
+$SIOCGIFBRDADDR = 0xC0206912;
+$SIOCSIFBRDADDR = 0x80206913;
+$SIOCGIFCONF = 0xC0086914;
+$SIOCGIFNETMASK = 0xC0206915;
+$SIOCSIFNETMASK = 0x80206916;
+$SIOCGIFMETRIC = 0xC0206917;
+$SIOCSIFMETRIC = 0x80206918;
+$SIOCSARP = 0x8024691E;
+$SIOCGARP = 0xC024691F;
+$SIOCDARP = 0x80246920;
+$PIXCONTINUE = 0x80747000;
+$PIXSTEP = 0x80747001;
+$PIXTERMINATE = 0x20007002;
+$PIGETFLAGS = 0x40747003;
+$PIXINHERIT = 0x80747004;
+$PIXDETACH = 0x20007005;
+$PIXGETSUBCODE = 0xC0747006;
+$PIXRDREGS = 0xC0747007;
+$PIXWRREGS = 0xC0747008;
+$PIXRDVREGS = 0xC0747009;
+$PIXWRVREGS = 0xC074700A;
+$PIXRDVSTATE = 0xC074700B;
+$PIXWRVSTATE = 0xC074700C;
+$PIXRDCREGS = 0xC074700D;
+$PIXWRCREGS = 0xC074700E;
+$PIRDSDRS = 0xC074700F;
+$PIXGETSIGACTION = 0xC0747010;
+$PIGETU = 0xC0747011;
+$PISETRWTID = 0xC0747012;
+$PIXGETTHCOUNT = 0xC0747013;
+$PIXRUN = 0x20007014;
diff --git a/gnu/usr.bin/perl/h2pl/eg/sysexits.pl b/gnu/usr.bin/perl/h2pl/eg/sysexits.pl
new file mode 100644
index 00000000000..f4cb777ee91
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/eg/sysexits.pl
@@ -0,0 +1,16 @@
+$EX_OK = 0x0;
+$EX__BASE = 0x40;
+$EX_USAGE = 0x40;
+$EX_DATAERR = 0x41;
+$EX_NOINPUT = 0x42;
+$EX_NOUSER = 0x43;
+$EX_NOHOST = 0x44;
+$EX_UNAVAILABLE = 0x45;
+$EX_SOFTWARE = 0x46;
+$EX_OSERR = 0x47;
+$EX_OSFILE = 0x48;
+$EX_CANTCREAT = 0x49;
+$EX_IOERR = 0x4A;
+$EX_TEMPFAIL = 0x4B;
+$EX_PROTOCOL = 0x4C;
+$EX_NOPERM = 0x4D;
diff --git a/gnu/usr.bin/perl/h2pl/getioctlsizes b/gnu/usr.bin/perl/h2pl/getioctlsizes
new file mode 100644
index 00000000000..403fffaf86c
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/getioctlsizes
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+open (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed";
+
+while (<IOCTLS>) {
+    if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\('?\w+'?,\s*\w+,\s*([^)]+)/) {
+	$need{$2}++;
+    } 
+}
+
+foreach $key ( sort keys %need ) {
+    print $key,"\n";
+} 
diff --git a/gnu/usr.bin/perl/h2pl/mksizes b/gnu/usr.bin/perl/h2pl/mksizes
new file mode 100644
index 00000000000..cb4b8ab86ea
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/mksizes
@@ -0,0 +1,42 @@
+#!/usr/local/bin/perl
+
+($iam = $0) =~ s%.*/%%;
+$tmp = "$iam.$$";
+open (CODE,">$tmp.c") || die "$iam: cannot create $tmp.c: $!\n";
+
+$mask = q/printf ("$sizeof{'%s'} = %d;\n"/; 
+
+# write C program
+select(CODE);
+
+print <<EO_C_PROGRAM;
+#include <sys/param.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <net/if_arp.h>
+#include <net/if.h>
+#include <net/route.h>
+#include <sys/ioctl.h>
+
+main() {
+EO_C_PROGRAM
+
+while ( <> ) {
+    chop;
+    printf "\t%s, \n\t\t\"%s\", sizeof(%s));\n", $mask, $_,$_;
+}
+
+print "\n}\n";
+
+close CODE;
+
+# compile C program
+
+select(STDOUT);
+
+system "cc $tmp.c -o $tmp";
+die "couldn't compile $tmp.c" if $?;
+system "./$tmp"; 	   
+die "couldn't run $tmp" if $?;
+
+unlink "$tmp.c", $tmp;
diff --git a/gnu/usr.bin/perl/h2pl/mkvars b/gnu/usr.bin/perl/h2pl/mkvars
new file mode 100644
index 00000000000..ffb0f0b0b9e
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/mkvars
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+require 'sizeof.ph';
+
+$LIB = '/usr/local/lib/perl';
+
+foreach $include (@ARGV) {
+    printf STDERR "including %s\n", $include;
+    do $include;
+    warn "sourcing $include: $@\n" if ($@);
+    if (!open (INCLUDE,"$LIB/$include")) {
+	warn "can't open $LIB/$include: $!\n"; 
+	next; 
+    } 
+    while (<INCLUDE>) {
+	chop;
+	if (/^\s*eval\s+'sub\s+(\w+)\s.*[^{]$/ || /^\s*sub\s+(\w+)\s.*[^{]$/) {
+	    $var = $1;
+	    $val = eval "&$var;";
+	    if ($@) {
+		warn "$@: $_";
+		print <<EOT;
+warn "\$$var isn't correctly set" if defined \$_main{'$var'};
+EOT
+		next;
+	    } 
+	    ( $nval = sprintf ("%x",$val ) ) =~ tr/a-z/A-Z/;
+	    printf "\$%s = 0x%s;\n", $var, $nval;
+	} 
+    }
+} 
diff --git a/gnu/usr.bin/perl/h2pl/tcbreak b/gnu/usr.bin/perl/h2pl/tcbreak
new file mode 100644
index 00000000000..2677cc982bc
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/tcbreak
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+require 'cbreak.pl';
+
+&cbreak;
+
+$| = 1;
+
+print "gimme a char: ";
+
+$c = getc;
+
+print "$c\n";
+
+printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);
+
+&cooked;
diff --git a/gnu/usr.bin/perl/h2pl/tcbreak2 b/gnu/usr.bin/perl/h2pl/tcbreak2
new file mode 100644
index 00000000000..fcbf9265161
--- /dev/null
+++ b/gnu/usr.bin/perl/h2pl/tcbreak2
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+require 'cbreak2.pl';
+
+&cbreak;
+
+$| = 1;
+
+print "gimme a char: ";
+
+$c = getc;
+
+print "$c\n";
+
+printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);
+
+&cooked;
diff --git a/gnu/usr.bin/perl/handy.h b/gnu/usr.bin/perl/handy.h
new file mode 100644
index 00000000000..aa4107eca55
--- /dev/null
+++ b/gnu/usr.bin/perl/handy.h
@@ -0,0 +1,188 @@
+/*    handy.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#if !defined(__STDC__)
+#ifdef NULL
+#undef NULL
+#endif
+#ifndef I286
+#  define NULL 0
+#else
+#  define NULL 0L
+#endif
+#endif
+
+#define Null(type) ((type)NULL)
+#define Nullch Null(char*)
+#define Nullfp Null(FILE*)
+#define Nullsv Null(SV*)
+
+/* bool is built-in for g++-2.6.3, which might be used for an extension.
+   If the extension includes <_G_config.h> before this file then
+   _G_HAVE_BOOL will be properly set.  If, however, the extension includes
+   this file first, then you will have to manually set -DHAS_BOOL in 
+   your command line to avoid a conflict.
+*/
+#ifdef _G_HAVE_BOOL
+# if _G_HAVE_BOOL
+#  ifndef HAS_BOOL
+#   define HAS_BOOL 1
+#  endif
+# endif
+#endif
+
+#ifndef HAS_BOOL
+# ifdef UTS
+#  define bool int
+# else
+#  define bool char
+# endif
+#endif
+
+#ifdef TRUE
+#undef TRUE
+#endif
+#ifdef FALSE
+#undef FALSE
+#endif
+#define TRUE (1)
+#define FALSE (0)
+
+typedef char		I8;
+typedef unsigned char	U8;
+
+typedef short		I16;
+typedef unsigned short	U16;
+
+#if BYTEORDER > 0x4321
+  typedef int		I32;
+  typedef unsigned int	U32;
+#else
+  typedef long		I32;
+  typedef unsigned long	U32;
+#endif
+
+#define Ctl(ch) (ch & 037)
+
+#define strNE(s1,s2) (strcmp(s1,s2))
+#define strEQ(s1,s2) (!strcmp(s1,s2))
+#define strLT(s1,s2) (strcmp(s1,s2) < 0)
+#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
+#define strGT(s1,s2) (strcmp(s1,s2) > 0)
+#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
+#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
+#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
+
+#ifdef HAS_SETLOCALE  /* XXX Is there a better test for this? */
+#  ifndef CTYPE256
+#    define CTYPE256
+#  endif
+#endif
+
+#ifdef USE_NEXT_CTYPE 
+#define isALNUM(c)   (NXIsAlpha((unsigned int)c) || NXIsDigit((unsigned int)c) || c == '_')
+#define isIDFIRST(c) (NXIsAlpha((unsigned int)c) || c == '_')
+#define isALPHA(c)   NXIsAlpha((unsigned int)c)
+#define isSPACE(c)   NXIsSpace((unsigned int)c)
+#define isDIGIT(c)   NXIsDigit((unsigned int)c)
+#define isUPPER(c)   NXIsUpper((unsigned int)c)
+#define isLOWER(c)   NXIsLower((unsigned int)c)
+#define toUPPER(c)   NXToUpper((unsigned int)c)
+#define toLOWER(c)   NXToLower((unsigned int)c)
+#else /* USE_NEXT_CTYPE */
+#if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
+#define isALNUM(c)   (isalpha((unsigned char)(c)) || isdigit((unsigned char)(c)) || c == '_')
+#define isIDFIRST(c) (isalpha((unsigned char)(c)) || (c) == '_')
+#define isALPHA(c)   isalpha((unsigned char)(c))
+#define isSPACE(c)   isspace((unsigned char)(c))
+#define isDIGIT(c)   isdigit((unsigned char)(c))
+#define isUPPER(c)   isupper((unsigned char)(c))
+#define isLOWER(c)   islower((unsigned char)(c))
+#define toUPPER(c)   toupper((unsigned char)(c))
+#define toLOWER(c)   tolower((unsigned char)(c))
+#else
+#define isALNUM(c)   (isascii(c) && (isalpha(c) || isdigit(c) || c == '_'))
+#define isIDFIRST(c) (isascii(c) && (isalpha(c) || (c) == '_'))
+#define isALPHA(c)   (isascii(c) && isalpha(c))
+#define isSPACE(c)   (isascii(c) && isspace(c))
+#define isDIGIT(c)   (isascii(c) && isdigit(c))
+#define isUPPER(c)   (isascii(c) && isupper(c))
+#define isLOWER(c)   (isascii(c) && islower(c))
+#define toUPPER(c)   toupper(c)
+#define toLOWER(c)   tolower(c)
+#endif
+#endif /* USE_NEXT_CTYPE */
+
+/* Line numbers are unsigned, 16 bits. */
+typedef U16 line_t;
+#ifdef lint
+#define NOLINE ((line_t)0)
+#else
+#define NOLINE ((line_t) 65535)
+#endif
+
+#ifndef lint
+#ifndef LEAKTEST
+#ifndef safemalloc
+char *safemalloc _((MEM_SIZE));
+char *saferealloc _((char *, MEM_SIZE));
+void safefree _((char *));
+#endif
+#ifndef MSDOS
+#define New(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#else
+#define New(x,v,n,t)  (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#endif /* MSDOS */
+#define Safefree(d) safefree((char*)d)
+#define NEWSV(x,len) newSV(len)
+#else /* LEAKTEST */
+char *safexmalloc();
+char *safexrealloc();
+void safexfree();
+#define New(x,v,n,t)  (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Safefree(d) safexfree((char*)d)
+#define NEWSV(x,len) newSV(x,len)
+#define MAXXCOUNT 1200
+long xcount[MAXXCOUNT];
+long lastxcount[MAXXCOUNT];
+#endif /* LEAKTEST */
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+#else /* lint */
+#define New(x,v,n,s) (v = Null(s *))
+#define Newc(x,v,n,s,c) (v = Null(s *))
+#define Newz(x,v,n,s) (v = Null(s *))
+#define Renew(v,n,s) (v = Null(s *))
+#define Move(s,d,n,t)
+#define Copy(s,d,n,t)
+#define Zero(d,n,t)
+#define Safefree(d) d = d
+#endif /* lint */
+
+#ifdef USE_STRUCT_COPY
+#define StructCopy(s,d,t) *((t*)(d)) = *((t*)(s))
+#else
+#define StructCopy(s,d,t) Copy(s,d,1,t)
+#endif
diff --git a/gnu/usr.bin/perl/hints/3b1.sh b/gnu/usr.bin/perl/hints/3b1.sh
new file mode 100644
index 00000000000..2ed65c591bc
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/3b1.sh
@@ -0,0 +1,15 @@
+d_voidsig='undef'
+d_tosignal='int'
+gidtype='int'
+groupstype='int'
+uidtype='int'
+# Note that 'Configure' is run from 'UU', hence the strange 'ln'
+# command.
+for i in .. ../x2p
+do
+      rm -f $i/3b1cc
+      ln ../hints/3b1cc $i
+done
+echo "\nIf you want to use the 3b1 shared libraries, complete this script then"
+echo "read the header in 3b1cc.           [Type carriage return to continue]\c"
+read vch
diff --git a/gnu/usr.bin/perl/hints/3b1cc b/gnu/usr.bin/perl/hints/3b1cc
new file mode 100644
index 00000000000..0001e046b8c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/3b1cc
@@ -0,0 +1,88 @@
+# To incorporate the 7300/3b1 shared library, run this script in place
+# of 'CC'.
+# You can skip this is you have the shcc program installed as cc in
+# your path.
+# First: Run 'Configure' through to the end and run 'make depend'.
+# Second: Edit 'makefile' ( not Makefile ) and set CC = 3b1cc.
+# Third: Edit 'x2p/makefile' and set CC = 3b1cc.
+#
+# Do not use '3b1cc' as the default compiler.  The call to the default
+# compiler is used by 'perl' and will not be available when running
+# 'perl'.
+#
+# Note: This script omits libraries which are redundant in the shared
+# library.  It is an excerpt from a grander version available upon
+# request from "zebra!vern" or "vern@zebra.alphacdc.com".
+
+CC="cc"
+LIBS=
+INCL=
+
+LD="ld"
+SHAREDLIB="/lib/crt0s.o /lib/shlib.ifile"
+
+# Local variables
+COBJS=
+LOBJS=
+TARG=
+FLAGS=
+CMD=
+
+# These are libraries which are incorporated in the shared library
+OMIT="-lmalloc"
+
+# These routines are in libc.a but not in the shared library
+if [ ! -f vsprintf.o -o ! -f doprnt.o ]
+then
+	echo "Extracting vsprintf.o from libc.a"
+	ar -x /lib/libc.a vsprintf.o doprnt.o
+fi
+
+CMD="$CC"
+while [ $# -gt 0 ]
+do
+	case $1 in
+	-c)	CFLAG=$1;;
+	-o)	CFLAG=$1
+		shift
+		TARG="$1";;
+	-l*)	match=false
+		for i in $OMIT
+		do
+			[ "$i" = "$1" ] && match=true
+		done
+		[ "$match" != false ] || LIBS="$LIBS $1";;
+	-*)	FLAGS="$FLAGS $1";;
+	*.c)	COBJS="$COBJS $1";;
+	*.o)	LOBJS="$LOBJS $1";;
+	*)	TARG="$1";;
+	esac
+	shift
+done
+
+if [ -n "$COBJS" ]
+then
+	CMD="$CMD $FLAGS $INCL $LPATHS $LIBS $COBJS $CFLAG $TARG"
+elif [ -n "$LOBJS" ]
+then
+	LOBJS="$LOBJS vsprintf.o doprnt.o"
+	CMD="$LD -r $LOBJS $LPATHS $LIBS -o temp.o"
+	echo "\t$CMD"
+	$CMD
+	CMD="$LD -s temp.o $SHAREDLIB -o $TARG"
+	echo "\t$CMD"
+	$CMD
+	ccrslt=$?
+	if [ $ccrslt -ne 0 ]
+	then
+		exit $ccrslt
+	fi
+	CMD="rm -f temp.o"
+else
+	exit 1
+fi
+echo "\t$CMD"
+$CMD
+ccrslt=$?
+rm -f $$.c	
+exit $ccrslt
diff --git a/gnu/usr.bin/perl/hints/README.hints b/gnu/usr.bin/perl/hints/README.hints
new file mode 100644
index 00000000000..6c67585561b
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/README.hints
@@ -0,0 +1,61 @@
+These files are used by Configure to set things which Configure either
+can't or doesn't guess properly.  Many of these hints files are from
+perl4.  They may or may not work with perl5, but they are probably a
+good starting point.
+
+The following hints files have been tested with at least some version
+of perl5 and are probably reasonably close to being correct:
+
+aix.sh
+aux.sh
+bsdos.sh
+dec_osf.sh
+dgux.sh
+esix4.sh
+freebsd.sh
+hpux_9.sh
+irix_4.sh
+irix_5.sh
+irix_6.sh
+irix_6_2.sh
+isc.sh
+linux.sh
+machten_2.sh
+machten.sh
+ncr_tower.sh
+netbsd.sh
+next_3_2.sh
+sco_3.sh
+solaris_2.sh
+sunos_4_1.sh
+svr4.sh
+titanos.sh
+ultrix_4.sh
+unicos.sh
+utekv.sh
+
+The following hints files have not been tested with perl5:
+
+3b1.sh
+altos486.sh
+apollo.sh
+dnix.sh
+dynix.sh
+fps.sh
+genix.sh
+greenhills.sh
+i386.sh
+isc_2.sh
+mips.sh
+mpc.sh
+opus.sh
+sco_2_3_0.sh
+sco_2_3_1.sh
+sco_2_3_2.sh
+sco_2_3_3.sh
+sco_2_3_4.sh
+stellar.sh
+sunos_4_0.sh
+ti1500.sh
+unisysdynix.sh
+uts.sh
diff --git a/gnu/usr.bin/perl/hints/aix.sh b/gnu/usr.bin/perl/hints/aix.sh
new file mode 100644
index 00000000000..a9f277eed19
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/aix.sh
@@ -0,0 +1,67 @@
+# hints/aix.sh
+# AIX 3.x.x hints thanks to Wayne Scott <wscott@ichips.intel.com>
+# AIX 4.1 hints thanks to Christopher Chan-Nui <channui@austin.ibm.com>.
+# Merged on Mon Feb  6 10:22:35 EST 1995 by
+#   Andy Dougherty  <doughera@lafcol.lafayette.edu>
+
+
+# Configure finds setrgid and setruid, but they're useless.  The man
+# pages state:
+#    setrgid: The EPERM error code is always returned.
+#    setruid: The EPERM error code is always returned. Processes cannot
+#             reset only their real user IDs.
+d_setrgid='undef'
+d_setruid='undef'
+
+alignbytes=8
+
+usemymalloc='n'
+
+# Make setsockopt work correctly.  See man page.
+# ccflags='-D_BSD=44'
+
+# uname -m output is too specific and not appropriate here
+case "$archname" in
+'') archname="$osname" ;;
+esac
+
+case "$osvers" in
+3*) d_fchmod=undef
+    ccflags='-D_ALL_SOURCE'
+    ;;
+*)  # These hints at least work for 4.x, possibly other systems too.
+    d_setregid='undef'
+    d_setreuid='undef'
+    ccflags='-qmaxmem=8192 -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE'
+    nm_opt='-B'
+    ;;
+esac
+
+# The optimizer in 4.1.1 apparently generates bad code for scope.c.
+# Configure doesn't offer an easy way to propagate extra variables
+# only for certain cases, so the following contortion is required:
+# This is probably not needed in 5.002 and later.
+# scope_cflags='case "$osvers" in 4.1*) optimize=" ";; esac'
+
+# Changes for dynamic linking by Wayne Scott <wscott@ichips.intel.com>
+#
+# Tell perl which symbols to export for dynamic linking.
+case "$cc" in
+*gcc*) ccdlflags='-Xlinker -bE:perl.exp' ;;
+*) ccdlflags='-bE:perl.exp' ;;
+esac
+
+# The first 3 options would not be needed if dynamic libs. could be linked
+# with the compiler instead of ld.
+# -bI:$(PERL_INC)/perl.exp  Read the exported symbols from the perl binary
+# -bE:$(BASEEXT).exp        Export these symbols.  This file contains only one
+#                           symbol: boot_$(EXP)  can it be auto-generated?
+case "$osvers" in
+3*) 
+lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
+    ;;
+*) 
+lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
+
+;;
+esac
diff --git a/gnu/usr.bin/perl/hints/altos486.sh b/gnu/usr.bin/perl/hints/altos486.sh
new file mode 100644
index 00000000000..b85f907e347
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/altos486.sh
@@ -0,0 +1,3 @@
+: have heard of problems with -lc_s on Altos 486
+set `echo " $libswanted " | sed "s/ c_s / /"`
+libswanted="$*"
diff --git a/gnu/usr.bin/perl/hints/apollo.sh b/gnu/usr.bin/perl/hints/apollo.sh
new file mode 100644
index 00000000000..26180396341
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/apollo.sh
@@ -0,0 +1,51 @@
+# Info from Johann Klasek <jk@auto.tuwien.ac.at>
+# Merged by Andy Dougherty  <doughera@lafcol.lafayette.edu>
+# Last revised	Fri Jun  2 11:21:27 EDT 1995
+
+# uname -a looks like
+# DomainOS newton 10.4.1 bsd4.3 425t
+
+# We want to use both BSD includes and some of the features from the
+# /sys5 includes.
+ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include"
+
+# These adjustments are necessary (why?) to compile malloc.c.
+freetype='void'
+i_malloc='undef'
+malloctype='void *'
+
+# This info is left over from perl4.  
+cat <<'EOF'
+Some tests may fail unless you use 'chacl -B'.  Also, op/stat
+test 2 may fail occasionally because Apollo doesn't guarantee
+that mtime will be equal to ctime on a newly created unmodified
+file.  Finally, the sleep test will sometimes fail.  See the
+sleep(3) man page to learn why.
+
+See hints/apollo.sh for hints on running h2ph.
+
+And a note on ccflags:
+
+    Lastly, while -A cpu,mathchip generates optimal code for your DN3500
+    running sr10.3, be aware that you should be using -A cpu,mathlib_sr10
+    if your perl must also run on any machines running sr10.0, sr10.1, or
+    sr10.2.  The -A cpu,mathchip option generates code that doesn't work on
+    pre-sr10.3 nodes.  See the cc(1) man page for more details.
+						-- Steve Vinoski
+
+EOF
+
+# Running h2ph, on the other hand, presents a challenge. 
+
+#The perl header files have to be generated with following commands
+
+#sed 's|/usr/include|/sys5/usr/include|g' h2ph >h2ph.new && chmod +x h2ph.new
+#(set cdir=`pwd`; cd /sys5/usr/include; $cdir/h2ph.new sys/* )
+#(set cdir=`pwd`; cd /usr/include; $cdir/h2ph * sys/* machine/*)
+
+#The SYS5 headers (only sys) are overlayed by the BSD headers.  It  seems
+#all ok, but once I am going into details,  a  lot  of  limitations  from
+#'h2ph' are coming up. Lines like "#define NODEV (dev_t)(-1)"  result  in
+#syntax errors as converted by h2ph. 
+
+# Generally, h2ph might need a lot of help.
diff --git a/gnu/usr.bin/perl/hints/aux.sh b/gnu/usr.bin/perl/hints/aux.sh
new file mode 100644
index 00000000000..add0f4dec8f
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/aux.sh
@@ -0,0 +1,20 @@
+# hints/aux.sh
+#
+# Improved by Jake Hamby <jehamby@lightside.com> to support both Apple CC
+# and GNU CC.  Tested on A/UX 3.1.1 with GCC 2.6.3.
+# Last modified 
+# Fri May  5 10:59:43 EDT 1995
+
+case "$cc" in
+gcc)	optimize='-O2'
+	ccflags="$ccflags -D_POSIX_SOURCE"
+	echo "Setting hints for GNU CC."
+	;;
+*)	optimize='-O'
+	ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES -D_POSIX_SOURCE"
+	POSIX_cflags='ccflags="$ccflags -ZP -Du_long=U32"'
+	echo "Setting hints for Apple's CC.  If you plan to use"
+	echo "GNU CC, please rerun this Configure script as:"
+	echo "./Configure -Dcc=gcc"
+	;;
+esac
diff --git a/gnu/usr.bin/perl/hints/bsdos.sh b/gnu/usr.bin/perl/hints/bsdos.sh
new file mode 100644
index 00000000000..aedf4b69676
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/bsdos.sh
@@ -0,0 +1,99 @@
+# hints/bsdos.sh
+#
+# hints file for BSD/OS 2.x (adapted from bsd386.sh)
+# Original by Neil Bowers <neilb@khoros.unm.edu>
+#     Tue Oct  4 12:01:34 EDT 1994
+# Updated by Tony Sanders <sanders@bsdi.com>
+#     Mon Nov 27 17:25:51 CST 1995
+#
+# You can override the compiler and loader on the Configure command line:
+#     ./Configure -Dcc=shlicc2 -Dld=shlicc2
+
+# filename extension for shared library objects
+so='o'
+
+# Don't use this for Perl 5.002, which needs parallel sig_name and sig_num lists
+#sig_name='ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2 '
+signal_t='void'
+d_voidsig='define'
+d_dosuid='define'
+
+# we don't want to use -lnm, since exp() is busted (in 1.1 anyway)
+set `echo X "$libswanted "| sed -e 's/ nm / /'`
+shift
+libswanted="$*"
+
+# BSD/OS X libraries are in their own tree
+glibpth="$glibpth /usr/X11/lib"
+ldflags="$ldflags -L/usr/X11/lib"
+
+# Avoid telldir prototype conflict in pp_sys.c
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+case "$bsdos_distribution" in
+defined)
+	d_portable='no'
+	prefix='/usr/contrib'
+	man3dir='/usr/contrib/man/man3'
+	;;
+esac
+
+case "$osvers" in
+1.0*)
+	# Avoid problems with HUGE_VAL in POSIX in 1.0's cc.
+	POSIX_cflags='ccflags="$ccflags -UHUGE_VAL"' 
+	;;
+1.1*)
+	# Use gcc2
+	case "$cc" in
+	'')	cc='gcc2' ;;
+	esac
+	;;
+2.0*)
+	# default to GCC 2.X w/shared libraries
+	case "$cc" in
+	'')	cc='shlicc2' ;;
+	esac
+
+	# default ld to shared library linker
+	case "$ld" in
+	'')	ld='shlicc2' ;;
+	esac
+
+	# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS stuff
+	# in 4.4BSD-based systems (including BSD/OS 2.0 and later).
+	# See http://www.bsdi.com/bsdi-man?setuid(2)
+	d_setregid='undef'
+	d_setreuid='undef'
+	d_setrgid='undef'
+	d_setruid='undef'
+	;;
+2.1*)
+	# Use 2.1's shlicc2 for dynamic linking
+	# Since cc -o is linking, use it for compiling too.
+	# I'm not sure whether Configure is careful about
+	# distinguishing between the two.
+
+	case "$cc" in
+	'')	cc='shlicc2'
+		cccdlflags=' ' ;; # Avoid the dreaded -fpic
+	esac
+
+	# Link with shared libraries in 2.1
+	# Turns out that shlicc2 will automatically use the
+	# shared libs, so don't explicitly specify -lc_s.2.1.*
+	case "$ld" in
+	'')	ld='shlicc2'
+		lddlflags='-r' ;; # this one is necessary
+	esac
+
+	# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS  stuff
+	# in 4.4BSD-based systems (including BSD/OS 2.0 and later).
+	# See http://www.bsdi.com/bsdi-man?setuid(2)
+	# This stuff may or may not be right, but it works.
+	d_setregid='undef'
+	d_setreuid='undef'
+	d_setrgid='undef'
+	d_setruid='undef'
+	;;
+esac
diff --git a/gnu/usr.bin/perl/hints/convexos.sh b/gnu/usr.bin/perl/hints/convexos.sh
new file mode 100644
index 00000000000..f0ce4097563
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/convexos.sh
@@ -0,0 +1,20 @@
+# convexos.sh
+# Thanks to David Starks-Browning <dstarks@rc.tudelft.nl>
+# Date: Tue, 17 Jan 1995 10:45:03 -0500 (EST)
+# Subject: Re: Hints for ConvexOS 10.2
+# 
+# uname -a output looks like
+#   ConvexOS  xxxx C38xx  10.2 convex
+# Configure may incorrectly assign $3 to $osvers.
+#
+set X $myuname
+shift
+osvers=$4
+# ConvexOS 10.2 uses POSIX process group semantics for getpgrp but
+# BSD semantics for setpgrp.  Perl assumes you don't have such
+# a mixed system, so we undef d_getpgrp.
+#   Andy Dougherty		doughera@lafcol.lafayette.edu
+#
+case "$osvers" in
+10.2)	d_getpgrp='undef' ;;
+esac
diff --git a/gnu/usr.bin/perl/hints/cxux.sh b/gnu/usr.bin/perl/hints/cxux.sh
new file mode 100644
index 00000000000..66608decef0
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/cxux.sh
@@ -0,0 +1,101 @@
+# Hints for the CX/UX 7.1 operating system running on Harris NightHawk
+# machines.  written by Tom.Horsley@mail.hcsc.com
+#
+# This config is setup for dynamic linking and the Harris C compiler.
+
+# Check some things and print warnings if this isn't going to work...
+#
+case ${SDE_TARGET:-ELF} in
+   [Cc][Oo][Ff][Ff]|[Oo][Cc][Ss]) echo ''
+      echo ''
+      echo WARNING: Do not build perl 5 with the SDE_TARGET set to
+      echo generate coff object - perl 5 must be built in the ELF
+      echo environment.
+      echo ''
+      echo '';;
+   [Ee][Ll][Ff]) : ;;
+   *) echo ''
+      echo 'Unknown SDE_TARGET value: '$SDE_TARGET
+      echo '';;
+esac
+
+case `uname -r` in
+   [789]*) : ;;
+   *) echo ''
+      echo ''
+      echo WARNING: Perl 5 requires shared library support, it cannot
+      echo be built on releases of CX/UX prior to 7.0 with this hints
+      echo file. You\'ll have to do a separate port for the statically
+      echo linked COFF environment.
+      echo ''
+      echo '';;
+esac
+
+# Internally at Harris, we use a source management tool which winds up
+# giving us read-only copies of source trees that are mostly symbolic links.
+# That upsets the perl build process when it tries to edit opcode.h and
+# embed.h or touch perly.c or perly.h, so turn those files into "real" files
+# when Configure runs. (If you already have "real" source files, this won't
+# do anything).
+#
+if [ -x /usr/local/mkreal ]
+then
+   for i in '.' '..'
+   do
+      for j in embed.h opcode.h perly.h perly.c
+      do
+         if [ -h $i/$j ]
+         then
+            ( cd $i ; /usr/local/mkreal $j ; chmod 666 $j )
+         fi
+      done
+   done
+fi
+
+# We DO NOT want -lmalloc
+#
+libswanted=`echo ' '$libswanted' ' | sed -e 's/ malloc / /'`
+
+# Stick the low-level elf library path in first.
+#
+glibpth="/usr/sde/elf/usr/lib $glibpth"
+
+# Need to use Harris cc for most of these options to be meaningful (if you
+# want to get this to work with gcc, you're on your own :-). Passing
+# -Bexport to the linker when linking perl is important because it leaves
+# the interpreter internal symbols visible to the shared libs that will be
+# loaded on demand (and will try to reference those symbols). The -u
+# option to drag 'sigaction' into the perl main program is to make sure
+# it gets defined for the posix shared library (for some reason sigaction
+# is static, rather than being defined in libc.so.1).
+#
+cc='/bin/cc -Xa'
+cccdlflags='-Zelf -Zpic'
+ccdlflags='-Zelf -Zlink=dynamic -Wl,-Bexport -u sigaction'
+lddlflags='-Zlink=so'
+
+# Configure imagines that it sees a pw_quota field, but it is really in a
+# different structure than the one it thinks it is looking at.
+d_pwquota='undef'
+
+# Configure sometimes finds what it believes to be ndbm header files on the
+# system and imagines that we have the NDBM library, but we really don't.
+# There is something there that once resembled ndbm, but it is purely
+# for internal use in some tool and has been hacked beyond recognition
+# (or even function :-)
+#
+i_ndbm='undef'
+
+# Don't use the perl malloc
+#
+d_mymalloc='undef'
+usemymalloc='n'
+
+cat <<'EOM'
+
+You will get a failure on lib/posix.t test 16 because ungetc() on
+stdin does not work if no characters have been read from stdin.
+If you type a character at the terminal where you are running
+the tests, you can fool it into thinking it worked.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/dec_osf.sh b/gnu/usr.bin/perl/hints/dec_osf.sh
new file mode 100644
index 00000000000..bfd235faaf9
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/dec_osf.sh
@@ -0,0 +1,11 @@
+# hints/dec_osf.sh
+case "$optimize" in
+'')
+    case "$cc" in 
+    *gcc*) ;;
+    *)	optimize='-O2 -Olimit 2900' ;;
+    esac
+    ;;
+esac
+ccflags="$ccflags -DSTANDARD_C"
+lddlflags='-shared -expect_unresolved "*" -s -hidden'
diff --git a/gnu/usr.bin/perl/hints/dgux.sh b/gnu/usr.bin/perl/hints/dgux.sh
new file mode 100644
index 00000000000..bc54c945bd1
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/dgux.sh
@@ -0,0 +1,123 @@
+# $Id: dgux.sh,v 1.4 1996/01/18 03:40:38 roderick Exp $
+
+# This is a hints file for DGUX, which is Data General's Unix.  It was
+# developed using version 5.4.3.10 of the OS.  I think the gross
+# features should work with versions 5.4.2 through 5.4.4.11 with perhaps
+# minor tweaking, but I don't have any older or newer versions installed
+# at the moment with which to test it.
+#
+# DGUX is a SVR4 derivative.  It ships with gcc as the standard
+# compiler.  Since version 5.4.3.0 it has shipped with Perl 4.036
+# installed in /usr/bin, which is kind of neat.  Be careful when you
+# install that you don't overwrite the system version, though (by
+# answering yes to the question about installing perl as /usr/bin/perl),
+# as it would suck to try to get support if the vendor learned that you
+# were physically replacing the system binaries.
+#
+# Be aware that if you opt to use dynamic loading you'll need to set
+# your $LD_LIBRARY_PATH to include the source directory when you build,
+# test and install the software.
+#
+# -Roderick Schertler <roderick@gate.net>
+
+
+# Here are the things from some old DGUX hints files which are different
+# from what's in here now.  I don't know the exact reasons that most of
+# these settings were in the hints files, presumably they can be chalked
+# up to old Configure inadequacies and changes in the OS headers and the
+# like.  These settings might make a good place to start looking if you
+# have problems.
+#
+# This was specified the the 4.036 hints file.  That hints file didn't
+# say what version of the OS it was developed using.
+#
+#     cppstdin='/lib/cpp'
+#
+# The 4.036 and 5.001 hints files both contained these.  The 5.001 hints
+# file said it was developed with version 5.4.2.01 of DGUX.
+#
+#     gidtype='gid_t'
+#     groupstype='gid_t'
+#     uidtype='uid_t'
+#     d_index='define'
+#     cc='gcc'
+#
+# These were peculiar to the 5.001 hints file.
+#
+#     ccflags='-D_POSIX_SOURCE -D_DGUX_SOURCE'
+#
+#     # an ugly hack, since the Configure test for "gcc -P -" hangs.
+#     # can't just use 'cppstdin', since our DG has a broken cppstdin :-(
+#     cppstdin=`cd ..; pwd`/cppstdin
+#     cpprun=`cd ..; pwd`/cppstdin
+#
+# One last note:  The 5.001 hints file said "you don't want to use
+# /usr/ucb/cc" in the place at which it set cc to gcc.  That in
+# particular baffles me, as I used to have 5.4.2.01 loaded and my memory
+# is telling me that even then /usr/ucb was a symlink to /usr/bin.
+
+
+# The standard system compiler is gcc, but invoking it as cc changes its
+# behavior.  I have to pick one name or the other so I can get the
+# dynamic loading switches right (they vary depending on this).  I'm
+# picking gcc because there's no way to get at the optimization options
+# and so on when you call it cc.
+case $cc in
+    '')
+	cc=gcc
+	case $optimize in
+	    '') optimize=-O2;;
+	esac
+	;;
+esac
+
+usevfork=true
+
+# DG has this thing set up with symlinks which point to different places
+# depending on environment variables (see elink(5)) and the compiler and
+# related tools use them to access different development environments
+# (COFF, ELF, m88k BCS and so on), see sde(5).  The upshot, however, is
+# that when a normal program tries to access one of these elinks it sees
+# no such file (like stat()ting a mis-directed symlink).  Setting
+# $plibpth to explicitly include the place to which the elinks point
+# allows Configure to find libraries which vary based on the development
+# environment.
+plibpth="$plibpth \
+    ${SDE_PATH:-/usr}/sde/${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib"
+
+# Many functions (eg, gethostent(), killpg(), getpriority(), setruid()
+# dbm_*(), and plenty more) are defined in -ldgc.  Usually you don't
+# need to know this (it seems that libdgc.so is searched automatically
+# by ld), but Configure needs to check it otherwise it will report all
+# those functions as missing.
+libswanted="dgc $libswanted"
+
+# Dynamic loading works using the dlopen() functions.  Note that dlfcn.h
+# is broken, it declares _dl*() rather than dl*().  (This is in my
+# I'd-open-a-ticket-about-this-if-it-weren't-going-to-be-such-a-hassle
+# file.)  You can ignore the warnings caused by the missing
+# declarations, they're harmless.
+usedl=true
+# For cc rather than gcc the flags would be `-K PIC' for compiling and
+# -G for loading.  I haven't tested this.
+cccdlflags=-fpic
+lddlflags=-shared
+# The Perl library has to be built as a shared library so that dynamic
+# loading will work (otherwise code loaded with dlopen() won't be able
+# to reference symbols in the main part of perl).  Note that since
+# Configure doesn't normally prompt about $d_shrplib this will cause a
+# `Whoa there!'.  This is normal, just keep the recommended value.  A
+# consequence of all this is that you've got to include the source
+# directory in your LD_LIBRARY_PATH when you're building and testing
+# perl.
+d_shrplib=define
+
+# The system has a function called dg_flock() which is an flock()
+# emulation built using fcntl() locking.  Perl currently comes with an
+# flock() emulation which uses lockf(), it should eventually also
+# include an fcntl() emulation of its own.  Until that happens I
+# recommend using DG's emulation (and ignoring the `WHOA THERE!' this
+# causes), it provides semantics closer to the original than the lockf()
+# emulation.
+ccflags="$ccflags -Dflock=dg_flock"
+d_flock=define
diff --git a/gnu/usr.bin/perl/hints/dnix.sh b/gnu/usr.bin/perl/hints/dnix.sh
new file mode 100644
index 00000000000..5b67dab8f2d
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/dnix.sh
@@ -0,0 +1 @@
+optimize='-g'
diff --git a/gnu/usr.bin/perl/hints/dynix.sh b/gnu/usr.bin/perl/hints/dynix.sh
new file mode 100644
index 00000000000..4bdb804f530
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/dynix.sh
@@ -0,0 +1,7 @@
+# If this doesn't work, try specifying 'none' for hints.
+d_castneg=undef
+libswanted=`echo $libswanted | sed -e 's/socket /socket seq /'`
+
+# Reported by Craig Milo Rogers <Rogers@ISI.EDU>
+# Date: Tue, 30 Jan 96 15:29:26 PST
+d_casti32=undef
diff --git a/gnu/usr.bin/perl/hints/dynixptx.sh b/gnu/usr.bin/perl/hints/dynixptx.sh
new file mode 100644
index 00000000000..d44f6b82cde
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/dynixptx.sh
@@ -0,0 +1,39 @@
+# Sequent Dynix/Ptx v. 4 hints
+# Created 1996/03/15 by Brad Howerter, bhower@wgc.woodward.com
+# Use Configure -Dcc=gcc to use gcc.
+
+# cc wants -G for dynamic loading
+lddlflags='-G'
+
+# Remove inet to avoid this error in Configure, which causes Configure
+# to be unable to figure out return types:
+# dynamic linker: ./ssize: can't find libinet.so,
+# link with -lsocket instead of -l inet
+
+libswanted=`echo $libswanted | sed -e 's/ inet / /'`
+
+# Configure defaults to usenm='y', which doesn't work very well
+usenm='n'
+
+# The Perl library has to be built as a shared library so that dynamic
+# loading will work (otherwise code loaded with dlopen() won't be able
+# to reference symbols in the main part of perl).  Note that since
+# Configure doesn't normally prompt about $d_shrplib this will cause a
+# `Whoa there!'.  This is normal, just keep the recommended value.  A
+# consequence of all this is that you've got to include the source
+# directory in your LD_LIBRARY_PATH when you're building and testing
+# perl.
+d_shrplib=define
+
+cat <<'EOM' >&4
+
+If you get a 'Whoa there!' with regard to d_shrplib, you can ignore
+it, and just keep the recommended value.
+
+If you wish to use dynamic linking, you must use
+   LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH
+or
+   setenv LD_LIBRARY_PATH `pwd`
+before running make.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/epix.sh b/gnu/usr.bin/perl/hints/epix.sh
new file mode 100644
index 00000000000..25e357328f1
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/epix.sh
@@ -0,0 +1,75 @@
+# epix.sh
+# Hint file for EP/IX on CDC RISC boxes.
+#
+# From: Stanley Donald Capelik <sd9sdc@hp100.den.mmc.com>
+# Modified by Andy Dougherty   <doughera@lafcol.lafayette.edu>
+# Last modified:  Mon May  8 15:29:18 EDT 1995
+#
+#  This hint file appears to be based on the svr4 hints for perl5.000,
+#  with some CDC-specific additions.  I've tried to updated it to
+#  match the 5.001 svr4 hints, which allow for dynamic loading,
+#  but I have no way of testing the resulting file.
+#
+#  There were also some contradictions that I've tried to straighten
+#  out, but I'm not sure I got them all right.
+#
+# Edit config.sh to change shmattype from 'char *' to 'void *'"
+
+# Use Configure -Dcc=gcc to use gcc.
+case "$cc" in
+'') cc='/bin/cc3.11'
+    test -f $cc || cc='/usr/ccs/bin/cc'
+    ;;
+esac
+
+usrinc='/svr4/usr/include'
+
+# Various things that Configure apparently doesn't get right.
+strings='/svr4/usr/include/string.h'
+timeincl='/svr4/usr/include/sys/time.h '
+libc='/svr4/usr/lib/libc.a'
+libpth='/svr4/usr/lib /svr4/usr/lib/cmplrs/cc /usr/ccs/lib /svr4/lib /svr4/usr/ucblib'
+osname='epix2'
+archname='epix2'
+d_suidsafe='define'	# "./Configure -d" can't figure this out easilly
+d_flock='undef'
+
+# Old version had this, but I'm not sure why since the old version
+# also mucked around with libswanted.  This is also definitely wrong
+# if the user is trying to use DB_File or GDBM_File.
+# libs='-lsocket -lnsl -ldbm -ldl -lc -lcrypt -lm -lucb'
+
+# We include support for using libraries in /usr/ucblib, but the setting
+# of libswanted excludes some libraries found there.  You may want to
+# prevent "ucb" from being removed from libswanted and see if perl will
+# build on your system.
+ldflags='-non_shared -systype svr4 -L/svr4/usr/lib -L/svr4/usr/lib/cmplrs/cc -L/usr/ccs/lib -L/svr4/usr/ucblib'
+ccflags='-systype svr4 -D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude'
+cppflags='-D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude'
+
+# Don't use problematic libraries:
+
+libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'`
+# libmalloc.a - Probably using Perl's malloc() anyway.
+# libucb.a - Remove it if you have problems ld'ing.  We include it because
+#   it is needed for ODBM_File and NDBM_File extensions.
+if [ -r /usr/ucblib/libucb.a ]; then	# If using BSD-compat. library:
+    # Use the "native" counterparts, not the BSD emulation stuff:
+    d_bcmp='undef'; d_bcopy='undef'; d_bzero='undef'; d_safebcpy='undef'
+    d_index='undef'; d_killpg='undef'; d_getprior='undef'; d_setprior='undef'
+    d_setlinebuf='undef'; d_setregid='undef'; d_setreuid='undef'
+fi
+
+lddlflags="-G $ldflags"	# Probably needed for dynamic loading
+# We _do_ want the -L paths in ldflags, but we don't want the -non_shared.
+lddlflags=`echo $lddlflags | sed 's/-non_shared//'`
+
+cat <<'EOM' >&4
+
+If you wish to use dynamic linking, you must use 
+	LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH
+or
+	setenv LD_LIBRARY_PATH `pwd`
+before running make.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/esix4.sh b/gnu/usr.bin/perl/hints/esix4.sh
new file mode 100644
index 00000000000..c8dec8a8b8e
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/esix4.sh
@@ -0,0 +1,41 @@
+# hints/esix4.sh
+# Original esix4 hint file courtesy of
+# Kevin O'Gorman ( kevin@kosman.UUCP, kevin%kosman.uucp@nrc.com )
+#
+# Use Configure -Dcc=gcc to use gcc.
+case "$cc" in
+'') cc='/bin/cc'
+    test -f $cc || cc='/usr/ccs/bin/cc'
+    ;;
+esac
+ldflags='-L/usr/ccs/lib -L/usr/ucblib'
+test -d /usr/local/man || mansrc='none'
+ccflags='-I/usr/include -I/usr/ucbinclude'
+libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' `
+d_index='undef'
+d_suidsafe=define
+usevfork='false'
+if test "$osvers" = "3.0"; then
+	d_gconvert='undef'
+	grep 'define[ 	]*AF_OSI[ 	]' /usr/include/sys/socket.h | grep '/\*[^*]*$' >/tmp/esix$$
+	if test -s /tmp/esix$$; then
+		cat <<EOM
+
+WARNING: You are likely to have problems compiling the Socket extension
+unless you fix the unterminated comment for AF_OSI in the file
+/usr/include/sys/socket.h.
+
+EOM
+	fi
+	rm -f /tmp/esix$$
+fi
+
+cat <<'EOM'
+
+If you wish to use dynamic linking, you must use 
+	LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH
+or
+	setenv LD_LIBRARY_PATH `pwd`
+before running make.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/fps.sh b/gnu/usr.bin/perl/hints/fps.sh
new file mode 100644
index 00000000000..7726790ac0c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/fps.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -J"
diff --git a/gnu/usr.bin/perl/hints/freebsd.sh b/gnu/usr.bin/perl/hints/freebsd.sh
new file mode 100644
index 00000000000..1e92053cf54
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/freebsd.sh
@@ -0,0 +1,81 @@
+# Original based on info from
+# Carl M. Fongheiser <cmf@ins.infonet.net>
+# Date: Thu, 28 Jul 1994 19:17:05 -0500 (CDT)
+#
+# Additional 1.1.5 defines from 
+# Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net>
+# Date: Wed, 28 Sep 1994 00:37:46 +0100 (MET)
+#
+# Additional 2.* defines from
+# Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net>
+# Date: Sat, 8 Apr 1995 20:53:41 +0200 (MET DST)
+#
+# Additional 2.0.5 and 2.1 defined from
+# Ollivier Robert <Ollivier.Robert@keltia.frmug.fr.net>
+# Date: Fri, 12 May 1995 14:30:38 +0200 (MET DST)
+#
+# The two flags "-fpic -DPIC" are used to indicate a
+# will-be-shared object.  Configure will guess the -fpic, (and the
+# -DPIC is not used by perl proper) but the full define is included to 
+# be consistent with the FreeBSD general shared libs building process.
+#
+# setreuid and friends are inherently broken in all versions of FreeBSD
+# before 2.1-current (before approx date 4/15/95). It is fixed in 2.0.5
+# and what-will-be-2.1
+#
+
+case "$osvers" in
+0.*|1.0*)
+	usedl="$undef"
+	;;
+1.1*)
+	malloctype='void *'
+	groupstype='int'
+	d_setregid='undef'
+	d_setreuid='undef'
+	d_setrgid='undef'
+	d_setruid='undef'
+	;;
+2.0-release*)
+	d_setregid='undef'
+	d_setreuid='undef'
+	d_setrgid='undef'
+	d_setruid='undef'
+	;;
+#
+# Trying to cover 2.0.5, 2.1-current and future 2.1
+# It does not covert all 2.1-current versions as the output of uname
+# changed a few times.
+#
+2.0.5*|2.0-built*|2.1*)
+ 	usevfork='true'
+	;;
+#
+# Guesses at what will be needed after 2.1
+*)	usevfork='true'
+	;;
+esac
+
+# Dynamic Loading flags have not changed much, so they are separated
+# out here to avoid duplicating them everywhere.
+case "$osvers" in
+0.*|1.0*) ;;
+*)	cccdlflags='-DPIC -fpic'
+	lddlflags="-Bshareable $lddlflags"
+	;;
+esac
+
+# Avoid telldir prototype conflict in pp_sys.c  (FreeBSD uses const DIR *)
+# Configure should test for this.  Volunteers?
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+cat <<'EOM'
+
+Some users have reported that Configure halts when testing for
+the O_NONBLOCK symbol with a syntax error.  This is apparently a
+sh error.  Rerunning Configure with ksh apparently fixes the
+problem.  Try
+	ksh Configure [your options]
+
+EOM
+
diff --git a/gnu/usr.bin/perl/hints/genix.sh b/gnu/usr.bin/perl/hints/genix.sh
new file mode 100644
index 00000000000..16b6879b46b
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/genix.sh
@@ -0,0 +1 @@
+i_varargs=undef
diff --git a/gnu/usr.bin/perl/hints/greenhills.sh b/gnu/usr.bin/perl/hints/greenhills.sh
new file mode 100644
index 00000000000..da6fcc95b04
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/greenhills.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -X18"
diff --git a/gnu/usr.bin/perl/hints/hpux.sh b/gnu/usr.bin/perl/hints/hpux.sh
new file mode 100644
index 00000000000..8eaf272d70e
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/hpux.sh
@@ -0,0 +1,123 @@
+# hints/hpux.sh
+# Perl Configure hints file for Hewlett Packard HP/UX 9.x and 10.x
+# This file is based on 
+# hints/hpux_9.sh, Perl Configure hints file for Hewlett Packard HP/UX 9.x
+# Use Configure -Dcc=gcc to use gcc.
+# From: Jeff Okamoto <okamoto@hpcc123.corp.hp.com>
+# Date: Thu, 28 Sep 95 11:06:07 PDT
+# and
+# hints/hpux_10.sh, Perl Configure hints file for Hewlett Packard HP/UX 10.x
+# From: Giles Lean <giles@nemeton.com.au>
+# Date: Tue, 27 Jun 1995 08:17:45 +1000
+
+# Use Configure -Dcc=gcc to use gcc.
+# Use Configure -Dprefix=/usr/local to install in /usr/local.
+
+# Some users have reported problems with dynamic loading if the 
+# environment variable LDOPTS='-a archive' .
+
+# Turn on the _HPUX_SOURCE flag to get many of the HP add-ons
+ccflags="$ccflags -D_HPUX_SOURCE"
+ldflags="$ldflags"
+
+# Check if you're using the bundled C compiler.  This compiler doesn't support
+# ANSI C (the -Aa flag) nor can it produce shared libraries.  Thus we have
+# to turn off dynamic loading.
+case "$cc" in
+'') if cc $ccflags -Aa 2>&1 | $contains 'option' >/dev/null
+    then
+	case "$usedl" in
+	 '') usedl="$undef"
+	     cat <<'EOM'
+
+The bundled C compiler can not produce shared libraries, so you will
+not be able to use dynamic loading. 
+
+EOM
+	     ;;
+	esac
+    else
+	ccflags="$ccflags -Aa"	# The add-on compiler supports ANSI C
+    fi
+    optimize='-O'
+    ;;
+esac
+
+# Determine the architecture type of this system.
+xxuname=`uname -r`
+if echo $xxuname | $contains '10'
+then
+	# This system is running 10.0
+	xxcontext=`grep $(printf %#x $(getconf CPU_VERSION)) /usr/include/sys/unistd.h`
+	if echo "$xxcontext" | $contains 'PA-RISC1.1'
+	then
+		archname='PA-RISC1.1'
+	elif echo "$xxcontext" | $contains 'PA-RISC1.0'
+	then
+		archname='PA-RISC1.0'
+	elif echo "$xxcontext" | $contains 'PA-RISC2'
+	then
+		archname='PA-RISC2'
+	else
+		echo "This 10.0 system is of a PA-RISC type I don't recognize."
+		echo "Debugging output: $xxcontext"
+		archname=''
+	fi
+else
+	# This system is not running 10.0
+	xxcontext=`/bin/getcontext`
+	if echo "$xxcontext" | $contains 'PA-RISC1.1'
+	then
+		archname='PA-RISC1.1'
+	elif echo "$xxcontext" | $contains 'PA-RISC1.0'
+	then
+		archname='PA-RISC1.0'
+	elif echo "$xxcontext" | $contains 'HP-MC'
+	then
+		archname='HP-MC68K'
+	else
+		echo "I cannot recognize what chip set this system is using."
+		echo "Debugging output: $xxcontext"
+		archname=''
+	fi
+fi
+
+# Remove bad libraries that will cause problems
+# (This doesn't remove libraries that don't actually exist)
+# -lld is unneeded (and I can't figure out what it's used for anyway)
+# -ldbm is obsolete and should not be used
+# -lBSD contains BSD-style duplicates of SVR4 routines that cause confusion
+# -lPW is obsolete and should not be used
+# The libraries crypt, malloc, ndir, and net are empty.
+# Although -lndbm should be included, it will make perl blow up if you should
+# copy the binary to a system without libndbm.sl.  See ccdlflags below.
+set `echo " $libswanted " | sed  -e 's@ ld @ @' -e 's@ dbm @ @' -e 's@ BSD @ @' -e 's@ PW @ @'`
+libswanted="$*"
+
+# By setting the deferred flag below, this means that if you run perl on a
+# system that does not have the required shared library that you linked it
+# with, it will die when you try to access a symbol in the (missing) shared
+# library.  If you would rather know at perl startup time that you are
+# missing an important shared library, switch the comments so that immediate,
+# rather than deferred loading is performed.
+# ccdlflags="-Wl,-E $ccdlflags"
+ccdlflags="-Wl,-E -Wl,-B,deferred $ccdlflags"
+
+usemymalloc='y'
+alignbytes=8
+selecttype='int *' 
+
+# There are some lingering issues about whether g/setpgrp should be a part
+# of the perl core.  This setting should cause perl to conform to the Principle
+# of Least Astonishment.  The best thing is to use the g/setpgrp in the POSIX
+# module.
+d_bsdpgrp='define'
+
+# If your compile complains about FLT_MIN, uncomment the next line
+# POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"'
+
+# Comment this out if you don't want to follow the SVR4 filesystem layout
+# that HP-UX 10.0 uses
+case "$prefix" in
+'') prefix='/opt/perl5' ;;
+esac
diff --git a/gnu/usr.bin/perl/hints/i386.sh b/gnu/usr.bin/perl/hints/i386.sh
new file mode 100644
index 00000000000..0a810ffea88
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/i386.sh
@@ -0,0 +1 @@
+ldflags='-L/usr/ucblib'
diff --git a/gnu/usr.bin/perl/hints/irix_4.sh b/gnu/usr.bin/perl/hints/irix_4.sh
new file mode 100644
index 00000000000..f934ac7725d
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/irix_4.sh
@@ -0,0 +1,24 @@
+#irix_4.sh
+# Last modified Fri May  5 14:06:37 EDT 1995
+optimize='-O1'
+
+# Does Configure really get these wrong? Why?
+d_voidsig=define
+d_charsprf=undef
+
+case "$cc" in
+*gcc) ccflags="$ccflags -D_BSD_TYPES" ;;
+*) ccflags="$ccflags -ansiposix -signed" ;;
+esac
+
+# This hint due thanks Hershel Walters <walters@smd4d.wes.army.mil>
+# Date: Tue, 31 Jan 1995 16:32:53 -0600 (CST)
+# Subject: IRIX4.0.4(.5? 5.0?) problems
+# I don't know if they affect versions of perl other than 5.000 or
+# versions of IRIX other than 4.0.4.
+#
+cat <<'EOM'
+If you have problems, you might have try including
+	-DSTANDARD_C -cckr 
+in ccflags.
+EOM
diff --git a/gnu/usr.bin/perl/hints/irix_5.sh b/gnu/usr.bin/perl/hints/irix_5.sh
new file mode 100644
index 00000000000..5027b1574f8
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/irix_5.sh
@@ -0,0 +1,34 @@
+# irix_5.sh
+# Tue Jan  9 16:04:38 EST 1996
+#  Add note about socket patch.
+#
+# Tue Jan  2 14:52:36 EST 1996
+# Apparently, there's a stdio bug that can lead to memory
+# corruption using perl's malloc, but not SGI's malloc.
+usemymalloc='n'
+
+ld=ld
+i_time='define'
+
+case "$cc" in
+*gcc) ccflags="$ccflags -D_BSD_TYPES" ;;
+*) ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" ;;
+esac
+
+lddlflags="-shared"
+# For some reason we don't want -lsocket -lnsl or -ldl.  Can anyone
+# contribute an explanation?
+set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'`
+shift
+libswanted="$*"
+
+# Date: Fri, 22 Dec 1995 11:49:17 -0800
+# From: Matthew Black <black@csulb.edu>
+# Subject: sockets broken under IRIX 5.3? YES...how to fix
+# Anyone attempting to use perl4 or perl5 with SGI IRIX 5.3 may discover
+# that sockets are essentially broken.  The syslog interface for perl also
+# fails because it uses the broken socket interface.  This problem was
+# reported to SGI as bug #255347 and it can be fixed by installing 
+# patchSG0000596.  The patch can be downloaded from Advantage OnLine (SGI's
+# WWW server) or from the Support Advantage 9/95 Patch CDROM.  Thanks to Tom 
+# Christiansen and others who provided assistance.
diff --git a/gnu/usr.bin/perl/hints/irix_6.sh b/gnu/usr.bin/perl/hints/irix_6.sh
new file mode 100644
index 00000000000..38fe27d282c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/irix_6.sh
@@ -0,0 +1,43 @@
+# irix_6.sh
+# from Krishna Sethuraman, krishna@sgi.com
+# Date: Wed Jan 18 11:40:08 EST 1995
+# added `-32' to force compilation in 32-bit mode.
+# otherwise, copied from irix_5.sh.
+
+# Perl built with this hints file under IRIX 6.0.1 passes 
+# all tests (`make test').
+
+# Tue Jan  2 14:52:36 EST 1996
+# Apparently, there's a stdio bug that can lead to memory
+# corruption using perl's malloc, but not SGI's malloc.
+usemymalloc='n'
+
+ld=ld
+i_time='define'
+cc="cc -32"
+ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000"
+lddlflags="-32 -shared"
+
+# We don't want these libraries.  Anyone know why?
+set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'`
+shift
+libswanted="$*"
+#
+# The following might be of interest if you wish to try 64-bit mode:
+# irix_6_64bit.sh
+# Krishna Sethuraman, krishna@sgi.com
+# taken from irix_5.sh .  Changes from irix_5.sh:
+# Olimit and nested comments (warning 1009) no longer accepted
+# -OPT:fold_arith_limit so POSIX module will optimize
+# no 64bit versions of sun, crypt, nsl, socket, dl dso's available
+# as of IRIX 6.0.1 so omit those from libswanted line via `sed'.
+
+# perl 5 built with this hints file passes most tests (`make test').
+# Fails on op/subst test only. (built and tested under IRIX 6.0.1).
+
+# i_time='define'
+# ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -woff 1009 -OPT:fold_arith_limit=1046"
+# lddlflags="-shared"
+# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'`
+# shift
+# libswanted="$*"
diff --git a/gnu/usr.bin/perl/hints/irix_6_2.sh b/gnu/usr.bin/perl/hints/irix_6_2.sh
new file mode 100644
index 00000000000..111c4ad02ca
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/irix_6_2.sh
@@ -0,0 +1,28 @@
+# irix_6_2.sh
+# from Krishna Sethuraman, krishna@sgi.com
+# Date: Tue Aug 22 00:38:26 PDT 1995
+# removed -ansiposix and -D_POSIX_SOURCE cuz it was choking
+
+# Perl built with this hints file under IRIX 6.2 passes
+# all tests (`make test').
+
+ld=ld
+i_time='define'
+cc="cc -32"
+ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -Olimit 3000"
+#ccflags="$ccflags -Olimit 3000" # this line builds perl but not tk (beta 8)
+lddlflags="-32 -shared"
+# Configure would suggest the default -Kpic, which won't work for SGI.
+# Configure will respect this blank hint value instead.
+cccdlflags=' '
+
+# We don't want these libraries.  Anyone know why?
+set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'`
+shift
+libswanted="$*"
+# Don't need sun crypt bsd PW under 6.2.  You *may* need to link
+# with these if you want to run perl built under 6.2 on a 5.3 machine
+# (I haven't checked)
+#set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /' -e 's/ PW / /'`
+#shift
+#libswanted="$*"
diff --git a/gnu/usr.bin/perl/hints/isc.sh b/gnu/usr.bin/perl/hints/isc.sh
new file mode 100644
index 00000000000..df745a9b252
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/isc.sh
@@ -0,0 +1,35 @@
+#  isc.sh
+#  Interactive Unix Versions 3 and 4. 
+#  Compile perl entirely in posix mode. 
+#  Andy Dougherty		doughera@lafcol.lafayette.edu
+#  Wed Oct  5 15:57:37 EDT 1994
+#
+# Use Configure -Dcc=gcc to use gcc
+#
+
+# We don't want to explicitly mention -lc (since we're using POSIX mode.)
+# We also don't want -lx (the Xenix compatability libraries.) The only
+# thing that it seems to pick up is chsize(), which has been reported to
+# not work.  chsize() can also be implemented via fcntl() in perl (if you
+# define -D_SYSV3).  We'll leave in -lPW since it's harmless.  Some
+# extension might eventually need it for alloca, though perl doesn't use
+# it. 
+
+set `echo X "$libswanted "| sed -e 's/ c / /' -e 's/ x / /'`
+shift
+libswanted="$*"
+
+case "$cc" in
+*gcc*)	ccflags="$ccflags -posix"
+	ldflags="$ldflags -posix"
+	;;
+*)	ccflags="$ccflags -Xp -D_POSIX_SOURCE"
+	ldflags="$ldflags -Xp"
+    	;;
+esac
+
+# You can also include -D_SYSV3 to pick up "traditionally visible"
+# symbols hidden by name-space pollution rules.  This raises some
+# compilation "redefinition" warnings, but they appear harmless.
+# ccflags="$ccflags -D_SYSV3"
+
diff --git a/gnu/usr.bin/perl/hints/isc_2.sh b/gnu/usr.bin/perl/hints/isc_2.sh
new file mode 100644
index 00000000000..c73908cbc68
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/isc_2.sh
@@ -0,0 +1,22 @@
+#  isc_2.sh
+#  Interactive Unix Version 2.2
+#  Compile perl entirely in posix mode. 
+#  Andy Dougherty		doughera@lafcol.lafayette.edu
+#  Wed Oct  5 15:57:37 EDT 1994
+#
+# Use Configure -Dcc=gcc to use gcc
+#
+set `echo X "$libswanted "| sed -e 's/ c / /'`
+shift
+libswanted="$*"
+case "$cc" in
+*gcc*)	ccflags="$ccflags -posix"
+	ldflags="$ldflags -posix"
+	;;
+*)	ccflags="$ccflags -Xp -D_POSIX_SOURCE"
+	ldflags="$ldflags -Xp"
+    	;;
+esac
+# Compensate for conflicts in <net/errno.h>
+doio_cflags='ccflags="$ccflags -DENOTSOCK=103"'
+pp_sys_cflags='ccflags="$ccflags -DENOTSOCK=103"'
diff --git a/gnu/usr.bin/perl/hints/linux.sh b/gnu/usr.bin/perl/hints/linux.sh
new file mode 100644
index 00000000000..b76ee89e515
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/linux.sh
@@ -0,0 +1,163 @@
+# hints/linux.sh
+# Original version by rsanders
+# Additional support by Kenneth Albanowski <kjahds@kjahds.com>
+#
+# ELF support by H.J. Lu <hjl@nynexst.com>
+# Additional info from Nigel Head <nhead@ESOC.bitnet>
+# and Kenneth Albanowski <kjahds@kjahds.com>
+#
+# Consolidated by Andy Dougherty <doughera@lafcol.lafayette.edu>
+#
+# Updated Thu Feb  8 11:56:10 EST 1996
+
+# Updated Thu May 30 10:50:22 EDT 1996 by <doughera@lafcol.lafayette.edu>
+
+# Updated Fri Jun 21 11:07:54 EDT 1996
+# NDBM support for ELF renabled by <kjahds@kjahds.com>
+
+# perl goes into the /usr tree.  See the Filesystem Standard
+# available via anonymous FTP at tsx-11.mit.edu in
+# /pub/linux/docs/linux-standards/fsstnd.
+# Allow a command line override, e.g. Configure -Dprefix=/foo/bar
+case "$prefix" in
+'') prefix='/usr' ;;
+esac
+
+# gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool.
+ccflags="-Dbool=char -DHAS_BOOL $ccflags"
+
+# BSD compatability library no longer needed
+set `echo X "$libswanted "| sed -e 's/ bsd / /'`
+shift
+libswanted="$*"
+
+# Configure may fail to find lstat() since it's a static/inline
+# function in <sys/stat.h>.
+d_lstat=define
+
+# Explanation?
+case "$usemymalloc" in
+'') usemymalloc='n' ;;
+esac
+
+case "$optimize" in
+'') optimize='-O2' ;;
+esac
+
+# Are we using ELF?  Thanks to Kenneth Albanowski <kjahds@kjahds.com>
+# for this test.
+cat >try.c <<'EOM'
+/* Test for whether ELF binaries are produced */
+#include <fcntl.h>
+#include <stdlib.h>
+main() {
+	char buffer[4];
+	int i=open("a.out",O_RDONLY);
+	if(i==-1)
+		exit(1); /* fail */
+	if(read(i,&buffer[0],4)<4)
+		exit(1); /* fail */
+	if(buffer[0] != 127 || buffer[1] != 'E' ||
+           buffer[2] != 'L' || buffer[3] != 'F')
+		exit(1); /* fail */
+	exit(0); /* succeed (yes, it's ELF) */
+}
+EOM
+if ${cc:-gcc} try.c >/dev/null 2>&1 && ./a.out; then
+    cat <<'EOM' >&4
+
+You appear to have ELF support.  I'll try to use it for dynamic loading.
+If dynamic loading doesn't work, read hints/linux.sh for further information.
+EOM
+
+#For RedHat Linux 3.0.3, you may need to fetch
+# ftp://ftp.redhat.com/pub/redhat-3.0.3/i386/updates/RPMS/ld.so-1.7.14-3.i386.rpm
+#
+
+else
+    cat <<'EOM' >&4
+
+You don't have an ELF gcc.  I will use dld if possible.  If you are
+using a version of DLD earlier than 3.2.6, or don't have it at all, you
+should probably upgrade. If you are forced to use 3.2.4, you should
+uncomment a couple of lines in hints/linux.sh and restart Configure so
+that shared libraries will be disallowed.
+
+EOM
+    lddlflags="-r $lddlflags"
+    # These empty values are so that Configure doesn't put in the
+    # Linux ELF values.
+    ccdlflags=' '
+    cccdlflags=' '
+    ccflags="-DOVR_DBL_DIG=14 $ccflags"
+    so='sa'
+    dlext='o'
+    nm_so_opt=' '
+    ## If you are using DLD 3.2.4 which does not support shared libs,
+    ## uncomment the next two lines:
+    #ldflags="-static"
+    #so='none'
+
+	# In addition, on some systems there is a problem with perl and NDBM
+	# which causes AnyDBM and NDBM_File to lock up. This is evidenced 
+	# in the tests as AnyDBM just freezing.  Apparently, this only 
+	# happens on a.out systems, so we disable NDBM for all a.out linux
+	# systems.  If someone can suggest a more robust test
+	#  that would be appreciated.
+	#
+	# More info:
+	# Date: Wed, 7 Feb 1996 03:21:04 +0900
+	# From: Jeffrey Friedl <jfriedl@nff.ncl.omron.co.jp>
+	#
+	# I tried compiling with DBM support and sure enough things locked up
+	# just as advertised. Checking into it, I found that the lockup was
+	# during the call to dbm_open. Not *in* dbm_open -- but between the call
+	# to and the jump into.
+	# 
+	# To make a long story short, making sure that the *.a and *.sa pairs of
+	#   /usr/lib/lib{m,db,gdbm}.{a,sa}
+	# were perfectly in sync took care of it.
+	#
+	# This will generate a harmless Whoa There! message
+	case "$d_dbm_open" in
+	'')	cat <<'EOM' >&4
+
+Disabling ndbm.  This will generate a Whoa There message in Configure.
+Read hints/linux.sh for further information.
+EOM
+		# You can override this with Configure -Dd_dbm_open
+		d_dbm_open=undef
+		;;
+	esac
+fi
+
+rm -f try.c a.out
+
+if /bin/bash -c exit; then
+  echo
+  echo You appear to have a working bash. Good.
+else
+  cat << 'EOM' >&4
+
+*********************** Warning! *********************
+It would appear you have a defective bash shell installed. This is likely to
+give you a failure of op/exec test #5 during the test phase of the build,
+Upgrading to a recent version (1.14.4 or later) should fix the problem.
+******************************************************
+EOM
+
+fi
+
+# Avoid some troublesome gcvt() functions.  With some libc versions, 
+# perl -e '$x=1e5; print "$x\n";' prints 1e+5.  We'd like it
+# to print 100000 instead, consistent with the integer value given
+# on other platforms.  This isn't a bug in gcvt, really; more in our
+# expectations for it.  We'd like it to behave exactly as
+# sprintf %.16g, but it isn't documented to do that.
+#
+# We'll use sprintf() instead, since we can control the output more
+# precisely.
+# 
+# The next version of Configure will check for this automatically.
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+
diff --git a/gnu/usr.bin/perl/hints/machten.sh b/gnu/usr.bin/perl/hints/machten.sh
new file mode 100644
index 00000000000..c86707c1827
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/machten.sh
@@ -0,0 +1,62 @@
+# machten.sh
+# This is for MachTen 4.0.2.  It might work on other versions too.
+#
+# MachTen users might need a fixed tr from ftp.tenon.com.  This should
+# be described in the MachTen release notes.
+#
+# MachTen 2.x has its own hint file.
+#
+# This file has been put together by Andy Dougherty
+# <doughera@lafcol.lafayette.edu> based on comments from lots of
+# folks, especially 
+# 	Mark Pease <peasem@primenet.com>
+#	Martijn Koster <m.koster@webcrawler.com>
+#	Richard Yeh <rcyeh@cco.caltech.edu>
+#
+# File::Find's use of link count disabled by Dominic Dunlop 950528
+# Perl's use of sigsetjmp etc. disabled by Dominic Dunlop 950521
+#
+# Comments, questions, and improvements welcome!
+#
+# MachTen 4.X does support dynamic loading, but perl doesn't
+# know how to use it yet.
+#
+#  Updated by Dominic Dunlop <domo@tcp.ip.lu>
+#  Tue May 28 11:20:08 WET DST 1996
+
+# Configure doesn't know how to parse the nm output.
+usenm=undef
+
+# At least on PowerMac, doubles must be aligned on 8 byte boundaries.
+# I don't know if this is true for all MachTen systems, or how to
+# determine this automatically.
+alignbytes=8
+
+# There appears to be a problem with perl's use of sigsetjmp and
+# friends.  Use setjmp and friends instead.
+d_sigsetjmp='undef' 
+
+# MachTen always reports ony two links to directories, even if they
+# contain subdirectories.  Consequently, we use this variable to stop
+# File::Find using the link count to determine whether there are
+# subdirectories to be searched.  This will generate a harmless message:
+# Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+#	Propagating recommended variable dont_use_nlink
+dont_use_nlink=define
+
+cat <<'EOM' >&4
+
+Tests
+	io/fs test 4  and
+	op/stat test 3
+may fail since MachTen does not return a useful nlinks field to stat
+on directories.
+
+At the end of Configure, you will see a harmless message
+
+Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+	Propagating recommended variable dont_use_nlink
+
+Read the File::Find documentation for more information.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/machten_2.sh b/gnu/usr.bin/perl/hints/machten_2.sh
new file mode 100644
index 00000000000..e9fe41df134
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/machten_2.sh
@@ -0,0 +1,52 @@
+# machten.sh
+# This file has been put together by Mark Pease <peasem@primenet.com>
+# Comments, questions, and improvements welcome!
+#
+# MachTen does not support dynamic loading. If you wish to, you
+# can get <ftp://tsx-11.mit.edu/pub/linux/sources/libs/dld-src-3.2.4.tar.gz>
+# compile and install. This is the version of DLD that works with the
+# ext/DynaLoader/dl_dld.xs in the perl5 package. Have fun!
+#
+#  Original version was for MachTen 2.1.1.
+#  Last modified by Andy Dougherty   <doughera@lafcol.lafayette.edu>
+#  Fri Feb  9 13:04:45 EST 1996
+
+# I don't know why this is needed.  It might be similar to NeXT's
+# problem.  See hints/next_3.sh.
+usemymalloc='n'
+
+so='none'
+# These are useful only if you have DLD, but harmless otherwise.
+# Make sure gcc doesn't use -fpic.
+cccdlflags=' '  # That's an empty space.
+lddlflags='-r'
+dlext='o'
+
+# MachTen does not support POSIX enough to compile the POSIX module.
+useposix=false
+
+#MachTen might have an incomplete Berkeley DB implementation.
+i_db=$undef
+
+#MachTen versions 2.X have no hard links.  This variable is used
+# by File::Find.
+# This will generate a harmless message:
+# Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+#	Propagating recommended variable dont_use_nlink
+dont_use_nlink=define
+
+cat <<'EOM' >&4
+
+Tests
+	io/fs test 4  and
+	op/stat test 3
+may fail since MachTen versions 2.X have no hard links.
+
+At the end of Configure, you will see a harmless message
+
+Hmm...You had some extra variables I don't know about...I'll try to keep 'em.
+	Propagating recommended variable dont_use_nlink
+
+Read the File::Find documentation for more information.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/mips.sh b/gnu/usr.bin/perl/hints/mips.sh
new file mode 100644
index 00000000000..39cadb4b667
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/mips.sh
@@ -0,0 +1,14 @@
+perl_cflags='optimize="-g"'
+d_volatile=undef
+d_castneg=undef
+cc=cc
+libpth="/usr/lib/cmplrs/cc $libpth"
+groupstype=int
+nm_opt='-B'
+case $PATH in
+*bsd*:/bin:*) cat <<END
+NOTE:  Some people have reported having much better luck with Mips CC than
+with the BSD cc.  Put /bin first in your PATH if you have difficulties.
+END
+;;
+esac
diff --git a/gnu/usr.bin/perl/hints/mpc.sh b/gnu/usr.bin/perl/hints/mpc.sh
new file mode 100644
index 00000000000..da6fcc95b04
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/mpc.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -X18"
diff --git a/gnu/usr.bin/perl/hints/mpeix.sh b/gnu/usr.bin/perl/hints/mpeix.sh
new file mode 100644
index 00000000000..9fc2737893a
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/mpeix.sh
@@ -0,0 +1,70 @@
+# MPE/IX does not have nm, and the linker doesn't complain
+# about unresolved symbols, so these are all filled in by hand.
+osname='mpeix'
+osvers='5.0'
+alignbytes='8'
+ccflags='-D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL'
+cc='c89'
+optimize='-g'
+d_safebcpy='undef'
+d_safemcpy='undef'
+intsize='8'
+usemymalloc='y'
+d_casti32='undef'
+d_castneg='undef'
+prefix='/PERL'
+privlib='/PERL/PERL/lib'
+archlib='/PERL/PERL/lib/mpeix'
+clocktype='clock_t'
+gidtype='gid_t'
+groupstype='gid_t'
+lseektype='off_t'
+modetype='mode_t'
+randbits='15'
+ssizetype='ssize_t'
+uidtype='uid_t'
+d_stdstdio='undef'
+i_pwd='undef'
+i_grp='undef'
+#d_fd_set='undef'
+#d_fds_bits='undef'
+d_chroot='undef'
+d_fchmod='undef'
+d_fchown='undef'
+d_flock='undef'
+d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_getpgrp2='undef'
+d_getprior='undef'
+d_killpg='undef'
+d_lstat='undef'
+d_seekdir='undef'
+d_telldir='undef'
+d_setpgrp2='undef'
+d_setprior='undef'
+d_setresgid='undef'
+d_setresuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+d_syscall='undef'
+d_truncate='undef'
+d_setregid='undef'
+d_setreuid='undef'
+d_setpgrp='undef'
+d_chsize='undef'
+d_group='undef'
+d_bcmp='undef'
+d_bcopy='undef'
+d_bzero='undef'
+d_attrib='undef'
+d_dirnamlen='define'
+d_link='undef'
+d_passwd='undef'
+d_pwcomment='undef'
+d_statblks='undef'
+libs='-lsvipc -lsocket -lm -lc'
+ranlib='/bin/true'
+d_nice='undef'
+d_cuserid='undef'
+i_termios='undef'
+d_tcgetpgrp='undef'
+d_tcsetpgrp='undef'
diff --git a/gnu/usr.bin/perl/hints/ncr_tower.sh b/gnu/usr.bin/perl/hints/ncr_tower.sh
new file mode 100644
index 00000000000..7ddb9230e90
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/ncr_tower.sh
@@ -0,0 +1,16 @@
+#  For SysV release 2, there are no directory functions defined.  To
+#  prevent compile errors, acquire the functions written by Doug Gwynn.
+#  They are contained in dirent.tar.gz and can be accessed from gnu 
+#  repositories, as well as other places.
+#
+#	The following hints have been verified to work with PERL5 (001m) on
+#  SysVr2 with the following caveat(s):
+#	1. Maximum User program space (MAXSPACE) must be at least 2MB.
+#	2. The directory functions mentioned above have been installed.
+#
+optimize='-O0'
+ccflags="$ccflags -W2,-Sl,1500 -W0,-Sp,350,-Ss,2500 -Wp,-Sd,30"
+d_mkdir=$undef
+usemymalloc='y'
+useposix='false'
+so='none'
diff --git a/gnu/usr.bin/perl/hints/netbsd.sh b/gnu/usr.bin/perl/hints/netbsd.sh
new file mode 100644
index 00000000000..24ffe15f730
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/netbsd.sh
@@ -0,0 +1,39 @@
+# hints/netbsd.sh
+#
+# talk to mrg@eterna.com.au if you want to change this file.
+#
+# netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o,
+# so Configure doesn't find them (unless you abandon the nm scan).
+# this should be *just* 0.9 below as netbsd 0.9a was the first to
+# introduce shared libraries.
+case "$osvers" in
+0.9|0.8*)
+	usedl="$undef"
+	;;
+*)	d_dlopen=$define
+	d_dlerror=$define
+# we use -fPIC here because -fpic is *NOT* enough for some of the
+# extensions like Tk on some netbsd platforms (the sparc is one)
+	cccdlflags="-DPIC -fPIC $cccdlflags"
+	lddlflags="-Bforcearchive -Bshareable $lddlflags"
+# netbsd has these but they don't really work as advertised.  if they
+# are defined, then there isn't a way to make perl call setuid() or
+# setgid().  if they aren't, then ($<, $>) = ($u, $u); will work (same
+# for $(/$)).  this is because you can not change the real userid of
+# a process under 4.4BSD.
+	d_setregid="$undef"
+	d_setreuid="$undef"
+	d_setrgid="$undef"
+	d_setruid="$undef"
+	;;
+esac
+
+# Avoid telldir prototype conflict in pp_sys.c  (NetBSD uses const DIR *)
+# Configure should test for this.  Volunteers?
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+case "$archname" in
+'')
+    archname=`uname -m`-${osname}
+    ;;
+esac
diff --git a/gnu/usr.bin/perl/hints/next_3.sh b/gnu/usr.bin/perl/hints/next_3.sh
new file mode 100644
index 00000000000..7db901c7385
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/next_3.sh
@@ -0,0 +1,41 @@
+# This file has been put together by Anno Siegel <siegel@zrz.TU-Berlin.DE>
+# and Andreas Koenig <k@franz.ww.TU-Berlin.DE>. Comments, questions, and
+# improvements welcome!
+#
+# These hints work for NeXT 3.2 and 3.3.  3.0 has it's own
+# special hint file.
+
+ccflags='-DUSE_NEXT_CTYPE'
+POSIX_cflags='ccflags="-posix $ccflags"'
+ldflags='-u libsys_s'
+libswanted='dbm gdbm db'
+
+lddlflags='-r'
+# Give cccdlflags an empty value since Configure will detect we are
+# using GNU cc and try to specify -fpic for cccdlflags.
+cccdlflags=' '
+
+i_utime='undef'
+groupstype='int'
+direntrytype='struct direct'
+d_strcoll='undef'
+# the simple program `for ($i=1;$i<38771;$i++){$t{$i}=123}' fails
+# with Larry's malloc on NS 3.2 due to broken sbrk()
+usemymalloc='n'
+d_uname='define'
+d_setpgid='define'
+d_setsid='define'
+d_tcgetpgrp='define'
+d_tcsetpgrp='define'
+#
+# On some NeXT machines, the timestamp put by ranlib is not correct, and
+# this may cause useless recompiles.  Fix that by adding a sleep before
+# running ranlib.  The '5' is an empirical number that's "long enough."
+# (Thanks to Andreas Koenig <k@franz.ww.tu-berlin.de>)
+ranlib='sleep 5; /bin/ranlib' 
+#
+# There where reports that the compiler on HPPA machines
+# fails with the -O flag on pp.c.
+if [ `arch` = "hppa" ]; then
+pp_cflags='optimize="-g"'
+fi
diff --git a/gnu/usr.bin/perl/hints/next_3_0.sh b/gnu/usr.bin/perl/hints/next_3_0.sh
new file mode 100644
index 00000000000..3a50247e9c4
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/next_3_0.sh
@@ -0,0 +1,48 @@
+# This file has been put together by Anno Siegel <siegel@zrz.TU-Berlin.DE>
+# and Andreas Koenig <k@franz.ww.TU-Berlin.DE>. Comments, questions, and
+# improvements welcome!
+
+# This file was modified to work on NS 3.0 by Kevin White
+# <klwhite@magnus.acs.ohio-state.edu>, based on suggestions by Andreas
+# Koenig and Andy Dougherty.
+
+echo With NS 3.0 you won\'t be able to use the POSIX module.
+echo Be aware that some of the tests that are run during "make test"
+echo will fail due to the lack of POSIX support on this system.
+echo
+echo Also, if you have the GDBM installed, make sure the header file
+echo is located at a place on the system where the C compiler will
+echo find it.  By default, it is placed in /usr/local/include/gdbm.h.
+echo It will not be found there.  Try moving it to
+echo /NextDeveloper/Headers/bsd/gdbm.h.
+
+ccflags='-DUSE_NEXT_CTYPE -DNEXT30_NO_ATTRIBUTE'
+POSIX_cflags='ccflags="-posix $ccflags"'
+useposix='undef'
+ldflags='-u libsys_s'
+libswanted='dbm gdbm db'
+#
+lddlflags='-r'
+# Give cccdlflags an empty value since Configure will detect we are
+# using GNU cc and try to specify -fpic for cccdlflags.
+cccdlflags=' '
+#
+i_utime='undef'
+groupstype='int'
+direntrytype='struct direct'
+d_strcoll='undef'
+# the simple program `for ($i=1;$i<38771;$i++){$t{$i}=123}' fails
+# with Larry's malloc on NS 3.2 due to broken sbrk()
+usemymalloc='n'
+d_uname='define'
+d_setpgid='define'
+d_setsid='define'
+d_tcgetpgrp='define'
+d_tcsetpgrp='define'
+#
+# On some NeXT machines, the timestamp put by ranlib is not correct, and
+# this may cause useless recompiles.  Fix that by adding a sleep before
+# running ranlib.  The '5' is an empirical number that's "long enough."
+# (Thanks to Andreas Koenig <k@franz.ww.tu-berlin.de>)
+ranlib='sleep 5; /bin/ranlib' 
+
diff --git a/gnu/usr.bin/perl/hints/opus.sh b/gnu/usr.bin/perl/hints/opus.sh
new file mode 100644
index 00000000000..da6fcc95b04
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/opus.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -X18"
diff --git a/gnu/usr.bin/perl/hints/os2.sh b/gnu/usr.bin/perl/hints/os2.sh
new file mode 100644
index 00000000000..43b4b8ea49b
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/os2.sh
@@ -0,0 +1,139 @@
+# hints/os2.sh
+# This file reflects the tireless work of
+# Ilya Zakharevich <ilya@math.ohio-state.edu>
+#
+# Trimmed and comments added by 
+#     Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#     Exactly what is required beyond a standard OS/2 installation?
+#     There are notes about "patched pdksh" I don't understand.
+
+# Note that symbol extraction code gives wrong answers (sometimes?) on
+# gethostent and setsid.
+
+# Note that during the .obj compile you need to move the perl.dll file
+# to LIBPATH :-(
+
+#osname="OS/2"
+sysman=`../UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`
+cc='gcc'
+usrinc='/emx/include'
+libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`"
+
+if test "$libemx" = "X"; then echo "Cannot find C library!"; fi
+
+libpth="$libemx/st $libemx"
+
+so='dll'
+
+# Additional definitions:
+
+firstmakefile='GNUmakefile'
+exe_ext='.exe'
+
+if [ "$emxaout" != "" ]; then
+    d_shrplib='undef'
+    obj_ext='.o'
+    lib_ext='.a'
+    ar='ar'
+    plibext='.a'
+    d_fork='define'
+    lddlflags='-Zdll'
+    ldflags='-Zexe'
+    ccflags='-DDOSISH -DNO_SYS_ALLOC -DOS2=2 -DEMBED -I. -DPACK_MALLOC'
+    use_clib='c'
+else
+    d_shrplib='define'
+    obj_ext='.obj'
+    lib_ext='.lib'
+    ar='emxomfar'
+    plibext='.lib'
+    d_fork='undef'
+    lddlflags='-Zdll -Zomf -Zcrtdll'
+    # Recursive regmatch may eat 2.5M of stack alone.
+    ldflags='-Zexe -Zomf -Zcrtdll -Zstack 32000'
+    ccflags='-Zomf -DDOSISH -DOS2=2 -DEMBED -I. -DPACK_MALLOC'
+    use_clib='c_import'
+fi
+
+# To get into config.sh (should start at the beginning of line)
+# or you can put it into config.over.
+plibext="$plibext"
+
+#libc="/emx/lib/st/c_import$lib_ext"
+libc="$libemx/st/$use_clib$lib_ext"
+
+if test -r "$libemx/c_alias$lib_ext"; then 
+    libnames="$libemx/c_alias$lib_ext"
+fi
+# otherwise puts -lc ???
+
+# [Maybe we should just remove c from $libswanted ?]
+
+libs='-lsocket -lm'
+archobjs="os2$obj_ext"
+
+# Run files without extension with sh - feature of patched ksh
+# [???]
+NOHASHBANG=sh
+# Same with newer ksh
+EXECSHELL=sh
+
+cccdlflags='-Zdll'
+dlsrc='dl_os2.xs'
+ld='gcc'
+usedl='define'
+
+#cppflags='-DDOSISH -DOS2=2 -DEMBED -I.'
+
+# for speedup: (some patches to ungetc are also needed):
+# Note that without this guy tests 8 and 10 of io/tell.t fail, with it 11 fails
+
+stdstdunder=`echo "#include <stdio.h>" | cpp | egrep -c "char +\* +_ptr"`
+d_stdstdio='define'
+d_stdiobase='define'
+d_stdio_ptr_lval='define'
+d_stdio_cnt_lval='define'
+
+if test "$stdstdunder" = 0; then
+  stdio_ptr='((fp)->ptr)'
+  stdio_cnt='((fp)->rcount)'
+  stdio_base='((fp)->buffer)'
+  stdio_bufsiz='((fp)->rcount + (fp)->ptr - (fp)->buffer)'
+  ccflags="$ccflags -DMYTTYNAME"
+  myttyname='define'
+else
+  stdio_ptr='((fp)->_ptr)'
+  stdio_cnt='((fp)->_rcount)'
+  stdio_base='((fp)->_buffer)'
+  stdio_bufsiz='((fp)->_rcount + (fp)->_ptr - (fp)->_buffer)'
+fi
+
+# to put into config.sh
+myttyname="$myttyname"
+
+# To have manpages installed
+nroff='nroff.cmd'
+# above will be overwritten otherwise, indented to avoid config.sh
+  _nroff='nroff.cmd'
+
+ln='cp'
+# Will be rewritten otherwise, indented to not put in config.sh
+  _ln='cp'
+lns='cp'
+
+nm_opt='-p'
+
+####### All the rest is commented
+
+# I do not have these:
+#dynamic_ext='Fcntl GDBM_File SDBM_File POSIX Socket UPM REXXCALL'
+#dynamic_ext='Fcntl POSIX Socket SDBM_File Devel/DProf'
+#extensions='Fcntl GDBM_File SDBM_File POSIX Socket UPM REXXCALL'
+#extensions='Fcntl SDBM_File POSIX Socket Devel/DProf'
+
+# The next two are commented. pdksh handles #!
+# sharpbang='extproc '
+# shsharp='false'
+
+# Commented:
+#startsh='extproc ksh\\n#! sh'
diff --git a/gnu/usr.bin/perl/hints/powerux.sh b/gnu/usr.bin/perl/hints/powerux.sh
new file mode 100644
index 00000000000..b1c082651f6
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/powerux.sh
@@ -0,0 +1,68 @@
+# Hints for the PowerUX operating system running on Harris NightHawk
+# machines.  Written by Tom.Horsley@mail.hcsc.com
+#
+# This config uses dynamic linking and the Harris C compiler.  It has been
+# tested on a Harris 6800 running PowerUX.
+
+# Internally at Harris, we use a source management tool which winds up
+# giving us read-only copies of source trees that are mostly symbolic links.
+# That upsets the perl build process when it tries to edit opcode.h and
+# embed.h or touch perly.c or perly.h, so turn those files into "real" files
+# when Configure runs. (If you already have "real" source files, this won't
+# do anything).
+#
+if [ -x /usr/local/mkreal ]
+then
+   for i in '.' '..'
+   do
+      for j in embed.h opcode.h perly.h perly.c
+      do
+         if [ -h $i/$j ]
+         then
+            ( cd $i ; /usr/local/mkreal $j ; chmod 666 $j )
+         fi
+      done
+   done
+fi
+
+# We DO NOT want -lmalloc or -lPW, we DO need -lgen to follow -lnsl, so
+# fixup libswanted to reflect that desire.
+#
+libswanted=`echo ' '$libswanted' ' | sed -e 's/ malloc / /' -e 's/ PW / /' -e 's/ nsl / nsl gen /'`
+
+# We DO NOT want /usr/ucblib in glibpth
+#
+glibpth=`echo ' '$glibpth' ' | sed -e 's@ /usr/ucblib @ @'`
+
+# Yes, csh exists, but doesn't work worth beans, if perl tries to use it,
+# the glob test fails, so just pretend it isn't there...
+#
+d_csh='undef'
+
+# Need to use Harris cc for most of these options to be meaningful (if you
+# want to get this to work with gcc, you're on your own :-). Passing
+# -Bexport to the linker when linking perl is important because it leaves
+# the interpreter internal symbols visible to the shared libs that will be
+# loaded on demand (and will try to reference those symbols).
+#
+cc='/bin/cc'
+cccdlflags='-Zpic'
+ccdlflags='-Zlink=dynamic -Wl,-Bexport'
+lddlflags='-Zlink=so'
+
+# Configure sometime finds what it believes to be ndbm header files on the
+# system and imagines that we have the NDBM library, but we really don't.
+# There is something there that once resembled ndbm, but it is purely
+# for internal use in some tool and has been hacked beyond recognition
+# (or even function :-)
+#
+i_ndbm='undef'
+
+# Misc other flags that might be able to change, but I know these work right.
+#
+d_suidsafe='define'
+d_isascii='define'
+d_mymalloc='undef'
+usemymalloc='n'
+ssizetype='ssize_t'
+usevfork='false'
diff --git a/gnu/usr.bin/perl/hints/sco.sh b/gnu/usr.bin/perl/hints/sco.sh
new file mode 100644
index 00000000000..307e27e4db2
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco.sh
@@ -0,0 +1,90 @@
+# sco_3.sh 
+# Courtesy of Joel Rosi-Schwartz <joel@ftechne.co.uk>
+# Additional SCO version info from
+# Peter Wolfe	<wolfe@teloseng.com>
+# Last revised 
+# Tue Feb 13 09:09:10 EST 1996
+
+# To use gcc, use     sh Configure -Dcc=gcc
+
+# figure out what SCO version we are:
+case `uname -X | egrep '^Release'` in
+*3.2v4.2) scorls=3 ;;
+*3.2v5.*) scorls=5 ;;
+*) scorls=3 ;; # this probabaly shouldn't happen
+esac
+
+# Try to use libintl.a since it has strcoll and strxfrm
+libswanted="intl $libswanted"
+# Try to use libdbm.nfs.a since it has dbmclose.
+# 
+if test -f /usr/lib/libdbm.nfs.a ; then
+    libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'`
+fi
+set X $libswanted
+shift
+libswanted="$*"
+
+# We don't want Xenix cross-development libraries
+glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'`
+xlibpth=''
+
+case "$cc" in
+gcc)
+	ccflags="$ccflags -U M_XENIX"
+	optimize="$optimize -O2"
+	;;
+scocc)	;;
+
+*)	# Apparently, SCO's cc gives rather verbose warnings
+	# Set -w0 to turn them off.
+	case $scorls in
+	3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
+	5) ccflags="$ccflags -w0 -U M_XENIX" ;;
+	esac
+	;;
+esac
+i_varargs=undef
+
+# I have received one report that nm extraction doesn't work if you're
+# using the scocc compiler.  This system had the following 'myconfig'
+# uname='xxx xxx 3.2 2 i386 '
+# cc='scocc', optimize='-O'
+usenm='false'
+
+# If you want to use nm, you'll probably have to use nm -p.  The
+# following does that for you:
+nm_opt='-p'
+
+# I have received one report that you can't include utime.h in
+# pp_sys.c.  Uncomment the following line if that happens to you:
+# i_utime=undef
+
+# Apparently, some versions of SCO include both .so and .a libraries,
+# but they don't mix as they do on other ELF systems.  The upshot is
+# that Configure finds -ldl (libdl.so) but 'ld' complains it can't
+# find libdl.a. 
+# I don't know which systems have this feature, so I'll just remove
+# -dl from libswanted for all SCO systems until someone can figure
+# out how to get dynamic loading working on SCO.
+#
+# The output of uname -X on one such system was
+#	System = SCO_SV
+#	Node = xxxxx
+#	Release = 3.2v5.0.0
+#	KernelID = 95/08/08
+#	Machine = Pentium  
+#	BusType = ISA
+#	Serial = xxxxx
+#	Users = 5-user
+#	OEM# = 0
+#	Origin# = 1
+#	NumCPU = 1 
+#
+# The 5.0.0 on the Release= line is probably the thing to watch.
+#	Andy Dougherty <doughera@lafcol.lafayette.edu>
+#	Thu Feb  1 15:06:56 EST 1996
+libswanted=`echo " $libswanted " | sed -e 's/ dl / /'`
+set X $libswanted
+shift
+libswanted="$*"
diff --git a/gnu/usr.bin/perl/hints/sco_2_3_0.sh b/gnu/usr.bin/perl/hints/sco_2_3_0.sh
new file mode 100644
index 00000000000..146363ab3d5
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco_2_3_0.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -Sm25000'
+i_dirent=undef
diff --git a/gnu/usr.bin/perl/hints/sco_2_3_1.sh b/gnu/usr.bin/perl/hints/sco_2_3_1.sh
new file mode 100644
index 00000000000..146363ab3d5
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco_2_3_1.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -Sm25000'
+i_dirent=undef
diff --git a/gnu/usr.bin/perl/hints/sco_2_3_2.sh b/gnu/usr.bin/perl/hints/sco_2_3_2.sh
new file mode 100644
index 00000000000..e113a4ec65e
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco_2_3_2.sh
@@ -0,0 +1,2 @@
+yacc='/usr/bin/yacc -Sm25000'
+libswanted=`echo " $libswanted "| sed 's/ x / /'`
diff --git a/gnu/usr.bin/perl/hints/sco_2_3_3.sh b/gnu/usr.bin/perl/hints/sco_2_3_3.sh
new file mode 100644
index 00000000000..10baafd6a30
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco_2_3_3.sh
@@ -0,0 +1,3 @@
+yacc='/usr/bin/yacc -Sm25000'
+echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
+echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
diff --git a/gnu/usr.bin/perl/hints/sco_2_3_4.sh b/gnu/usr.bin/perl/hints/sco_2_3_4.sh
new file mode 100644
index 00000000000..84f58172b3c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sco_2_3_4.sh
@@ -0,0 +1,5 @@
+yacc='/usr/bin/yacc -Sm25000'
+ccflags="$ccflags -UM_I86"
+usemymalloc='y'
+echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
+echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
diff --git a/gnu/usr.bin/perl/hints/solaris_2.sh b/gnu/usr.bin/perl/hints/solaris_2.sh
new file mode 100644
index 00000000000..6ce4666421e
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/solaris_2.sh
@@ -0,0 +1,346 @@
+# hints/solaris_2.sh
+# Last modified:  Thu Feb  8 11:38:12 EST 1996
+# Andy Dougherty  <doughera@lafcol.lafayette.edu>
+# Based on input from lots of folks, especially
+# Dean Roehrich <roehrich@ironwood-fddi.cray.com>
+
+# See man vfork.
+usevfork=false
+
+d_suidsafe=define
+
+# Avoid all libraries in /usr/ucblib.
+set `echo $glibpth | sed -e 's@/usr/ucblib@@'`
+glibpth="$*"
+
+# Remove bad libraries.  -lucb contains incompatible routines.
+# -lld doesn't do anything useful.
+# -lmalloc can cause a problem with GNU CC & Solaris.  Specifically,
+# libmalloc.a may allocate memory that is only 4 byte aligned, but
+# GNU CC on the Sparc assumes that doubles are 8 byte aligned.
+# Thanks to  Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
+set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ malloc @ @' -e 's@ ucb @ @'`
+libswanted="$*"
+
+# Look for architecture name.  We want to suggest a useful default.
+case "$archname" in
+'')
+    if test -f /usr/bin/arch; then
+        archname=`/usr/bin/arch`
+    	archname="${archname}-${osname}"
+    elif test -f /usr/ucb/arch; then
+        archname=`/usr/ucb/arch`
+    	archname="${archname}-${osname}"
+    fi
+    ;;
+esac
+
+# Solaris 2.5 has reintroduced some BSD-ish functions into libc.
+# This is no problem unless you compile perl under Solaris 2.5 but
+# try to run the binary on 2.4.  Here, we take the easy way out by
+# claiming we don't have these functions.  perl.h works around all of
+# these anyway.
+# XXX Eventually, I should fix perl.h to prefer the POSIX versions.
+d_bcmp='undef'
+d_bcopy='undef'
+d_safebcpy='undef'
+d_index='undef'
+
+######################################################
+# General sanity testing.  See below for excerpts from the Solaris FAQ.
+
+# From roehrich@ironwood-fddi.cray.com Wed Sep 27 12:51:46 1995
+# Date: Thu, 7 Sep 1995 16:31:40 -0500
+# From: Dean Roehrich <roehrich@ironwood-fddi.cray.com>
+# To: perl5-porters@africa.nicoh.com
+# Subject: Re: On perl5/solaris/gcc
+
+# Here's another draft of the perl5/solaris/gcc sanity-checker. 
+
+case $PATH in
+*/usr/ucb*:/usr/bin:*|*/usr/ucb*:/usr/bin) cat <<END
+
+NOTE:  Some people have reported problems with /usr/ucb/cc.  
+Remove /usr/ucb from your PATH if you have difficulties.
+
+END
+;;
+esac
+
+
+# Check that /dev/fd is mounted.  If it is not mounted, let the
+# user know that suid scripts may not work.
+/usr/bin/df /dev/fd 2>&1 > /dev/null
+case $? in
+0) ;;
+*)
+	cat <<END
+
+NOTE: Your system does not have /dev/fd mounted.  If you want to
+be able to use set-uid scripts you must ask your system administrator
+to mount /dev/fd.
+
+END
+	;;
+esac
+
+
+# See if libucb can be found in /usr/lib.  If it is, warn the user
+# that this may cause problems while building Perl extensions.
+/usr/bin/ls /usr/lib/libucb* >/dev/null 2>&1
+case $? in
+0)
+	cat <<END
+
+NOTE: libucb has been found in /usr/lib.  libucb should reside in
+/usr/ucblib.  You may have trouble while building Perl extensions.
+
+END
+;;
+esac
+
+
+# See if make(1) is GNU make(1).
+# If it is, make sure the setgid bit is not set.
+make -v > make.vers 2>&1
+if grep GNU make.vers > /dev/null 2>&1; then
+    tmp=`/usr/bin/which make`
+    case "`/usr/bin/ls -l $tmp`" in
+    ??????s*)
+	    cat <<END
+	
+NOTE: Your PATH points to GNU make, and your GNU make has the set-group-id
+bit set.  You must either rearrange your PATH to put /usr/ccs/bin before the
+GNU utilities or you must ask your system administrator to disable the
+set-group-id bit on GNU make.
+
+END
+	    ;;
+    esac
+fi
+rm -f make.vers
+
+# If the C compiler is gcc:
+#   - check the fixed-includes
+#   - check as(1) and ld(1), they should not be GNU
+# If the C compiler is not gcc:
+#   - check as(1) and ld(1), they should not be GNU
+#
+# Watch out in case they have not set $cc.
+case "`${cc:-cc} -v 2>&1`" in
+*gcc*)
+	#
+	# Using gcc.
+	#
+	#echo Using gcc
+
+	# Get gcc to share its secrets.
+	echo 'main() { return 0; }' > try.c
+	verbose=`${cc:-cc} -v -o try try.c 2>&1`
+	rm -f try try.c
+	tmp=`echo "$verbose" | grep '^Reading' |
+		awk '{print $NF}'  | sed 's/specs$/include/'`
+
+	# Determine if the fixed-includes look like they'll work.
+	# Doesn't work anymore for gcc-2.7.2.
+
+	# See if as(1) is GNU as(1).  GNU as(1) won't work for this job.
+	case $verbose in
+	*/usr/ccs/bin/as*) ;;
+	*)
+	    cat <<END
+
+NOTE: You are using GNU as(1).  GNU as(1) will not build Perl.
+You must arrange to use /usr/ccs/bin/as, perhaps by setting
+GCC_EXEC_PREFIX or by including -B/usr/ccs/bin in your cc command.
+
+END
+	;;
+	esac
+
+	# See if ld(1) is GNU ld(1).  GNU ld(1) won't work for this job.
+	case $verbose in
+	*/usr/ccs/bin/ld*) ;;
+	*)
+	    cat <<END
+
+NOTE: You are using GNU ld(1).  GNU ld(1) will not build Perl.
+You must arrange to use /usr/ccs/bin/ld, perhaps by setting
+GCC_EXEC_PREFIX or by including -B/usr/ccs/bin in your cc command.
+
+END
+	;;
+	esac
+
+	;; #using gcc
+*)
+	#
+	# Not using gcc.
+	#
+	#echo Not using gcc
+
+	# See if as(1) is GNU as(1).  GNU as(1) won't work for this job.
+	case `as --version < /dev/null 2>&1` in
+	*GNU*)
+		cat <<END
+
+NOTE: You are using GNU as(1).  GNU as(1) will not build Perl.
+You must arrange to use /usr/ccs/bin, perhaps by adding it to the
+beginning of your PATH.
+
+END
+		;;
+	esac
+
+	# See if ld(1) is GNU ld(1).  GNU ld(1) won't work for this job.
+	case `ld --version < /dev/null 2>&1` in
+	*GNU*)
+		cat <<END
+
+NOTE: You are using GNU ld(1).  GNU ld(1) will not build Perl.
+You must arrange to use /usr/ccs/bin, perhaps by adding it to the
+beginning of your PATH
+
+END
+		;;
+	esac
+
+	;; #not using gcc
+esac
+
+# as --version or ld --version might dump core.
+rm -f core
+
+# This is just a trick to include some useful notes.
+cat > /dev/null <<'End_of_Solaris_Notes'
+
+Here are some notes kindly contributed by Dean Roehrich.
+
+-----
+Generic notes about building Perl5 on Solaris:
+- Use /usr/ccs/bin/make.
+- If you use GNU make, remove its setgid bit.
+- Remove all instances of *ucb* from your path.
+- Make sure libucb is not in /usr/lib (it should be in /usr/ucblib).
+- Do not use GNU as or GNU ld, or any of GNU binutils or GNU libc.
+- Do not use /usr/ucb/cc.
+- Do not change Configure's default answers, except for the path names.
+- Do not use -lmalloc.
+- Do not build on SunOS 4 and expect it to work properly on SunOS 5.
+- /dev/fd must be mounted if you want set-uid scripts to work.
+
+
+Here are the gcc-related questions and answers from the Solaris 2 FAQ.  Note
+the themes:
+	- run fixincludes
+	- run fixincludes correctly
+	- don't use GNU as or GNU ld
+
+Question 5.7 covers the __builtin_va_alist problem people are always seeing.
+Question 6.1.3 covers the GNU as and GNU ld issues which are always biting
+people.
+Question 6.9 is for those who are still trying to compile Perl4.
+
+The latest Solaris 2 FAQ can be found in the following locations:
+	rtfm.mit.edu:/pub/usenet-by-group/comp.sys.sun.admin
+	ftp.fwi.uva.nl:/pub/solaris
+
+Perl5 comes with a script in the top-level directory called "myconfig" which
+will print a summary of the configuration in your config.sh.  My summary for
+Solaris 2.4 and gcc 2.6.3 follows.  I have also built with gcc 2.7.0 and the
+results are identical.  This configuration was generated with Configure's -d
+option (take all defaults, don't bother prompting me).  All tests pass for
+Perl5.001, patch.1m.
+
+Summary of my perl5 (patchlevel 1) configuration:
+  Platform:
+    osname=solaris, osver=2.4, archname=sun4-solaris
+    uname='sunos poplar 5.4 generic_101945-27 sun4d sparc '
+    hint=recommended
+  Compiler:
+    cc='gcc', optimize='-O', ld='gcc'
+    cppflags=''
+    ccflags =''
+    ldflags =''
+    stdchar='unsigned char', d_stdstdio=define, usevfork=false
+    voidflags=15, castflags=0, d_casti32=define, d_castneg=define
+    intsize=4, alignbytes=8, usemymalloc=y, randbits=15
+  Libraries:
+    so=so
+    libpth=/lib /usr/lib /usr/ccs/lib /usr/local/lib
+    libs=-lsocket -lnsl -ldl -lm -lc -lcrypt
+    libc=/usr/lib/libc.so
+  Dynamic Linking:
+    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef
+    cccdlflags='-fpic', ccdlflags=' ', lddlflags='-G'
+
+
+Dean
+roehrich@cray.com
+9/7/95
+
+-----------
+
+From: Casper.Dik@Holland.Sun.COM (Casper H.S. Dik - Network Security Engineer)
+Subject: Solaris 2 Frequently Asked Questions (FAQ) 1.48
+Date: 25 Jul 1995 12:20:18 GMT
+
+5.7) Why do I get __builtin_va_alist or __builtin_va_arg_incr undefined?
+
+    You're using gcc without properly installing the gcc fixed
+    include files.  Or you ran fixincludes after installing gcc
+    w/o moving the gcc supplied varargs.h and stdarg.h files
+    out of the way and moving them back again later.  This often
+    happens when people install gcc from a binary distribution.
+    If there's a tmp directory in gcc's include directory, fixincludes
+    didn't complete.  You should have run "just-fixinc" instead.
+
+    Another possible cause is using ``gcc -I/usr/include.''
+
+6.1) Where is the C compiler or where can I get one?
+
+    [...]
+
+    3) Gcc.
+
+    Gcc is available from the GNU archives in source and binary
+    form.  Look in a directory called sparc-sun-solaris2 for
+    binaries.  You need gcc 2.3.3 or later.  You should not use
+    GNU as or GNU ld.  Make sure you run just-fixinc if you use
+    a binary distribution.  Better is to get a binary version and
+    use that to bootstrap gcc from source.
+
+    [...]
+
+    When you install gcc, don't make the mistake of installing
+    GNU binutils or GNU libc, they are not as capable as their
+    counterparts you get with Solaris 2.x.
+
+6.9) I can't get perl 4.036 to compile or run.
+
+    Run Configure, and use the solaris_2_0 hints, *don't* use
+    the solaris_2_1 hints and don't use the config.sh you may
+    already have.  First you must make sure Configure and make
+    don't find /usr/ucb/cc.  (It must use gcc or the native C
+    compiler: /opt/SUNWspro/bin/cc)
+
+    Some questions need a special answer.
+
+    Are your system (especially dbm) libraries compiled with gcc? [y] y
+
+    yes: gcc 2.3.3 or later uses the standard calling
+    conventions, same as Sun's C.
+
+    Any additional cc flags? [ -traditional -Dvolatile=__volatile__
+    -I/usr/ucbinclude] -traditional -Dvolatile=__volatile__
+    Remove /usr/ucbinclude.
+
+    Any additional libraries? [-lsocket -lnsl -ldbm -lmalloc -lm
+    -lucb] -lsocket -lnsl  -lm
+
+    Don't include -ldbm, -lmalloc and -lucb.
+
+    Perl 5 compiled out of the box.
+
+End_of_Solaris_Notes
+
diff --git a/gnu/usr.bin/perl/hints/stellar.sh b/gnu/usr.bin/perl/hints/stellar.sh
new file mode 100644
index 00000000000..23e15e90912
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/stellar.sh
@@ -0,0 +1,2 @@
+optimize="-O0"
+ccflags="$ccflags -nw"
diff --git a/gnu/usr.bin/perl/hints/sunos_4_0.sh b/gnu/usr.bin/perl/hints/sunos_4_0.sh
new file mode 100644
index 00000000000..99fce3f44b4
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sunos_4_0.sh
@@ -0,0 +1 @@
+ccflags="$ccflags -DFPUTS_BOTCH"
diff --git a/gnu/usr.bin/perl/hints/sunos_4_1.sh b/gnu/usr.bin/perl/hints/sunos_4_1.sh
new file mode 100644
index 00000000000..ee42e2c448c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/sunos_4_1.sh
@@ -0,0 +1,27 @@
+# hints/sunos_4_1.sh
+# Last modified:  Thu Feb  8 11:46:05 EST 1996
+# Andy Dougherty  <doughera@lafcol.lafayette.edu>
+
+case "$cc" in
+*gcc*)	usevfork=false ;;
+*)	usevfork=true ;;
+esac
+
+# Configure will issue a WHOA warning.  The problem is that
+# Configure finds getzname, not tzname.  If you're in the System V
+# environment, you can set d_tzname='define' since tzname[] is
+# available in the System V environment.
+d_tzname='undef'
+
+# SunOS 4.1.3 has two extra fields in struct tm.  This works around
+# the problem.  Other BSD platforms may have similar problems.
+POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
+
+# check if user is in a bsd or system 5 type environment
+if cat -b /dev/null 2>/dev/null
+then # bsd
+      groupstype='int'
+else # sys5
+      groupstype='gid_t'
+fi
+ 
diff --git a/gnu/usr.bin/perl/hints/svr4.sh b/gnu/usr.bin/perl/hints/svr4.sh
new file mode 100644
index 00000000000..5569274753c
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/svr4.sh
@@ -0,0 +1,43 @@
+# svr4 hints, System V Release 4.x
+# Last modified 1995/01/28 by Tye McQueen, tye@metronet.com
+# Use Configure -Dcc=gcc to use gcc.
+case "$cc" in
+'') cc='/bin/cc'
+    test -f $cc || cc='/usr/ccs/bin/cc'
+    ;;
+esac
+# We include support for using libraries in /usr/ucblib, but the setting
+# of libswanted excludes some libraries found there.  You may want to
+# prevent "ucb" from being removed from libswanted and see if perl will
+# build on your system.
+ldflags='-L/usr/ccs/lib -L/usr/ucblib'
+ccflags='-I/usr/include -I/usr/ucbinclude'
+# Don't use problematic libraries:
+libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'`
+# libmalloc.a - Probably using Perl's malloc() anyway.
+# libucb.a - Remove it if you have problems ld'ing.  We include it because
+#   it is needed for ODBM_File and NDBM_File extensions.
+if [ -r /usr/ucblib/libucb.a ]; then	# If using BSD-compat. library:
+    d_gconvert='undef'	# Unusuable under UnixWare 1.1 [use gcvt() instead]
+    # Use the "native" counterparts, not the BSD emulation stuff:
+    d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef'
+    d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef'
+    d_setlinebuf='undef' d_setregid='undef' d_setreuid='undef'
+fi
+d_suidsafe='define'	# "./Configure -d" can't figure this out easilly
+usevfork='false'
+
+# Configure may fail to find lstat() since it's a static/inline
+# function in <sys/stat.h> on Unisys U6000 SVR4, and possibly
+# other SVR4 derivatives.
+d_lstat=define
+
+cat <<'EOM' >&4
+
+If you wish to use dynamic linking, you must use 
+	LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH
+or
+	setenv LD_LIBRARY_PATH `pwd`
+before running make.
+
+EOM
diff --git a/gnu/usr.bin/perl/hints/ti1500.sh b/gnu/usr.bin/perl/hints/ti1500.sh
new file mode 100644
index 00000000000..69482d86802
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/ti1500.sh
@@ -0,0 +1 @@
+usemymalloc='n'
diff --git a/gnu/usr.bin/perl/hints/titanos.sh b/gnu/usr.bin/perl/hints/titanos.sh
new file mode 100644
index 00000000000..0f382ac0ff9
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/titanos.sh
@@ -0,0 +1,40 @@
+# Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines.
+# Created by: JT McDuffie (jt@kpc.com)  26 DEC 1991
+# p5ed by: Jarkko Hietaniemi <jhi@hut.fi> Aug 27 1994
+#  NOTE:   You should run Configure with tcsh (yes, tcsh).
+# Comments by Andy Dougherty <doughera@lafcol.lafayette.edu> 28 Mar 1995
+alignbytes="8"
+byteorder="4321"
+castflags='0'
+gidtype='ushort'
+groupstype='unsigned short'
+intsize='4'
+usenm='true'
+nm_opt='-eh'
+malloctype='void *'
+models='none'
+ccflags="$ccflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C"
+cppflags="$cppflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C"
+stdchar='unsigned char'
+#
+# Apparently there are some harmful libs in Configure's $libswanted.
+# Perl5.000 had: libs='-lnsl -ldbm -lPW -lmalloc -lm'
+# Unfortunately, this line prevents users from including things like
+# -lgdbm and -ldb, which they may or may not have or want.
+# We should probably fiddle with libswanted instead of libs.
+# And even there, we should only bother to delete harmful libraries.
+# However, I don't know what they are or why they should be deleted,
+# so this will have to do for now.  --AD  28 Mar 1995
+libswanted='nsl dbm gdbm db PW malloc m'
+#
+# Extensions:  This system can not compile POSIX. We'll let Configure 
+# figure out the others.  Certainly Fcntl, Socket, and at least one *DB*
+# extension should be included.
+# perl5.000 had:  static_ext='DynaLoader NDBM_File Socket'
+useposix='n'
+#
+uidtype='ushort'
+voidflags='7'
+inclwanted='/usr/include /usr/include/net'
+libpth='/usr/lib /usr/local/lib /lib'
+pth='. /bin /usr/bin /usr/ucb /usr/local/bin /usr/X11/bin /usr/lbin /etc /usr/lib'
diff --git a/gnu/usr.bin/perl/hints/ultrix_4.sh b/gnu/usr.bin/perl/hints/ultrix_4.sh
new file mode 100644
index 00000000000..e00450792dc
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/ultrix_4.sh
@@ -0,0 +1,53 @@
+# hints/ultrix_4.sh
+# Last updated by Andy Dougherty  <doughera@lafcol.lafayette.edu>
+# Fri Feb 10 10:04:51 EST 1995
+#
+# Use   Configure -Dcc=gcc   to use gcc.
+#
+# I don't know if -g is really needed.  (AD)
+case "$optimize" in
+'') optimize=-g ;;
+esac
+
+# Some users have reported Configure runs *much* faster if you 
+# replace all occurences of /bin/sh by /bin/sh5
+# Something like:
+#   sed 's!/bin/sh!/bin/sh5!g' Configure > Configure.sh5
+# Then run "sh5 Configure.sh5 [your options]"
+
+case "$myuname" in
+*risc*) cat <<EOF
+Note that there is a bug in some versions of NFS on the DECStation that
+may cause utime() to work incorrectly.  If so, regression test io/fs
+may fail if run under NFS.  Ignore the failure.
+EOF
+esac
+
+# Compiler flags that depend on osversion:
+case "$cc" in
+*gcc*) ;;
+*)
+    case "$osvers" in
+    *4.1*)	ccflags="$ccflags -DLANGUAGE_C -Olimit 2900" ;;
+    *4.2*)	ccflags="$ccflags -DLANGUAGE_C -Olimit 2900"
+		# Prototypes sometimes cause compilation errors in 4.2.
+		prototype=undef   
+		case "$myuname" in
+		*risc*)  d_volatile=undef ;;
+		esac
+		;;
+    *4.3*)	ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 2900" ;;
+    *)	ccflags="$ccflags -std -Olimit 2900" ;;
+    esac
+    ;;
+esac
+
+# Other settings that depend on $osvers:
+case "$osvers" in
+*4.1*)	;;
+*4.2*)	libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
+*4.3*)	;;
+*)	ranlib='ranlib' ;;
+esac
+
+groupstype='int'
diff --git a/gnu/usr.bin/perl/hints/unicos.sh b/gnu/usr.bin/perl/hints/unicos.sh
new file mode 100644
index 00000000000..272cb9b5d62
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/unicos.sh
@@ -0,0 +1,9 @@
+case `uname -r` in
+6.1*) shellflags="-m+65536" ;;
+esac
+ccflags="$ccflags -DHZ=__hertz"
+optimize="-O1"
+libswanted=m
+d_setregid='undef'
+d_setreuid='undef'
+
diff --git a/gnu/usr.bin/perl/hints/unisysdynix.sh b/gnu/usr.bin/perl/hints/unisysdynix.sh
new file mode 100644
index 00000000000..4251ba8d471
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/unisysdynix.sh
@@ -0,0 +1 @@
+d_waitpid=undef
diff --git a/gnu/usr.bin/perl/hints/utekv.sh b/gnu/usr.bin/perl/hints/utekv.sh
new file mode 100644
index 00000000000..ebc7809c601
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/utekv.sh
@@ -0,0 +1,12 @@
+# XD88/10 UTekV hints by Kaveh Ghazi (ghazi@caip.rutgers.edu)  2/11/92
+# Modified by Andy Dougherty <doughera@lafcol.lafayette.edu>   4 Oct. 1994
+
+# The -X18 is only if you are using the Greenhills compiler.
+ccflags="$ccflags -X18"
+
+usemymalloc='y'
+
+echo " "
+echo "NOTE: You may have to take out makefile dependencies on the files in"
+echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail.  A"
+echo "simple 'grep -v /usr/include/ makefile' should suffice."
diff --git a/gnu/usr.bin/perl/hints/uts.sh b/gnu/usr.bin/perl/hints/uts.sh
new file mode 100644
index 00000000000..9ad72d7e987
--- /dev/null
+++ b/gnu/usr.bin/perl/hints/uts.sh
@@ -0,0 +1,2 @@
+ccflags="$ccflags -DCRIPPLED_CC"
+d_lstat=define
diff --git a/gnu/usr.bin/perl/hv.c b/gnu/usr.bin/perl/hv.c
new file mode 100644
index 00000000000..d9cbe52337f
--- /dev/null
+++ b/gnu/usr.bin/perl/hv.c
@@ -0,0 +1,610 @@
+/*    hv.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "I sit beside the fire and think of all that I have seen."  --Bilbo
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static void hsplit _((HV *hv));
+static void hfreeentries _((HV *hv));
+
+static HE* more_he();
+
+static HE*
+new_he()
+{
+    HE* he;
+    if (he_root) {
+        he = he_root;
+        he_root = (HE*)he->hent_next;
+        return he;
+    }
+    return more_he();
+}
+
+static void
+del_he(p)
+HE* p;
+{
+    p->hent_next = (HE*)he_root;
+    he_root = p;
+}
+
+static HE*
+more_he()
+{
+    register HE* he;
+    register HE* heend;
+    he_root = (HE*)safemalloc(1008);
+    he = he_root;
+    heend = &he[1008 / sizeof(HE) - 1];
+    while (he < heend) {
+        he->hent_next = (HE*)(he + 1);
+        he++;
+    }
+    he->hent_next = 0;
+    return new_he();
+}
+
+SV**
+hv_fetch(hv,key,klen,lval)
+HV *hv;
+char *key;
+U32 klen;
+I32 lval;
+{
+    register XPVHV* xhv;
+    register char *s;
+    register I32 i;
+    register I32 hash;
+    register HE *entry;
+    SV *sv;
+
+    if (!hv)
+	return 0;
+
+    if (SvRMAGICAL(hv)) {
+	if (mg_find((SV*)hv,'P')) {
+	    sv = sv_newmortal();
+	    mg_copy((SV*)hv, sv, key, klen);
+	    Sv = sv;
+	    return &Sv;
+	}
+    }
+
+    xhv = (XPVHV*)SvANY(hv);
+    if (!xhv->xhv_array) {
+	if (lval 
+#ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
+	         || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
+#endif
+	                                                          )
+	    Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+	else
+	    return 0;
+    }
+
+    i = klen;
+    hash = 0;
+    s = key;
+    while (i--)
+	hash = hash * 33 + *s++;
+
+    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    for (; entry; entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	return &entry->hent_val;
+    }
+#ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
+    if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
+      char *gotenv;
+
+      gotenv = my_getenv(key);
+      if (gotenv != NULL) {
+        sv = newSVpv(gotenv,strlen(gotenv));
+        return hv_store(hv,key,klen,sv,hash);
+      }
+    }
+#endif
+    if (lval) {		/* gonna assign to this, so it better be there */
+	sv = NEWSV(61,0);
+	return hv_store(hv,key,klen,sv,hash);
+    }
+    return 0;
+}
+
+SV**
+hv_store(hv,key,klen,val,hash)
+HV *hv;
+char *key;
+U32 klen;
+SV *val;
+register U32 hash;
+{
+    register XPVHV* xhv;
+    register char *s;
+    register I32 i;
+    register HE *entry;
+    register HE **oentry;
+
+    if (!hv)
+	return 0;
+
+    xhv = (XPVHV*)SvANY(hv);
+    if (SvMAGICAL(hv)) {
+	mg_copy((SV*)hv, val, key, klen);
+#ifndef OVERLOAD
+	if (!xhv->xhv_array)
+	    return 0;
+#else
+	if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
+				|| SvMAGIC(hv)->mg_moremagic))
+	  return 0;
+#endif /* OVERLOAD */
+    }
+    if (!hash) {
+    i = klen;
+    s = key;
+    while (i--)
+	hash = hash * 33 + *s++;
+    }
+
+    if (!xhv->xhv_array)
+	Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
+
+    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    i = 1;
+
+    for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	SvREFCNT_dec(entry->hent_val);
+	entry->hent_val = val;
+	return &entry->hent_val;
+    }
+
+    entry = new_he();
+    entry->hent_klen = klen;
+    entry->hent_key = savepvn(key,klen);
+    entry->hent_val = val;
+    entry->hent_hash = hash;
+    entry->hent_next = *oentry;
+    *oentry = entry;
+
+    xhv->xhv_keys++;
+    if (i) {				/* initial entry? */
+	++xhv->xhv_fill;
+	if (xhv->xhv_keys > xhv->xhv_max)
+	    hsplit(hv);
+    }
+
+    return &entry->hent_val;
+}
+
+SV *
+hv_delete(hv,key,klen,flags)
+HV *hv;
+char *key;
+U32 klen;
+I32 flags;
+{
+    register XPVHV* xhv;
+    register char *s;
+    register I32 i;
+    register I32 hash;
+    register HE *entry;
+    register HE **oentry;
+    SV *sv;
+
+    if (!hv)
+	return Nullsv;
+    if (SvRMAGICAL(hv)) {
+	sv = *hv_fetch(hv, key, klen, TRUE);
+	mg_clear(sv);
+	if (mg_find(sv, 'p')) {
+	    sv_unmagic(sv, 'p');	/* No longer an element */
+	    return sv;
+	}
+    }
+    xhv = (XPVHV*)SvANY(hv);
+    if (!xhv->xhv_array)
+	return Nullsv;
+    i = klen;
+    hash = 0;
+    s = key;
+    while (i--)
+	hash = hash * 33 + *s++;
+
+    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    entry = *oentry;
+    i = 1;
+    for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	*oentry = entry->hent_next;
+	if (i && !*oentry)
+	    xhv->xhv_fill--;
+	if (flags & G_DISCARD)
+	    sv = Nullsv;
+	else
+	    sv = sv_mortalcopy(entry->hent_val);
+	if (entry == xhv->xhv_eiter)
+	    entry->hent_klen = -1;
+	else
+	    he_free(entry);
+	--xhv->xhv_keys;
+	return sv;
+    }
+    return Nullsv;
+}
+
+bool
+hv_exists(hv,key,klen)
+HV *hv;
+char *key;
+U32 klen;
+{
+    register XPVHV* xhv;
+    register char *s;
+    register I32 i;
+    register I32 hash;
+    register HE *entry;
+    SV *sv;
+
+    if (!hv)
+	return 0;
+
+    if (SvRMAGICAL(hv)) {
+	if (mg_find((SV*)hv,'P')) {
+	    sv = sv_newmortal();
+	    mg_copy((SV*)hv, sv, key, klen); 
+	    magic_existspack(sv, mg_find(sv, 'p'));
+	    return SvTRUE(sv);
+	}
+    }
+
+    xhv = (XPVHV*)SvANY(hv);
+    if (!xhv->xhv_array)
+	return 0; 
+
+    i = klen;
+    hash = 0;
+    s = key;
+    while (i--)
+	hash = hash * 33 + *s++;
+
+    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    for (; entry; entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (entry->hent_klen != klen)
+	    continue;
+	if (bcmp(entry->hent_key,key,klen))	/* is this it? */
+	    continue;
+	return TRUE;
+    }
+    return FALSE;
+}
+
+static void
+hsplit(hv)
+HV *hv;
+{
+    register XPVHV* xhv = (XPVHV*)SvANY(hv);
+    I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
+    register I32 newsize = oldsize * 2;
+    register I32 i;
+    register HE **a;
+    register HE **b;
+    register HE *entry;
+    register HE **oentry;
+#ifndef STRANGE_MALLOC
+    I32 tmp;
+#endif
+
+    a = (HE**)xhv->xhv_array;
+    nomemok = TRUE;
+#ifdef STRANGE_MALLOC
+    Renew(a, newsize, HE*);
+#else
+    i = newsize * sizeof(HE*);
+#define MALLOC_OVERHEAD 16
+    tmp = MALLOC_OVERHEAD;
+    while (tmp - MALLOC_OVERHEAD < i)
+	tmp += tmp;
+    tmp -= MALLOC_OVERHEAD;
+    tmp /= sizeof(HE*);
+    assert(tmp >= newsize);
+    New(2,a, tmp, HE*);
+    Copy(xhv->xhv_array, a, oldsize, HE*);
+    if (oldsize >= 64 && !nice_chunk) {
+	nice_chunk = (char*)xhv->xhv_array;
+	nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
+    }
+    else
+	Safefree(xhv->xhv_array);
+#endif
+
+    nomemok = FALSE;
+    Zero(&a[oldsize], oldsize, HE*);		/* zero 2nd half*/
+    xhv->xhv_max = --newsize;
+    xhv->xhv_array = (char*)a;
+
+    for (i=0; i<oldsize; i++,a++) {
+	if (!*a)				/* non-existent */
+	    continue;
+	b = a+oldsize;
+	for (oentry = a, entry = *a; entry; entry = *oentry) {
+	    if ((entry->hent_hash & newsize) != i) {
+		*oentry = entry->hent_next;
+		entry->hent_next = *b;
+		if (!*b)
+		    xhv->xhv_fill++;
+		*b = entry;
+		continue;
+	    }
+	    else
+		oentry = &entry->hent_next;
+	}
+	if (!*a)				/* everything moved */
+	    xhv->xhv_fill--;
+    }
+}
+
+HV *
+newHV()
+{
+    register HV *hv;
+    register XPVHV* xhv;
+
+    hv = (HV*)NEWSV(502,0);
+    sv_upgrade((SV *)hv, SVt_PVHV);
+    xhv = (XPVHV*)SvANY(hv);
+    SvPOK_off(hv);
+    SvNOK_off(hv);
+    xhv->xhv_max = 7;		/* start with 8 buckets */
+    xhv->xhv_fill = 0;
+    xhv->xhv_pmroot = 0;
+    (void)hv_iterinit(hv);	/* so each() will start off right */
+    return hv;
+}
+
+void
+he_free(hent)
+register HE *hent;
+{
+    if (!hent)
+	return;
+    SvREFCNT_dec(hent->hent_val);
+    Safefree(hent->hent_key);
+    del_he(hent);
+}
+
+void
+he_delayfree(hent)
+register HE *hent;
+{
+    if (!hent)
+	return;
+    sv_2mortal(hent->hent_val);	/* free between statements */
+    Safefree(hent->hent_key);
+    del_he(hent);
+}
+
+void
+hv_clear(hv)
+HV *hv;
+{
+    register XPVHV* xhv;
+    if (!hv)
+	return;
+    xhv = (XPVHV*)SvANY(hv);
+    hfreeentries(hv);
+    xhv->xhv_fill = 0;
+    xhv->xhv_keys = 0;
+    if (xhv->xhv_array)
+	(void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
+
+    if (SvRMAGICAL(hv))
+	mg_clear((SV*)hv); 
+}
+
+static void
+hfreeentries(hv)
+HV *hv;
+{
+    register HE **array;
+    register HE *hent;
+    register HE *ohent = Null(HE*);
+    I32 riter;
+    I32 max;
+
+    if (!hv)
+	return;
+    if (!HvARRAY(hv))
+	return;
+
+    riter = 0;
+    max = HvMAX(hv);
+    array = HvARRAY(hv);
+    hent = array[0];
+    for (;;) {
+	if (hent) {
+	    ohent = hent;
+	    hent = hent->hent_next;
+	    he_free(ohent);
+	}
+	if (!hent) {
+	    if (++riter > max)
+		break;
+	    hent = array[riter];
+	} 
+    }
+    (void)hv_iterinit(hv);
+}
+
+void
+hv_undef(hv)
+HV *hv;
+{
+    register XPVHV* xhv;
+    if (!hv)
+	return;
+    xhv = (XPVHV*)SvANY(hv);
+    hfreeentries(hv);
+    Safefree(xhv->xhv_array);
+    if (HvNAME(hv)) {
+	Safefree(HvNAME(hv));
+	HvNAME(hv) = 0;
+    }
+    xhv->xhv_array = 0;
+    xhv->xhv_max = 7;		/* it's a normal associative array */
+    xhv->xhv_fill = 0;
+    xhv->xhv_keys = 0;
+
+    if (SvRMAGICAL(hv))
+	mg_clear((SV*)hv); 
+}
+
+I32
+hv_iterinit(hv)
+HV *hv;
+{
+    register XPVHV* xhv = (XPVHV*)SvANY(hv);
+    HE *entry = xhv->xhv_eiter;
+    if (entry && entry->hent_klen < 0)	/* was deleted earlier? */
+	he_free(entry);
+    xhv->xhv_riter = -1;
+    xhv->xhv_eiter = Null(HE*);
+    return xhv->xhv_fill;
+}
+
+HE *
+hv_iternext(hv)
+HV *hv;
+{
+    register XPVHV* xhv;
+    register HE *entry;
+    HE *oldentry;
+    MAGIC* mg;
+
+    if (!hv)
+	croak("Bad associative array");
+    xhv = (XPVHV*)SvANY(hv);
+    oldentry = entry = xhv->xhv_eiter;
+
+    if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
+	SV *key = sv_newmortal();
+	if (entry) {
+	    sv_usepvn(key, entry->hent_key, entry->hent_klen);
+	    entry->hent_key = 0;
+	}
+	else {
+	    xhv->xhv_eiter = entry = new_he();
+	    Zero(entry, 1, HE);
+	}
+	magic_nextpack((SV*) hv,mg,key);
+        if (SvOK(key)) {
+	    STRLEN len;
+	    entry->hent_key = SvPV_force(key, len);
+	    entry->hent_klen = len;
+	    SvPOK_off(key);
+	    SvPVX(key) = 0;
+	    return entry;
+        }
+	if (entry->hent_val)
+	    SvREFCNT_dec(entry->hent_val);
+	del_he(entry);
+	xhv->xhv_eiter = Null(HE*);
+	return Null(HE*);
+    }
+
+    if (!xhv->xhv_array)
+	Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
+    do {
+	if (entry)
+	    entry = entry->hent_next;
+	if (!entry) {
+	    ++xhv->xhv_riter;
+	    if (xhv->xhv_riter > xhv->xhv_max) {
+		xhv->xhv_riter = -1;
+		break;
+	    }
+	    entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+	}
+    } while (!entry);
+
+    if (oldentry && oldentry->hent_klen < 0)	/* was deleted earlier? */
+	he_free(oldentry);
+
+    xhv->xhv_eiter = entry;
+    return entry;
+}
+
+char *
+hv_iterkey(entry,retlen)
+register HE *entry;
+I32 *retlen;
+{
+    *retlen = entry->hent_klen;
+    return entry->hent_key;
+}
+
+SV *
+hv_iterval(hv,entry)
+HV *hv;
+register HE *entry;
+{
+    if (SvRMAGICAL(hv)) {
+	if (mg_find((SV*)hv,'P')) {
+	    SV* sv = sv_newmortal();
+	    mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
+	    return sv;
+	}
+    }
+    return entry->hent_val;
+}
+
+SV *
+hv_iternextsv(hv, key, retlen)
+    HV *hv;
+    char **key;
+    I32 *retlen;
+{
+    HE *he;
+    if ( (he = hv_iternext(hv)) == NULL)
+	return NULL;
+    *key = hv_iterkey(he, retlen);
+    return hv_iterval(hv, he);
+}
+
+void
+hv_magic(hv, gv, how)
+HV* hv;
+GV* gv;
+int how;
+{
+    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
+}
diff --git a/gnu/usr.bin/perl/hv.h b/gnu/usr.bin/perl/hv.h
new file mode 100644
index 00000000000..49703632b86
--- /dev/null
+++ b/gnu/usr.bin/perl/hv.h
@@ -0,0 +1,60 @@
+/*    hv.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+typedef struct he HE;
+
+struct he {
+    HE		*hent_next;
+    char	*hent_key;
+    SV		*hent_val;
+    U32		hent_hash;
+    I32		hent_klen;
+};
+
+struct xpvhv {
+    char *	xhv_array;	/* pointer to malloced string */
+    STRLEN	xhv_fill;	/* how full xhv_array currently is */
+    STRLEN	xhv_max;	/* subscript of last element of xhv_array */
+    I32		xhv_keys;	/* how many elements in the array */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* magic for scalar array */
+    HV*		xmg_stash;	/* class package */
+
+    I32		xhv_riter;	/* current root of iterator */
+    HE		*xhv_eiter;	/* current entry of iterator */
+    PMOP	*xhv_pmroot;	/* list of pm's for this package */
+    char	*xhv_name;	/* name, if a symbol table */
+};
+
+#define Nullhv Null(HV*)
+#define HvARRAY(hv)	((HE**)((XPVHV*)  SvANY(hv))->xhv_array)
+#define HvFILL(hv)	((XPVHV*)  SvANY(hv))->xhv_fill
+#define HvMAX(hv)	((XPVHV*)  SvANY(hv))->xhv_max
+#define HvKEYS(hv)	((XPVHV*)  SvANY(hv))->xhv_keys
+#define HvRITER(hv)	((XPVHV*)  SvANY(hv))->xhv_riter
+#define HvEITER(hv)	((XPVHV*)  SvANY(hv))->xhv_eiter
+#define HvPMROOT(hv)	((XPVHV*)  SvANY(hv))->xhv_pmroot
+#define HvNAME(hv)	((XPVHV*)  SvANY(hv))->xhv_name
+
+#ifdef OVERLOAD
+
+/* Maybe amagical: */
+/* #define HV_AMAGICmb(hv)      (SvFLAGS(hv) & (SVpgv_badAM | SVpgv_AM)) */
+
+#define HV_AMAGIC(hv)        (SvFLAGS(hv) &   SVpgv_AM)
+#define HV_AMAGIC_on(hv)     (SvFLAGS(hv) |=  SVpgv_AM)
+#define HV_AMAGIC_off(hv)    (SvFLAGS(hv) &= ~SVpgv_AM)
+
+/*
+#define HV_AMAGICbad(hv)     (SvFLAGS(hv) & SVpgv_badAM)
+#define HV_badAMAGIC_on(hv)  (SvFLAGS(hv) |= SVpgv_badAM)
+#define HV_badAMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_badAM)
+*/
+
+#endif /* OVERLOAD */
diff --git a/gnu/usr.bin/perl/installman b/gnu/usr.bin/perl/installman
new file mode 100644
index 00000000000..38bd0af10e8
--- /dev/null
+++ b/gnu/usr.bin/perl/installman
@@ -0,0 +1,205 @@
+#!./perl
+BEGIN { @INC = ('lib') }
+use Config;
+use Getopt::Long;
+use File::Find;
+use File::Path qw(mkpath);
+use subs qw(unlink chmod rename link);
+require Cwd;
+
+umask 022;
+$ENV{SHELL} = 'sh' if $^O eq 'os2';
+
+$ver = $];
+$release = substr($ver,0,3);   # Not used presently.
+$patchlevel = substr($ver,3,2);
+die "Patchlevel of perl ($patchlevel)",
+    "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
+	if $patchlevel != $Config{'PATCHLEVEL'};
+
+$usage =
+"Usage:  installman --man1dir=/usr/wherever --man1ext=1
+                    --man3dir=/usr/wherever --man3ext=3
+		    --notify --help
+	Defaults are:
+	man1dir = $Config{'installman1dir'};
+	man1ext = $Config{'man1ext'};
+	man3dir = $Config{'installman3dir'};
+	man3ext = $Config{'man3ext'};
+	--notify (or -n) just lists commands that would be executed.\n";
+
+GetOptions( qw( man1dir=s man1ext=s man3dir=s man3ext=s notify n help)) 
+	|| die $usage;
+die $usage if $opt_help;
+
+# These are written funny to avoid -w typo warnings.
+$man1dir = defined($opt_man1dir) ? $opt_man1dir : $Config{'installman1dir'};
+$man1ext = defined($opt_man1ext) ? $opt_man1ext : $Config{'man1ext'};
+$man3dir = defined($opt_man3dir) ? $opt_man3dir : $Config{'installman3dir'};
+$man3ext = defined($opt_man3ext) ? $opt_man3ext : $Config{'man3ext'};
+
+$notify = $opt_notify || $opt_n;
+
+#Sanity checks
+
+-x  "./perl$Config{exe_ext}" 
+  or warn "./perl$Config{exe_ext} not found!  Have you run make?\n";
+-d  $Config{'installprivlib'}
+	|| warn "Perl library directory $Config{'installprivlib'} not found.
+		Have you run make install?.  (Installing anyway.)\n";
+-x "t/perl$Config{exe_ext}"		|| warn "WARNING: You've never run 'make test'!!!",
+	"  (Installing anyway.)\n";
+
+# Install the main pod pages.
+runpod2man('pod', $man1dir, $man1ext);
+
+# Install the pods for library modules.
+runpod2man('lib', $man3dir, $man3ext);
+
+sub runpod2man {
+    my($poddir, $mandir, $manext) = @_;
+    my($builddir) = Cwd::getcwd();
+
+    if ($mandir eq ' ' or $mandir eq '') {
+	print STDERR "Skipping installation of $poddir man pages.\n";
+	return;
+    }
+
+    chdir $poddir || die "Unable to cd to $poddir directory!\n$!\n";
+
+    # We insist on using the current version of pod2man in case there
+    # are enhancements or changes from previous installed versions.
+    # The error message doesn't include the '..' because the user
+    # won't be aware that we've chdir to $poddir.
+    -r  "../pod/pod2man" || die "Executable pod/pod2man not found.\n";
+
+    # We want to be sure to use the current perl.  We can't rely on
+    # the installed perl because it might not be actually installed
+    # yet. (The user may have set the $install* Configure variables 
+    # to point to some temporary home, from which the executable gets
+    # installed by occult means.)
+    $pod2man = "../perl -I ../lib ../pod/pod2man --section=$manext --official";
+
+    mkpath($mandir, 1, 0777);  # In File::Path
+    # Make a list of all the .pm and .pod files in the directory.  We will
+    # always run pod2man from the lib directory and feed it the full pathname
+    # of the pod.  This might be useful for pod2man someday.
+    @modpods = ();
+    find(\&lsmodpods, '.');
+    foreach $mod (@modpods) {
+	$manpage = $mod;
+	my $tmp;
+	# Skip .pm files that have corresponding .pod files, and Functions.pm.
+	next if (($tmp = $mod) =~ s/\.pm$/.pod/ && -f $tmp);
+	next if ($mod eq 'Pod/Functions.pm');	#### Used only by pod itself
+
+	# Convert name from  File/Basename.pm to File::Basename.3 format,
+	# if necessary.
+	$manpage =~ s#\.p(m|od)$##;
+	if ($^O eq 'os2') {
+	  $manpage =~ s#/#.#g;
+	} else {
+	  $manpage =~ s#/#::#g;
+	}
+	$tmp = "${mandir}/${manpage}.tmp";
+	$manpage = "${mandir}/${manpage}.${manext}";
+	if (&cmd("$pod2man $mod > $tmp") == 0 && !$notify && -s $tmp) {
+	    rename($tmp, $manpage) && next;
+	}
+	unless ($notify) {
+    unlink($tmp);
+	}
+    }
+    chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n";
+}
+
+sub lsmodpods {
+    my $dir  = $File::Find::dir;
+    my $name = $File::Find::name;
+    if (-f $_) {
+        $name =~ s#^\./##;
+	push(@modpods, $name) if ($name =~ /\.p(m|od)$/);
+    }
+}
+
+print STDERR "  Installation complete\n";
+
+exit 0;
+    
+
+###############################################################################
+# Utility subroutines from installperl
+
+sub cmd {
+    local($cmd) = @_;
+    print STDERR "  $cmd\n";
+    unless ($notify) {
+	if ($Config{d_fork}) {
+	    fork ? wait : exec $cmd;  # Allow user to ^C out of command.
+	}
+	else {
+	    system $cmd;
+	}
+	warn "Command failed!!\n" if $?;
+    }
+    return $? != 0;
+}
+
+sub unlink {
+    local(@names) = @_;
+    my $cnt = 0;
+
+    foreach $name (@names) {
+next unless -e $name;
+chmod 0777, $name if $^O eq 'os2';
+print STDERR "  unlink $name\n";
+( CORE::unlink($name) and ++$cnt 
+    or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
+    }
+    return $cnt;
+}
+
+sub link {
+    local($from,$to) = @_;
+
+    print STDERR "  ln $from $to\n";
+    eval { CORE::link($from,$to) }
+|| system('cp', $from, $to) == 0
+|| warn "Couldn't link $from to $to: $!\n" unless $notify;
+}
+
+sub rename {
+    local($from,$to) = @_;
+    if (-f $to and not unlink($to)) {
+my($i);
+for ($i = 1; $i < 50; $i++) {
+    last if CORE::rename($to, "$to.$i");
+}
+warn("Cannot rename to `$to.$i': $!"), return 0 
+    if $i >= 50;	# Give up!
+    }
+    link($from,$to) || return 0;
+    unlink($from);
+}
+
+sub chmod {
+    local($mode,$name) = @_;
+
+    printf STDERR "  chmod %o %s\n", $mode, $name;
+    CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
+	unless $notify;
+}
+
+sub samepath {
+    local($p1, $p2) = @_;
+    local($dev1, $ino1, $dev2, $ino2);
+
+    if ($p1 ne $p2) {
+	($dev1, $ino1) = stat($p1);
+	($dev2, $ino2) = stat($p2);
+	($dev1 == $dev2 && $ino1 == $ino2);
+    }
+    else {
+	1;
+    }
+}
diff --git a/gnu/usr.bin/perl/installperl b/gnu/usr.bin/perl/installperl
new file mode 100644
index 00000000000..bf8e6927eab
--- /dev/null
+++ b/gnu/usr.bin/perl/installperl
@@ -0,0 +1,421 @@
+#!./perl
+BEGIN { @INC=('./lib', '../lib') }
+use File::Find;
+use File::Path qw(mkpath);
+use Config;
+use subs qw(unlink rename link chmod);
+
+$mainperldir = "/usr/bin";
+$exe_ext = $Config{exe_ext};
+
+while (@ARGV) {
+    $nonono = 1 if $ARGV[0] eq '-n';
+    $versiononly = 1 if $ARGV[0] eq '-v';
+    shift;
+}
+
+umask 022;
+
+@scripts = qw(cppstdin
+		utils/c2ph utils/h2ph utils/h2xs utils/pstruct
+		utils/perlbug utils/perldoc
+		x2p/s2p x2p/find2perl
+		pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
+
+# pod documentation now handled by separate installman script.
+# These two are archaic leftovers.
+@manpages = qw(x2p/a2p.man x2p/s2p.man);
+
+@pods = (<pod/*.pod>);
+
+$ver = $];
+$release = substr($ver,0,3);   # Not used presently.
+$patchlevel = substr($ver,3,2);
+die "Patchlevel of perl ($patchlevel)",
+    "and patchlevel of config.sh ($Config{'PATCHLEVEL'}) don't match\n"
+	if $patchlevel != $Config{'PATCHLEVEL'};
+
+# Fetch some frequently-used items from %Config
+$installbin = $Config{installbin};
+$installscript = $Config{installscript};
+$installprivlib = $Config{installprivlib};
+$installarchlib = $Config{installarchlib};
+$installsitelib = $Config{installsitelib};
+$installsitearch = $Config{installsitearch};
+$installman1dir = $Config{installman1dir};
+$man1ext = $Config{man1ext};
+# Did we build libperl as a shared library?
+$d_shrplib = $Config{d_shrplib};
+$shrpdir = $Config{shrpdir};
+# Shared library and dynamic loading suffixes.
+$so = $Config{so};
+$dlext = $Config{dlext};
+
+$d_dosuid = $Config{d_dosuid};
+$binexp = $Config{binexp};
+
+# Do some quick sanity checks.
+
+if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
+
+   $installbin		|| die "No installbin directory in config.sh\n";
+-d $installbin		|| mkpath($installbin, 1, 0777);
+-d $installbin		|| die "$installbin is not a directory\n";
+-w $installbin		|| die "$installbin is not writable by you\n"
+	unless $installbin =~ m#^/afs/# || $nonono;
+
+-x 'perl' . $exe_ext	|| die "perl isn't executable!\n";
+-x 'suidperl' . $exe_ext|| die "suidperl isn't executable!\n" if $d_dosuid;
+
+-x 't/TEST'		|| warn "WARNING: You've never run 'make test'!!!",
+	"  (Installing anyway.)\n";
+
+if ($d_shrplib) {
+    if (!<libperl*.$so*>) {
+	warn "WARNING: Can't find libperl*.$so* to install into $shrpdir.",
+	    "  (Installing other things anyway.)\n";
+    } else {
+	mkpath($shrpdir, 1, 0777);
+	-w $shrpdir	|| $nonono || die "$shrpdir is not writable by you\n";
+	&cmd("cp libperl*.$so* $shrpdir");
+    }
+}
+
+# First we install the version-numbered executables.
+
+&safe_unlink("$installbin/perl$ver$exe_ext");
+&cmd("cp perl$exe_ext $installbin/perl$ver$exe_ext");
+
+&safe_unlink("$installbin/sperl$ver$exe_ext");
+if ($d_dosuid) {
+    &cmd("cp suidperl$exe_ext $installbin/sperl$ver$exe_ext");
+    &chmod(04711, "$installbin/sperl$ver$exe_ext");
+}
+
+exit 0 if $versiononly;
+
+# Make links to ordinary names if installbin directory isn't current directory.
+
+if (! &samepath($installbin, '.')) {
+    &safe_unlink("$installbin/perl$exe_ext", "$installbin/suidperl$exe_ext");
+    &link("$installbin/perl$ver$exe_ext", "$installbin/perl$exe_ext");
+    &link("$installbin/sperl$ver$exe_ext", "$installbin/suidperl$exe_ext") 
+      if $d_dosuid;
+}
+
+if (! &samepath($installbin, 'x2p')) {
+    &safe_unlink("$installbin/a2p$exe_ext");
+    &cmd("cp x2p/a2p$exe_ext $installbin/a2p$exe_ext");
+    &chmod(0755, "$installbin/a2p$exe_ext");
+}
+
+# Install scripts.
+
+mkpath($installscript, 1, 0777);
+
+for (@scripts) {
+    if (-f $_) {   # cppstdin might not exist on this system.
+	&cmd("cp $_ $installscript");
+	s#.*/##; &chmod(0755, "$installscript/$_");
+    }
+}
+
+# Install pod pages.  Where? I guess in $installprivlib/pod.
+mkpath("${installprivlib}/pod", 1, 0777);
+foreach $file (@pods) {
+    # $file is a name like  pod/perl.pod
+    cp_if_diff($file, "${installprivlib}/${file}");
+}
+
+# Install old man pages.
+
+if ($installman1dir ne '') {
+    mkpath($installman1dir, 1, 0777);
+
+    if (! &samepath($installman1dir, '.')) {
+	for (@manpages) {
+	    ($new = $_) =~ s/man$/$man1ext/;
+	    $new =~ s#.*/##;
+	    print STDERR "  Installing $installman1dir/$new\n";
+	    next if $nonono;
+	    open(MI,$_) || warn "Can't open $_: $!\n";
+	    open(MO,">$installman1dir/$new") || 
+		    warn "Can't install $installman1dir/$new: $!\n";
+	    print MO ".ds RP Release $release Patchlevel $patchlevel\n";
+	    while (<MI>) {
+		print MO;
+	    }
+	    close MI;
+	    close MO;
+	}
+    }
+}
+
+# Install library files.
+
+$do_installarchlib = $do_installprivlib = 0;
+    
+mkpath($installprivlib, 1, 0777);
+mkpath($installarchlib, 1, 0777);
+mkpath($installsitelib, 1, 0777) if ($installsitelib);
+mkpath($installsitearch, 1, 0777) if ($installsitearch);
+
+if (chdir "lib") {
+    $do_installarchlib = ! &samepath($installarchlib, '.');
+    $do_installprivlib = ! &samepath($installprivlib, '.');
+
+    if ($do_installarchlib || $do_installprivlib) {
+	find(\&installlib, '.');
+    }
+    chdir ".." || die "Can't cd back to source directory: $!\n";
+}
+else {
+    warn "Can't cd to lib to install lib files: $!\n";
+}
+
+# Install header files and libraries.
+mkpath("$installarchlib/CORE", 1, 0777);
+foreach $file (<*.h libperl*.*>) {
+    cp_if_diff($file,"$installarchlib/CORE/$file");
+    &chmod(0444,"$installarchlib/CORE/$file");
+}
+# AIX needs perl.exp installed as well.
+cp_if_diff("perl.exp" ,"$installarchlib/CORE/perl.exp") if ($^O eq 'aix');
+
+# If they have built sperl.o...
+cp_if_diff("sperl.o" ,"$installarchlib/CORE/sperl.o") if (-f 'sperl.o');
+
+
+# Offer to install perl in a "standard" location
+
+$mainperl_is_instperl = 0;
+
+if (-w $mainperldir && ! &samepath($mainperldir, $installbin) && !$nonono) {
+    # First make sure $mainperldir/perl is not already the same as
+    # the perl we just installed
+    if (-x "$mainperldir/perl$exe_ext") {
+	# Try to be clever about mainperl being a symbolic link
+	# to binexp/perl if binexp and installbin are different.
+	$mainperl_is_instperl =
+	    &samepath("$mainperldir/perl$exe_ext", "$installbin/perl$exe_ext") ||
+	     (($binexp ne $installbin) &&
+	      (-l "$mainperldir/perl$exe_ext") &&
+	      ((readlink "$mainperldir/perl$exe_ext") eq "$binexp/perl$exe_ext"));
+    }
+    if ((! $mainperl_is_instperl) &&
+	(&yn("Many scripts expect perl to be installed as " .
+	     "$mainperldir/perl.\n" . 
+	     "Do you wish to have $mainperldir/perl be the same as\n" .
+	     "$binexp/perl? [y] ")))
+    {	
+	unlink("$mainperldir/perl$exe_ext");
+	eval 'link("$installbin/perl$exe_ext", "$mainperldir/perl$exe_ext")' ||
+	eval 'symlink("$binexp/perl$exe_ext", "$mainperldir/perl$exe_ext")' ||
+	&cmd("cp $installbin/perl$exe_ext $mainperldir$exe_ext");
+	$mainperl_is_instperl = 1;
+    }
+}
+
+# Check to make sure there aren't other perls around in installer's
+# path.  This is probably UNIX-specific.  Check all absolute directories
+# in the path except for where public executables are supposed to live.
+# Also skip $mainperl if the user opted to have it be a link to the
+# installed perl.
+
+$dirsep = ($^O eq 'os2') ? ';' : ':' ;
+($path = $ENV{"PATH"}) =~ s:\\:/:g ;
+@path = split(/$dirsep/, $path);
+@otherperls = ();
+for (@path) {
+    next unless m,^/,;
+    next if ($_ eq $binexp);
+    # Use &samepath here because some systems have other dirs linked
+    # to $mainperldir (like SunOS)
+    next if ($mainperl_is_instperl && &samepath($_, $mainperldir));
+    push(@otherperls, "$_/perl$exe_ext")
+      if (-x "$_/perl$exe_ext" && ! -d "$_/perl$exe_ext");
+}
+if (@otherperls) {
+    print STDERR "\nWarning: perl appears in your path in the following " .
+	"locations beyond where\nwe just installed it:\n";
+    for (@otherperls) {
+	print STDERR "    ", $_, "\n";
+    }
+    print STDERR "\n";
+}
+
+print STDERR "  Installation complete\n";
+
+exit 0;
+
+###############################################################################
+
+sub yn {
+    local($prompt) = @_;
+    local($answer);
+    local($default) = $prompt =~ m/\[([yn])\]\s*$/i;
+    print STDERR $prompt;
+    chop($answer = <STDIN>);
+    $answer = $default if $answer =~ m/^\s*$/;
+    ($answer =~ m/^[yY]/);
+}
+
+sub unlink {
+    local(@names) = @_;
+    my($cnt) = 0;
+
+    foreach $name (@names) {
+	next unless -e $name;
+	chmod 0777, $name if $^O eq 'os2';
+	print STDERR "  unlink $name\n";
+	( CORE::unlink($name) and ++$cnt 
+	  or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
+    }
+    return $cnt;
+}
+
+sub safe_unlink {
+    local(@names) = @_;
+
+    foreach $name (@names) {
+	next unless -e $name;
+	next if $nonono;
+	chmod 0777, $name if $^O eq 'os2';
+	print STDERR "  unlink $name\n";
+	next if CORE::unlink($name);
+	warn "Couldn't unlink $name: $!\n";
+	if ($! =~ /busy/i) {
+	    print STDERR "  mv $name $name.old\n";
+	    &rename($name, "$name.old") || warn "Couldn't rename $name: $!\n";
+	}
+    }
+}
+
+sub cmd {
+    local($cmd) = @_;
+    print STDERR "  $cmd\n";
+    unless ($nonono) {
+	system $cmd;
+	warn "Command failed!!!\n" if $?;
+    }
+}
+
+sub rename {
+    local($from,$to) = @_;
+    if (-f $to and not unlink($to)) {
+	my($i);
+	for ($i = 1; $i < 50; $i++) {
+	    last if CORE::rename($to, "$to.$i");
+	}
+	warn("Cannot rename to `$to.$i': $!"), return 0 
+	   if $i >= 50;	# Give up!
+    }
+    link($from,$to) || return 0;
+    unlink($from);
+}
+
+sub link {
+    local($from,$to) = @_;
+
+    print STDERR "  ln $from $to\n";
+    eval {
+      CORE::link($from,$to) || warn "Couldn't link $from to $to: $!\n" unless $nonono;
+    };
+    if ($@) {
+      system( $cp, $from, $to )
+	&& warn "Couldn't copy $from to $to: $!\n" unless $nonono;
+    }
+}
+
+sub chmod {
+    local($mode,$name) = @_;
+
+    printf STDERR "  chmod %o %s\n", $mode, $name;
+    CORE::chmod($mode,$name) || warn sprintf("Couldn't chmod %o %s: $!\n",$mode,$name)
+	unless $nonono;
+}
+
+sub samepath {
+    local($p1, $p2) = @_;
+    local($dev1, $ino1, $dev2, $ino2);
+
+    if ($p1 ne $p2) {
+	($dev1, $ino1) = stat($p1);
+	($dev2, $ino2) = stat($p2);
+	($dev1 == $dev2 && $ino1 == $ino2);
+    }
+    else {
+	1;
+    }
+}
+
+sub installlib {
+    my $dir = $File::Find::dir;
+    $dir =~ s#^\.(?![^/])/?##;
+
+    my $name = $_;
+    
+    # ignore patch backups and the .exists files.
+    return if $name =~ m{\.orig$|~$|^\.exists};
+
+    $name = "$dir/$name" if $dir ne '';
+
+    my $installlib = $installprivlib;
+    if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) {
+        $installlib = $installarchlib;
+	return unless $do_installarchlib;
+    } else {
+	return unless $do_installprivlib;
+    }
+
+    if (-f $_) {
+	if (/\.al$/ || /\.ix$/) {
+	    $installlib = $installprivlib;
+	    #We're installing *.al and *.ix files into $installprivlib,
+	    #but we have to delete old *.al and *.ix files from the 5.000
+	    #distribution:
+	    #This might not work because $archname might have changed.
+	    &unlink("$installarchlib/$name");
+	}
+	system "cmp", "-s", $_, "$installlib/$name";
+	if ($?) {
+	    &unlink("$installlib/$name");
+	    mkpath("$installlib/$dir", 1, 0777);
+	    cp_if_diff($_, "$installlib/$name");
+	    # HP-UX (at least) needs to maintain execute permissions
+	    # on dynamically-loaded libraries.
+	    if ($name =~ /\.(so|$dlext)$/o) {
+		&chmod(0555, "$installlib/$name");
+	    }
+	    else {
+		&chmod(0444, "$installlib/$name");
+	    }
+	}
+    } elsif (-d $_) {
+	mkpath("$installlib/$name", 1, 0777);
+    }
+}
+
+# Copy $from to $to, only if $from is different than $to.
+# Also preserve modification times for .a libraries.
+# On some systems, if you do
+#   ranlib libperl.a
+#   cp libperl.a /usr/local/lib/perl5/archlib/CORE/libperl.a
+# and then try to link against the installed libperl.a, you might
+# get an error message to the effect that the symbol table is older
+# than the library.
+sub cp_if_diff {
+    my($from,$to)=@_;
+    -f $from || die "$0: $from not found";
+    system "cmp", "-s", $from, $to;
+    if ($?) {
+	my ($atime, $mtime);
+	unlink($to);   # In case we don't have write permissions.
+	cmd("cp $from $to");
+	# Restore timestamps if it's a .a library.
+	if ($to =~ /\.a$/) {
+	    ($atime, $mtime) = (stat $from)[8,9];
+	    utime $atime, $mtime, $to;
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/interp.sym b/gnu/usr.bin/perl/interp.sym
new file mode 100644
index 00000000000..801eb41fd9a
--- /dev/null
+++ b/gnu/usr.bin/perl/interp.sym
@@ -0,0 +1,151 @@
+Argv
+Cmd
+DBgv
+DBline
+DBsignal
+DBsingle
+DBsub
+DBtrace
+allgvs
+ampergv
+argvgv
+argvoutgv
+basetime
+beginav
+bodytarget
+cddir
+chopset
+copline
+curblock
+curcop
+curcsv
+curpm
+curstash
+curstname
+cxstack
+cxstack_ix
+cxstack_max
+dbargs
+debdelim
+debname
+debstash
+debug
+defgv
+defoutgv
+defstash
+delaymagic
+diehook
+dirty
+dlevel
+dlmax
+do_undump
+doextract
+doswitches
+dowarn
+dumplvl
+e_fp
+e_tmpname
+endav
+envgv
+errgv
+eval_root
+eval_start
+fdpid
+filemode
+firstgv
+forkprocess
+formfeed
+formtarget
+gensym
+in_eval
+incgv
+inplace
+last_in_gv
+lastfd
+lastretstr
+lastscream
+lastsize
+lastspbase
+laststatval
+laststype
+leftgv
+lineary
+localizing
+main_cv
+main_root
+main_start
+mainstack
+maxscream
+maxsysfd
+minus_F
+minus_a
+minus_c
+minus_l
+minus_n
+minus_p
+multiline
+mystack_base
+mystack_mark
+mystack_max
+mystack_sp
+mystrk
+nrs
+ofmt
+ofs
+ofslen
+oldlastpm
+oldname
+op_mask
+origargc
+origargv
+origfilename
+ors
+orslen
+pad
+padname
+parsehook
+patchlevel
+perldb
+perl_destruct_level
+pidstatus
+preambled
+preambleav
+preprocess
+restartop
+rightgv
+rs
+runlevel
+sawampersand
+sawi
+sawstudy
+sawvec
+screamfirst
+screamnext
+secondgv
+siggv
+signalstack
+sortcop
+sortstack
+sortstash
+splitstr
+stack
+statcache
+statgv
+statname
+statusvalue
+stdingv
+strchop
+sv_count
+sv_objcount
+sv_root
+sv_arenaroot
+tainted
+tainting
+tmps_floor
+tmps_ix
+tmps_max
+tmps_stack
+top_env
+toptarget
+unsafe
+warnhook
diff --git a/gnu/usr.bin/perl/keywords.h b/gnu/usr.bin/perl/keywords.h
new file mode 100644
index 00000000000..8cb2748d75b
--- /dev/null
+++ b/gnu/usr.bin/perl/keywords.h
@@ -0,0 +1,245 @@
+#define KEY_NULL		0
+#define KEY___LINE__		1
+#define KEY___FILE__		2
+#define KEY___DATA__		3
+#define KEY___END__		4
+#define KEY_AUTOLOAD		5
+#define KEY_BEGIN		6
+#define KEY_CORE		7
+#define KEY_DESTROY		8
+#define KEY_END			9
+#define KEY_EQ			10
+#define KEY_GE			11
+#define KEY_GT			12
+#define KEY_LE			13
+#define KEY_LT			14
+#define KEY_NE			15
+#define KEY_abs			16
+#define KEY_accept		17
+#define KEY_alarm		18
+#define KEY_and			19
+#define KEY_atan2		20
+#define KEY_bind		21
+#define KEY_binmode		22
+#define KEY_bless		23
+#define KEY_caller		24
+#define KEY_chdir		25
+#define KEY_chmod		26
+#define KEY_chomp		27
+#define KEY_chop		28
+#define KEY_chown		29
+#define KEY_chr			30
+#define KEY_chroot		31
+#define KEY_close		32
+#define KEY_closedir		33
+#define KEY_cmp			34
+#define KEY_connect		35
+#define KEY_continue		36
+#define KEY_cos			37
+#define KEY_crypt		38
+#define KEY_dbmclose		39
+#define KEY_dbmopen		40
+#define KEY_defined		41
+#define KEY_delete		42
+#define KEY_die			43
+#define KEY_do			44
+#define KEY_dump		45
+#define KEY_each		46
+#define KEY_else		47
+#define KEY_elsif		48
+#define KEY_endgrent		49
+#define KEY_endhostent		50
+#define KEY_endnetent		51
+#define KEY_endprotoent		52
+#define KEY_endpwent		53
+#define KEY_endservent		54
+#define KEY_eof			55
+#define KEY_eq			56
+#define KEY_eval		57
+#define KEY_exec		58
+#define KEY_exists		59
+#define KEY_exit		60
+#define KEY_exp			61
+#define KEY_fcntl		62
+#define KEY_fileno		63
+#define KEY_flock		64
+#define KEY_for			65
+#define KEY_foreach		66
+#define KEY_fork		67
+#define KEY_format		68
+#define KEY_formline		69
+#define KEY_ge			70
+#define KEY_getc		71
+#define KEY_getgrent		72
+#define KEY_getgrgid		73
+#define KEY_getgrnam		74
+#define KEY_gethostbyaddr	75
+#define KEY_gethostbyname	76
+#define KEY_gethostent		77
+#define KEY_getlogin		78
+#define KEY_getnetbyaddr	79
+#define KEY_getnetbyname	80
+#define KEY_getnetent		81
+#define KEY_getpeername		82
+#define KEY_getpgrp		83
+#define KEY_getppid		84
+#define KEY_getpriority		85
+#define KEY_getprotobyname	86
+#define KEY_getprotobynumber	87
+#define KEY_getprotoent		88
+#define KEY_getpwent		89
+#define KEY_getpwnam		90
+#define KEY_getpwuid		91
+#define KEY_getservbyname	92
+#define KEY_getservbyport	93
+#define KEY_getservent		94
+#define KEY_getsockname		95
+#define KEY_getsockopt		96
+#define KEY_glob		97
+#define KEY_gmtime		98
+#define KEY_goto		99
+#define KEY_grep		100
+#define KEY_gt			101
+#define KEY_hex			102
+#define KEY_if			103
+#define KEY_index		104
+#define KEY_int			105
+#define KEY_ioctl		106
+#define KEY_join		107
+#define KEY_keys		108
+#define KEY_kill		109
+#define KEY_last		110
+#define KEY_lc			111
+#define KEY_lcfirst		112
+#define KEY_le			113
+#define KEY_length		114
+#define KEY_link		115
+#define KEY_listen		116
+#define KEY_local		117
+#define KEY_localtime		118
+#define KEY_log			119
+#define KEY_lstat		120
+#define KEY_lt			121
+#define KEY_m			122
+#define KEY_map			123
+#define KEY_mkdir		124
+#define KEY_msgctl		125
+#define KEY_msgget		126
+#define KEY_msgrcv		127
+#define KEY_msgsnd		128
+#define KEY_my			129
+#define KEY_ne			130
+#define KEY_next		131
+#define KEY_no			132
+#define KEY_not			133
+#define KEY_oct			134
+#define KEY_open		135
+#define KEY_opendir		136
+#define KEY_or			137
+#define KEY_ord			138
+#define KEY_pack		139
+#define KEY_package		140
+#define KEY_pipe		141
+#define KEY_pop			142
+#define KEY_pos			143
+#define KEY_print		144
+#define KEY_printf		145
+#define KEY_prototype		146
+#define KEY_push		147
+#define KEY_q			148
+#define KEY_qq			149
+#define KEY_quotemeta		150
+#define KEY_qw			151
+#define KEY_qx			152
+#define KEY_rand		153
+#define KEY_read		154
+#define KEY_readdir		155
+#define KEY_readline		156
+#define KEY_readlink		157
+#define KEY_readpipe		158
+#define KEY_recv		159
+#define KEY_redo		160
+#define KEY_ref			161
+#define KEY_rename		162
+#define KEY_require		163
+#define KEY_reset		164
+#define KEY_return		165
+#define KEY_reverse		166
+#define KEY_rewinddir		167
+#define KEY_rindex		168
+#define KEY_rmdir		169
+#define KEY_s			170
+#define KEY_scalar		171
+#define KEY_seek		172
+#define KEY_seekdir		173
+#define KEY_select		174
+#define KEY_semctl		175
+#define KEY_semget		176
+#define KEY_semop		177
+#define KEY_send		178
+#define KEY_setgrent		179
+#define KEY_sethostent		180
+#define KEY_setnetent		181
+#define KEY_setpgrp		182
+#define KEY_setpriority		183
+#define KEY_setprotoent		184
+#define KEY_setpwent		185
+#define KEY_setservent		186
+#define KEY_setsockopt		187
+#define KEY_shift		188
+#define KEY_shmctl		189
+#define KEY_shmget		190
+#define KEY_shmread		191
+#define KEY_shmwrite		192
+#define KEY_shutdown		193
+#define KEY_sin			194
+#define KEY_sleep		195
+#define KEY_socket		196
+#define KEY_socketpair		197
+#define KEY_sort		198
+#define KEY_splice		199
+#define KEY_split		200
+#define KEY_sprintf		201
+#define KEY_sqrt		202
+#define KEY_srand		203
+#define KEY_stat		204
+#define KEY_study		205
+#define KEY_sub			206
+#define KEY_substr		207
+#define KEY_symlink		208
+#define KEY_syscall		209
+#define KEY_sysopen		210
+#define KEY_sysread		211
+#define KEY_system		212
+#define KEY_syswrite		213
+#define KEY_tell		214
+#define KEY_telldir		215
+#define KEY_tie			216
+#define KEY_tied		217
+#define KEY_time		218
+#define KEY_times		219
+#define KEY_tr			220
+#define KEY_truncate		221
+#define KEY_uc			222
+#define KEY_ucfirst		223
+#define KEY_umask		224
+#define KEY_undef		225
+#define KEY_unless		226
+#define KEY_unlink		227
+#define KEY_unpack		228
+#define KEY_unshift		229
+#define KEY_untie		230
+#define KEY_until		231
+#define KEY_use			232
+#define KEY_utime		233
+#define KEY_values		234
+#define KEY_vec			235
+#define KEY_wait		236
+#define KEY_waitpid		237
+#define KEY_wantarray		238
+#define KEY_warn		239
+#define KEY_while		240
+#define KEY_write		241
+#define KEY_x			242
+#define KEY_xor			243
+#define KEY_y			244
diff --git a/gnu/usr.bin/perl/keywords.pl b/gnu/usr.bin/perl/keywords.pl
new file mode 100644
index 00000000000..086a10956ab
--- /dev/null
+++ b/gnu/usr.bin/perl/keywords.pl
@@ -0,0 +1,270 @@
+#!/usr/bin/perl
+
+open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n";
+select KW;
+
+# Read & print data.
+
+$keynum = 0;
+while (<DATA>) {
+    chop;
+    next unless $_;
+    next if /^#/;
+    ($keyword) = split;
+    print &tab(5, "#define KEY_$keyword"), $keynum++, "\n";
+}
+
+###########################################################################
+sub tab {
+    local($l, $t) = @_;
+    $t .= "\t" x ($l - (length($t) + 1) / 8);
+    $t;
+}
+###########################################################################
+__END__
+
+NULL
+__LINE__
+__FILE__
+__DATA__
+__END__
+AUTOLOAD
+BEGIN
+CORE
+DESTROY
+END
+EQ
+GE
+GT
+LE
+LT
+NE
+abs
+accept
+alarm
+and
+atan2
+bind
+binmode
+bless
+caller
+chdir
+chmod
+chomp
+chop
+chown
+chr
+chroot
+close
+closedir
+cmp
+connect
+continue
+cos
+crypt
+dbmclose
+dbmopen
+defined
+delete
+die
+do
+dump
+each
+else
+elsif
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof
+eq
+eval
+exec
+exists
+exit
+exp
+fcntl
+fileno
+flock
+for
+foreach
+fork
+format
+formline
+ge
+getc
+getgrent
+getgrgid
+getgrnam
+gethostbyaddr
+gethostbyname
+gethostent
+getlogin
+getnetbyaddr
+getnetbyname
+getnetent
+getpeername
+getpgrp
+getppid
+getpriority
+getprotobyname
+getprotobynumber
+getprotoent
+getpwent
+getpwnam
+getpwuid
+getservbyname
+getservbyport
+getservent
+getsockname
+getsockopt
+glob
+gmtime
+goto
+grep
+gt
+hex
+if
+index
+int
+ioctl
+join
+keys
+kill
+last
+lc
+lcfirst
+le
+length
+link
+listen
+local
+localtime
+log
+lstat
+lt
+m
+map
+mkdir
+msgctl
+msgget
+msgrcv
+msgsnd
+my
+ne
+next
+no
+not
+oct
+open
+opendir
+or
+ord
+pack
+package
+pipe
+pop
+pos
+print
+printf
+prototype
+push
+q
+qq
+quotemeta
+qw
+qx
+rand
+read
+readdir
+readline
+readlink
+readpipe
+recv
+redo
+ref
+rename
+require
+reset
+return
+reverse
+rewinddir
+rindex
+rmdir
+s
+scalar
+seek
+seekdir
+select
+semctl
+semget
+semop
+send
+setgrent
+sethostent
+setnetent
+setpgrp
+setpriority
+setprotoent
+setpwent
+setservent
+setsockopt
+shift
+shmctl
+shmget
+shmread
+shmwrite
+shutdown
+sin
+sleep
+socket
+socketpair
+sort
+splice
+split
+sprintf
+sqrt
+srand
+stat
+study
+sub
+substr
+symlink
+syscall
+sysopen
+sysread
+system
+syswrite
+tell
+telldir
+tie
+tied
+time
+times
+tr
+truncate
+uc
+ucfirst
+umask
+undef
+unless
+unlink
+unpack
+unshift
+untie
+until
+use
+utime
+values
+vec
+wait
+waitpid
+wantarray
+warn
+while
+write
+x
+xor
+y
diff --git a/gnu/usr.bin/perl/lib/AnyDBM_File.pm b/gnu/usr.bin/perl/lib/AnyDBM_File.pm
new file mode 100644
index 00000000000..50acce412a4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AnyDBM_File.pm
@@ -0,0 +1,92 @@
+package AnyDBM_File;
+
+@ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA;
+
+eval { require NDBM_File } ||
+eval { require DB_File } ||
+eval { require GDBM_File } ||
+eval { require SDBM_File } ||
+eval { require ODBM_File };
+
+=head1 NAME
+
+AnyDBM_File - provide framework for multiple DBMs
+
+NDBM_File, ODBM_File, SDBM_File, GDBM_File - various DBM implementations
+
+=head1 SYNOPSIS
+
+    use AnyDBM_File;
+
+=head1 DESCRIPTION
+
+This module is a "pure virtual base class"--it has nothing of its own.
+It's just there to inherit from one of the various DBM packages.  It
+prefers ndbm for compatibility reasons with Perl 4, then Berkeley DB (See
+L<DB_File>), GDBM, SDBM (which is always there--it comes with Perl), and
+finally ODBM.   This way old programs that used to use NDBM via dbmopen()
+can still do so, but new ones can reorder @ISA:
+
+    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
+
+Note, however, that an explicit use overrides the specified order:
+
+    use GDBM_File;
+    @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File);
+
+will only find GDBM_File.
+
+Having multiple DBM implementations makes it trivial to copy database formats:
+
+    use POSIX; use NDBM_File; use DB_File;
+    tie %newhash,  DB_File, $new_filename, O_CREAT|O_RDWR;
+    tie %oldhash,  NDBM_File, $old_filename, 1, 0;
+    %newhash = %oldhash;
+
+=head2 DBM Comparisons
+
+Here's a partial table of features the different packages offer:
+
+                         odbm    ndbm    sdbm    gdbm    bsd-db
+			 ----	 ----    ----    ----    ------
+ Linkage comes w/ perl   yes     yes     yes     yes     yes
+ Src comes w/ perl       no      no      yes     no      no
+ Comes w/ many unix os   yes     yes[0]  no      no      no
+ Builds ok on !unix      ?       ?       yes     yes     ?
+ Code Size               ?       ?       small   big     big
+ Database Size           ?       ?       small   big?    ok[1]
+ Speed                   ?       ?       slow    ok      fast
+ FTPable                 no      no      yes     yes     yes
+ Easy to build          N/A     N/A      yes     yes     ok[2]
+ Size limits             1k      4k      1k[3]   none    none
+ Byte-order independent  no      no      no      no      yes
+ Licensing restrictions  ?       ?       no      yes     no
+
+
+=over 4
+
+=item [0] 
+
+on mixed universe machines, may be in the bsd compat library,
+which is often shunned.
+
+=item [1] 
+
+Can be trimmed if you compile for one access method.
+
+=item [2] 
+
+See L<DB_File>. 
+Requires symbolic links.  
+
+=item [3] 
+
+By default, but can be redefined.
+
+=back
+
+=head1 SEE ALSO
+
+dbm(3), ndbm(3), DB_File(3)
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/AutoLoader.pm b/gnu/usr.bin/perl/lib/AutoLoader.pm
new file mode 100644
index 00000000000..566ca8688e9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AutoLoader.pm
@@ -0,0 +1,75 @@
+package AutoLoader;
+use Carp;
+$DB::sub = $DB::sub;	# Avoid warning
+
+=head1 NAME
+
+AutoLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+    package FOOBAR;
+    use Exporter;
+    use AutoLoader;
+    @ISA = (Exporter, AutoLoader);
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from F<auto/$AUTOLOAD.al>.  See L<perlsub/"Autoloading">.
+
+=cut
+
+AUTOLOAD {
+    my $name = "auto/$AUTOLOAD.al";
+    $name =~ s#::#/#g;
+    eval {require $name};
+    if ($@) {
+	# The load might just have failed because the filename was too
+	# long for some old SVR3 systems which treat long names as errors.
+	# If we can succesfully truncate a long name then it's worth a go.
+	# There is a slight risk that we could pick up the wrong file here
+	# but autosplit should have warned about that when splitting.
+	if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+	    eval {require $name};
+	}
+	elsif ($AUTOLOAD =~ /::DESTROY$/) {
+	    # eval "sub $AUTOLOAD {}";
+	    *$AUTOLOAD = sub {};
+	}
+	if ($@){
+	    $@ =~ s/ at .*\n//;
+	    croak $@;
+	}
+    }
+    $DB::sub = $AUTOLOAD;	# Now debugger know where we are.
+    goto &$AUTOLOAD;
+}
+                            
+sub import {
+    my ($callclass, $callfile, $callline,$path,$callpack) = caller(0);
+    ($callpack = $callclass) =~ s#::#/#;
+    # Try to find the autosplit index file.  Eg., if the call package
+    # is POSIX, then $INC{POSIX.pm} is something like
+    # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in
+    # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that.
+    #
+    # However, if @INC is a relative path, this might not work.  If,
+    # for example, @INC = ('lib'), then
+    # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require
+    # 'auto/POSIX/autosplit.ix' (without the leading 'lib').
+    #
+    if (defined($path = $INC{$callpack . '.pm'})) {
+	# Try absolute path name.
+	$path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#;
+	eval { require $path; };
+	# If that failed, try relative path with normal @INC searching.
+	if ($@) {
+	    $path ="auto/$callpack/autosplit.ix";
+	    eval { require $path; };
+	}
+	carp $@ if ($@);  
+    } 
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/AutoSplit.pm b/gnu/usr.bin/perl/lib/AutoSplit.pm
new file mode 100644
index 00000000000..f9e3ad6dc4c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/AutoSplit.pm
@@ -0,0 +1,277 @@
+package AutoSplit;
+
+require 5.000;
+require Exporter;
+
+use Config;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&autosplit &autosplit_lib_modules);
+@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
+
+=head1 NAME
+
+AutoSplit - split a package for autoloading
+
+=head1 SYNOPSIS
+
+ perl -e 'use AutoSplit; autosplit_modules(@ARGV)'  ...
+
+=head1 DESCRIPTION
+
+This function will split up your program into files that the AutoLoader
+module can handle.  Normally only used to build autoloading Perl library
+modules, especially extensions (like POSIX).  You should look at how
+they're built out for details.
+
+=cut
+
+# for portability warn about names longer than $maxlen
+$Maxlen  = 8;	# 8 for dos, 11 (14-".al") for SYSVR3
+$Verbose = 1;	# 0=none, 1=minimal, 2=list .al files
+$Keep    = 0;
+$CheckForAutoloader = 1;
+$CheckModTime = 1;
+
+$IndexFile = "autosplit.ix";	# file also serves as timestamp
+$maxflen = 255;
+$maxflen = 14 if $Config{'d_flexfnam'} ne 'define';
+$Is_VMS = ($^O eq 'VMS');
+
+
+sub autosplit{
+    my($file, $autodir,  $k, $ckal, $ckmt) = @_;
+    # $file    - the perl source file to be split (after __END__)
+    # $autodir - the ".../auto" dir below which to write split subs
+    # Handle optional flags:
+    $keep = $Keep unless defined $k;
+    $ckal = $CheckForAutoloader unless defined $ckal;
+    $ckmt = $CheckModTime unless defined $ckmt;
+    autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
+}
+
+
+# This function is used during perl building/installation
+# ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ...
+
+sub autosplit_lib_modules{
+    my(@modules) = @_; # list of Module names
+
+    foreach(@modules){
+	s#::#/#g;	# incase specified as ABC::XYZ
+	s|\\|/|g;		# bug in ksh OS/2
+	s#^lib/##; # incase specified as lib/*.pm
+	if ($Is_VMS && /[:>\]]/) { # may need to convert VMS-style filespecs
+	    my ($dir,$name) = (/(.*])(.*)/);
+	    $dir =~ s/.*lib[\.\]]//;
+	    $dir =~ s#[\.\]]#/#g;
+	    $_ = $dir . $name;
+	}
+	autosplit_file("lib/$_", "lib/auto", $Keep, $CheckForAutoloader, $CheckModTime);
+    }
+    0;
+}
+
+
+# private functions
+
+sub autosplit_file{
+    my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_;
+    my(@names);
+
+    # where to write output files
+    $autodir = "lib/auto" unless $autodir;
+    ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS;
+    unless (-d $autodir){
+	local($", @p)="/";
+	foreach(split(/\//,$autodir)){
+	    push(@p, $_);
+	    next if -d "@p/";
+	    mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
+	}
+	# We should never need to create the auto dir here. installperl
+	# (or similar) should have done it. Expecting it to exist is a valuable
+	# sanity check against autosplitting into some random directory by mistake.
+	print "Warning: AutoSplit had to create top-level $autodir unexpectedly.\n";
+    }
+
+    # allow just a package name to be used
+    $filename .= ".pm" unless ($filename =~ m/\.pm$/);
+
+    open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n";
+    my($pm_mod_time) = (stat($filename))[9];
+    my($autoloader_seen) = 0;
+    my($in_pod) = 0;
+    while (<IN>) {
+	# Skip pod text.
+	$in_pod = 1 if /^=/;
+	$in_pod = 0 if /^=cut/;
+	next if ($in_pod || /^=cut/);
+
+	# record last package name seen
+	$package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
+	++$autoloader_seen if m/^\s*(use|require)\s+AutoLoader\b/;
+	++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/;
+	last if /^__END__/;
+    }
+    if ($check_for_autoloader && !$autoloader_seen){
+	print "AutoSplit skipped $filename: no AutoLoader used\n" if ($Verbose>=2);
+	return 0
+    }
+    $_ or die "Can't find __END__ in $filename\n";
+
+    $package or die "Can't find 'package Name;' in $filename\n";
+
+    my($modpname) = $package; $modpname =~ s#::#/#g;
+    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+
+    die "Package $package does not match filename $filename"
+	    unless ($filename =~ m/$modpname.pm$/ or
+	            $Is_VMS && $filename =~ m/$modpname.pm/i);
+
+    if ($check_mod_time){
+	my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
+	if ($al_ts_time >= $pm_mod_time){
+	    print "AutoSplit skipped ($al_idx_file newer that $filename)\n"
+		if ($Verbose >= 2);
+	    return undef;	# one undef, not a list
+	}
+    }
+
+    my($from) = ($Verbose>=2) ? "$filename => " : "";
+    print "AutoSplitting $package ($from$autodir/$modpname)\n"
+	if $Verbose;
+
+    unless (-d "$autodir/$modpname"){
+	local($", @p)="/";
+	foreach(split(/\//,"$autodir/$modpname")){
+	    push(@p, $_);
+	    next if -d "@p/";
+	    mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
+	}
+    }
+
+    # We must try to deal with some SVR3 systems with a limit of 14
+    # characters for file names. Sadly we *cannot* simply truncate all
+    # file names to 14 characters on these systems because we *must*
+    # create filenames which exactly match the names used by AutoLoader.pm.
+    # This is a problem because some systems silently truncate the file
+    # names while others treat long file names as an error.
+
+    # We do not yet deal with multiple packages within one file.
+    # Ideally both of these styles should work.
+    #
+    #   package NAME;
+    #   __END__
+    #   sub AAA { ... }
+    #   package NAME::option1;
+    #   sub BBB { ... }
+    #   package NAME::option2;
+    #   sub BBB { ... }
+    #
+    #   package NAME;
+    #   __END__
+    #   sub AAA { ... }
+    #   sub NAME::option1::BBB { ... }
+    #   sub NAME::option2::BBB { ... }
+    #
+    # For now both of these produce warnings.
+
+    open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
+    my(@subnames, %proto);
+    while (<IN>) {
+	if (/^package ([\w:]+)\s*;/) {
+	    warn "package $1; in AutoSplit section ignored. Not currently supported.";
+	}
+	if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
+	    print OUT "1;\n";
+	    my $subname = $1;
+	    $proto{$1} = $2 or '';
+	    if ($subname =~ m/::/){
+		warn "subs with package names not currently supported in AutoSplit section";
+	    }
+	    push(@subnames, $subname);
+	    my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3));
+	    my($lpath) = "$autodir/$modpname/$lname.al";
+	    my($spath) = "$autodir/$modpname/$sname.al";
+	    unless(open(OUT, ">$lpath")){
+		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+		push(@names, $sname);
+		print "  writing $spath (with truncated name)\n"
+			if ($Verbose>=1);
+	    }else{
+		push(@names, $lname);
+		print "  writing $lpath\n" if ($Verbose>=2);
+	    }
+	    print OUT "# NOTE: Derived from $filename.  ",
+			"Changes made here will be lost.\n";
+	    print OUT "package $package;\n\n";
+	}
+	print OUT $_;
+    }
+    print OUT "1;\n";
+    close(OUT);
+    close(IN);
+
+    if (!$keep){  # don't keep any obsolete *.al files in the directory
+	my(%names);
+	@names{@names} = @names;
+	opendir(OUTDIR,"$autodir/$modpname");
+	foreach(sort readdir(OUTDIR)){
+	    next unless /\.al$/;
+	    my($subname) = m/(.*)\.al$/;
+	    next if $names{substr($subname,0,$maxflen-3)};
+	    my($file) = "$autodir/$modpname/$_";
+	    print "  deleting $file\n" if ($Verbose>=2);
+	    my($deleted,$thistime);  # catch all versions on VMS
+	    do { $deleted += ($thistime = unlink $file) } while ($thistime);
+	    carp "Unable to delete $file: $!" unless $deleted;
+	}
+	closedir(OUTDIR);
+    }
+
+    open(TS,">$al_idx_file") or
+	carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
+    print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n";
+    print TS "package $package;\n";
+    print TS map("sub $_$proto{$_} ;\n", @subnames);
+    print TS "1;\n";
+    close(TS);
+
+    check_unique($package, $Maxlen, 1, @names);
+
+    @names;
+}
+
+
+sub check_unique{
+    my($module, $maxlen, $warn, @names) = @_;
+    my(%notuniq) = ();
+    my(%shorts)  = ();
+    my(@toolong) = grep(length > $maxlen, @names);
+
+    foreach(@toolong){
+	my($trunc) = substr($_,0,$maxlen);
+	$notuniq{$trunc}=1 if $shorts{$trunc};
+	$shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_;
+    }
+    if (%notuniq && $warn){
+	print "$module: some names are not unique when truncated to $maxlen characters:\n";
+	foreach(keys %notuniq){
+	    print " $shorts{$_} truncate to $_\n";
+	}
+    }
+    %notuniq;
+}
+
+1;
+__END__
+
+# test functions so AutoSplit.pm can be applied to itself:
+sub test1{ "test 1\n"; }
+sub test2{ "test 2\n"; }
+sub test3{ "test 3\n"; }
+sub test4{ "test 4\n"; }
+
+
diff --git a/gnu/usr.bin/perl/lib/Benchmark.pm b/gnu/usr.bin/perl/lib/Benchmark.pm
new file mode 100644
index 00000000000..9929e6e0be6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Benchmark.pm
@@ -0,0 +1,411 @@
+package Benchmark;
+
+=head1 NAME
+
+Benchmark - benchmark running times of code
+
+timethis - run a chunk of code several times
+
+timethese - run several chunks of code several times
+
+timeit - run a chunk of code and see how long it goes
+
+=head1 SYNOPSIS
+
+    timethis ($count, "code");
+
+    timethese($count, {
+	'Name1' => '...code1...',
+	'Name2' => '...code2...',
+    });
+
+    $t = timeit($count, '...other code...')
+    print "$count loops of other code took:",timestr($t),"\n";
+
+=head1 DESCRIPTION
+
+The Benchmark module encapsulates a number of routines to help you
+figure out how long it takes to execute some code.
+
+=head2 Methods
+
+=over 10
+
+=item new
+
+Returns the current time.   Example:
+
+    use Benchmark;
+    $t0 = new Benchmark;
+    # ... your code here ...
+    $t1 = new Benchmark;
+    $td = timediff($t1, $t0);
+    print "the code took:",timestr($dt),"\n";
+
+=item debug
+
+Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
+
+    debug Benchmark 1; 
+    $t = timeit(10, ' 5 ** $Global ');
+    debug Benchmark 0; 
+
+=back
+
+=head2 Standard Exports
+
+The following routines will be exported into your namespace 
+if you use the Benchmark module:
+
+=over 10
+
+=item timeit(COUNT, CODE)
+
+Arguments: COUNT is the number of time to run the loop, and 
+the second is the code to run.  CODE may be a string containing the code,
+a reference to the function to run, or a reference to a hash containing 
+keys which are names and values which are more CODE specs.
+
+Side-effects: prints out noise to standard out.
+
+Returns: a Benchmark object.  
+
+=item timethis
+
+=item timethese
+
+=item timediff
+
+=item timestr
+
+=back
+
+=head2 Optional Exports
+
+The following routines will be exported into your namespace
+if you specifically ask that they be imported:
+
+=over 10
+
+clearcache
+
+clearallcache
+
+disablecache
+
+enablecache
+
+=back
+
+=head1 NOTES
+
+The data is stored as a list of values from the time and times
+functions: 
+
+      ($real, $user, $system, $children_user, $children_system)
+
+in seconds for the whole loop (not divided by the number of rounds).
+
+The timing is done using time(3) and times(3).
+
+Code is executed in the caller's package.
+
+Enable debugging by:  
+
+    $Benchmark::debug = 1;
+
+The time of the null loop (a loop with the same
+number of rounds but empty loop body) is subtracted
+from the time of the real loop.
+
+The null loop times are cached, the key being the
+number of rounds. The caching can be controlled using
+calls like these:
+
+    clearcache($key); 
+    clearallcache();
+
+    disablecache(); 
+    enablecache();
+
+=head1 INHERITANCE
+
+Benchmark inherits from no other class, except of course
+for Exporter.
+
+=head1 CAVEATS
+
+The real time timing is done using time(2) and
+the granularity is therefore only one second.
+
+Short tests may produce negative figures because perl
+can appear to take longer to execute the empty loop 
+than a short test; try: 
+
+    timethis(100,'1');
+
+The system time of the null loop might be slightly
+more than the system time of the loop with the actual
+code and therefore the difference might end up being < 0.
+
+More documentation is needed :-( especially for styles and formats.
+
+=head1 AUTHORS
+
+Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>,
+Tim Bunce <Tim.Bunce@ig.co.uk>
+
+=head1 MODIFICATION HISTORY
+
+September 8th, 1994; by Tim Bunce.
+
+=cut
+
+# Purpose: benchmark running times of code.
+#
+#
+# Usage - to time code snippets and print results:
+#
+#	timethis($count, '...code...');
+#		
+# prints:
+#	timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
+#
+#
+#	timethese($count, {
+#		Name1 => '...code1...',
+#		Name2 => '...code2...',
+#		... });
+# prints:
+#	Benchmark: timing 100 iterations of Name1, Name2...
+#	     Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
+#	     Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
+#
+# The default display style will automatically add child process
+# values if non-zero.
+#
+#
+# Usage - to time sections of your own code:
+#
+#	use Benchmark;
+#	$t0 = new Benchmark;
+#	... your code here ...
+#	$t1 = new Benchmark;
+#	$td = &timediff($t1, $t0);
+#	print "the code took:",timestr($td),"\n";
+#
+#	$t = &timeit($count, '...other code...')
+#	print "$count loops of other code took:",timestr($t),"\n";
+# 
+#
+# Data format:
+#       The data is stored as a list of values from the time and times
+#       functions: ($real, $user, $system, $children_user, $children_system)
+#	in seconds for the whole loop (not divided by the number of rounds).
+#		
+# Internals:
+#	The timing is done using time(3) and times(3).
+#		
+#	Code is executed in the callers package
+#
+#	Enable debugging by:  $Benchmark::debug = 1;
+#
+#	The time of the null loop (a loop with the same
+#	number of rounds but empty loop body) is substracted
+#	from the time of the real loop.
+#
+#	The null loop times are cached, the key being the
+#	number of rounds. The caching can be controlled using
+#	&clearcache($key); &clearallcache;
+#	&disablecache; &enablecache;
+#
+# Caveats:
+#
+#	The real time timing is done using time(2) and
+#	the granularity is therefore only one second.
+#
+#	Short tests may produce negative figures because perl
+#	can appear to take longer to execute the empty loop 
+#	than a short test: try timethis(100,'1');
+#
+#	The system time of the null loop might be slightly
+#	more than the system time of the loop with the actual
+#	code and therefore the difference might end up being < 0
+#
+#	More documentation is needed :-(
+#	Especially for styles and formats.
+#
+# Authors:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
+# 		Tim Bunce <Tim.Bunce@ig.co.uk>
+#
+#
+# Last updated:	Sept 8th 94 by Tim Bunce
+#
+
+use Carp;
+use Exporter;
+@ISA=(Exporter);
+@EXPORT=qw(timeit timethis timethese timediff timestr);
+@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
+
+&init;
+
+sub init {
+    $debug = 0;
+    $min_count = 4;
+    $min_cpu   = 0.4;
+    $defaultfmt = '5.2f';
+    $defaultstyle = 'auto';
+    # The cache can cause a slight loss of sys time accuracy. If a
+    # user does many tests (>10) with *very* large counts (>10000)
+    # or works on a very slow machine the cache may be useful.
+    &disablecache;
+    &clearallcache;
+}
+
+sub clearcache    { delete $cache{$_[0]}; }
+sub clearallcache { %cache = (); }
+sub enablecache   { $cache = 1; }
+sub disablecache  { $cache = 0; }
+
+
+# --- Functions to process the 'time' data type
+
+sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
+
+sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
+sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
+sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
+sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
+
+sub timediff{
+    my($a, $b) = @_;
+    my(@r);
+    for($i=0; $i < @$a; ++$i){
+	push(@r, $a->[$i] - $b->[$i]);
+    }
+    bless \@r;
+}
+
+sub timestr{
+    my($tr, $style, $f) = @_;
+    my(@t) = @$tr;
+    warn "bad time value" unless @t==5;
+    my($r, $pu, $ps, $cu, $cs) = @t;
+    my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
+    $f = $defaultfmt unless $f;
+    # format a time in the required style, other formats may be added here
+    $style = $defaultstyle unless $style;
+    $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
+    my($s) = "@t $style"; # default for unknown style
+    $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
+			    @t,$t) if $style =~ /^all$/;
+    $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
+			    $r,$pu,$ps,$pt) if $style =~ /^noc$/;
+    $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
+			    $r,$cu,$cs,$ct) if $style =~ /^nop$/;
+    $s;
+}
+sub timedebug{
+    my($msg, $t) = @_;
+    print STDERR "$msg",timestr($t),"\n" if ($debug);
+}
+
+
+# --- Functions implementing low-level support for timing loops
+
+sub runloop {
+    my($n, $c) = @_;
+
+    $n+=0; # force numeric now, so garbage won't creep into the eval
+    croak "negativ loopcount $n" if $n<0;
+    confess "Usage: runloop(number, string)" unless defined $c;
+    my($t0, $t1, $td); # before, after, difference
+
+    # find package of caller so we can execute code there
+    my ($curpack) = caller(0);
+    my ($i, $pack)= 0;
+    while (($pack) = caller(++$i)) {
+	last if $pack ne $curpack;
+    }
+
+    my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
+    my $subref  = eval $subcode;
+    croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
+    print STDERR "runloop $n '$subcode'\n" if ($debug);
+
+    $t0 = &new;
+    &$subref;
+    $t1 = &new;
+    $td = &timediff($t1, $t0);
+
+    timedebug("runloop:",$td);
+    $td;
+}
+
+
+sub timeit {
+    my($n, $code) = @_;
+    my($wn, $wc, $wd);
+
+    printf STDERR "timeit $n $code\n" if $debug;
+
+    if ($cache && exists $cache{$n}){
+	$wn = $cache{$n};
+    }else{
+	$wn = &runloop($n, '');
+	$cache{$n} = $wn;
+    }
+
+    $wc = &runloop($n, $code);
+
+    $wd = timediff($wc, $wn);
+
+    timedebug("timeit: ",$wc);
+    timedebug("      - ",$wn);
+    timedebug("      = ",$wd);
+
+    $wd;
+}
+
+
+# --- Functions implementing high-level time-then-print utilities
+
+sub timethis{
+    my($n, $code, $title, $style) = @_;
+    my($t) = timeit($n, $code);
+    local($|) = 1;
+    $title = "timethis $n" unless $title;
+    $style = "" unless $style;
+    printf("%10s: ", $title);
+    print timestr($t, $style),"\n";
+    # A conservative warning to spot very silly tests.
+    # Don't assume that your benchmark is ok simply because
+    # you don't get this warning!
+    print "            (warning: too few iterations for a reliable count)\n"
+	if (   $n < $min_count
+	    || ($t->real < 1 && $n < 1000)
+	    || $t->cpu_a < $min_cpu);
+    $t;
+}
+
+
+sub timethese{
+    my($n, $alt, $style) = @_;
+    die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
+		unless ref $alt eq HASH;
+    my(@all);
+    my(@names) = sort keys %$alt;
+    $style = "" unless $style;
+    print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
+    foreach(@names){
+	$t = timethis($n, $alt->{$_}, $_, $style);
+	push(@all, $t);
+    }
+    # we could produce a summary from @all here
+    # sum, min, max, avg etc etc
+    @all;
+}
+
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Carp.pm b/gnu/usr.bin/perl/lib/Carp.pm
new file mode 100644
index 00000000000..f30bd24135c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Carp.pm
@@ -0,0 +1,90 @@
+package Carp;
+
+=head1 NAME
+
+carp - warn of errors (from perspective of caller)
+
+croak - die of errors (from perspective of caller)
+
+confess - die of errors with stack backtrace
+
+=head1 SYNOPSIS
+
+    use Carp;
+    croak "We're outta here!";
+
+=head1 DESCRIPTION
+
+The Carp routines are useful in your own modules because
+they act like die() or warn(), but report where the error
+was in the code they were called from.  Thus if you have a 
+routine Foo() that has a carp() in it, then the carp() 
+will report the error as occurring where Foo() was called, 
+not where carp() was called.
+
+=cut
+
+# This package implements handy routines for modules that wish to throw
+# exceptions outside of the current package.
+
+$CarpLevel = 0;		# How many extra package levels to skip on carp.
+$MaxEvalLen = 0;	# How much eval '...text...' to show. 0 = all.
+
+require Exporter;
+@ISA = Exporter;
+@EXPORT = qw(confess croak carp);
+
+sub longmess {
+    my $error = shift;
+    my $mess = "";
+    my $i = 1 + $CarpLevel;
+    my ($pack,$file,$line,$sub,$eval,$require);
+    while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
+	if ($error =~ m/\n$/) {
+	    $mess .= $error;
+	} else {
+	    if (defined $eval) {
+	        if ($require) {
+		    $sub = "require $eval";
+		} else {
+		    $eval =~ s/[\\\']/\\$&/g;
+		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
+			substr($eval,$MaxEvalLen) = '...';
+		    }
+		    $sub = "eval '$eval'";
+		}
+	    } elsif ($sub eq '(eval)') {
+		$sub = 'eval {...}';
+	    }
+	    $mess .= "\t$sub " if $error eq "called";
+	    $mess .= "$error at $file line $line\n";
+	}
+	$error = "called";
+    }
+    $mess || $error;
+}
+
+sub shortmess {	# Short-circuit &longmess if called via multiple packages
+    my $error = $_[0];	# Instead of "shift"
+    my ($curpack) = caller(1);
+    my $extra = $CarpLevel;
+    my $i = 2;
+    my ($pack,$file,$line);
+    while (($pack,$file,$line) = caller($i++)) {
+	if ($pack ne $curpack) {
+	    if ($extra-- > 0) {
+		$curpack = $pack;
+	    }
+	    else {
+		return "$error at $file line $line\n";
+	    }
+	}
+    }
+    goto &longmess;
+}
+
+sub confess { die longmess @_; }
+sub croak { die shortmess @_; }
+sub carp { warn shortmess @_; }
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Cwd.pm b/gnu/usr.bin/perl/lib/Cwd.pm
new file mode 100644
index 00000000000..bee2e179aef
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Cwd.pm
@@ -0,0 +1,271 @@
+package Cwd;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+getcwd - get pathname of current working directory
+
+=head1 SYNOPSIS
+
+    use Cwd;
+    $dir = cwd;
+
+    use Cwd;
+    $dir = getcwd;
+
+    use Cwd;
+    $dir = fastgetcwd;
+
+    use Cwd 'chdir';
+    chdir "/tmp";
+    print $ENV{'PWD'};
+
+=head1 DESCRIPTION
+
+The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
+in Perl.
+
+The fastcwd() function looks the same as getcwd(), but runs faster.
+It's also more dangerous because you might conceivably chdir() out of a
+directory that you can't chdir() back into.
+
+The cwd() function looks the same as getcwd and fastgetcwd but is
+implemented using the most natural and safe form for the current
+architecture. For most systems it is identical to `pwd` (but without
+the trailing line terminator). It is recommended that cwd (or another
+*cwd() function) is used in I<all> code to ensure portability.
+
+If you ask to override your chdir() built-in function, then your PWD
+environment variable will be kept up to date.  (See
+L<perlsub/Overriding builtin functions>.) Note that it will only be
+kept up to date it all packages which use chdir import it from Cwd.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir);
+
+# use strict;
+
+sub _backtick_pwd {  # The 'natural and safe form' for UNIX (pwd may be setuid root)
+    my $cwd;
+    chop($cwd = `pwd`);
+    $cwd;
+} 
+
+# Since some ports may predefine cwd internally (e.g., NT)
+# we take care not to override an existing definition for cwd().
+
+*cwd = \&_backtick_pwd unless defined &cwd;
+
+
+# By Brandon S. Allbery
+#
+# Usage: $cwd = getcwd();
+
+sub getcwd
+{
+    my($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat('.'))
+    {
+	warn "stat(.): $!";
+	return '';
+    }
+    $cwd = '';
+    $dotdots = '';
+    do
+    {
+	$dotdots .= '/' if $dotdots;
+	$dotdots .= '..';
+	@pst = @cst;
+	unless (opendir(PARENT, $dotdots))
+	{
+	    warn "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    warn "stat($dotdots): $!";
+	    closedir(PARENT);
+	    return '';
+	}
+	if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
+	{
+	    $dir = '';
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(PARENT)))
+	        {
+		    warn "readdir($dotdots): $!";
+		    closedir(PARENT);
+		    return '';
+		}
+		unless (@tst = lstat("$dotdots/$dir"))
+		{
+		    warn "lstat($dotdots/$dir): $!";
+		    # Just because you can't lstat this directory
+		    # doesn't mean you'll never find the right one.
+		    # closedir(PARENT);
+		    # return '';
+		}
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
+		   $tst[1] != $pst[1]);
+	}
+	$cwd = "$dir/$cwd";
+	closedir(PARENT);
+    } while ($dir);
+    chop($cwd); # drop the trailing /
+    $cwd;
+}
+
+
+
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd.  It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+    my($odev, $oino, $cdev, $cino, $tdev, $tino);
+    my(@path, $path);
+    local(*DIR);
+
+    ($cdev, $cino) = stat('.');
+    for (;;) {
+	my $direntry;
+	($odev, $oino) = ($cdev, $cino);
+	chdir('..');
+	($cdev, $cino) = stat('.');
+	last if $odev == $cdev && $oino == $cino;
+	opendir(DIR, '.');
+	for (;;) {
+	    $direntry = readdir(DIR);
+	    next if $direntry eq '.';
+	    next if $direntry eq '..';
+
+	    last unless defined $direntry;
+	    ($tdev, $tino) = lstat($direntry);
+	    last unless $tdev != $odev || $tino != $oino;
+	}
+	closedir(DIR);
+	unshift(@path, $direntry);
+    }
+    chdir($path = '/' . join('/', @path));
+    $path;
+}
+
+
+# Keeps track of current working directory in PWD environment var
+# Usage:
+#	use Cwd 'chdir';
+#	chdir $newdir;
+
+my $chdir_init = 0;
+
+sub chdir_init {
+    if ($ENV{'PWD'} and $^O ne 'os2') {
+	my($dd,$di) = stat('.');
+	my($pd,$pi) = stat($ENV{'PWD'});
+	if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
+	    $ENV{'PWD'} = cwd();
+	}
+    }
+    else {
+	$ENV{'PWD'} = cwd();
+    }
+    # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
+    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+	my($pd,$pi) = stat($2);
+	my($dd,$di) = stat($1);
+	if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
+	    $ENV{'PWD'}="$2$3";
+	}
+    }
+    $chdir_init = 1;
+}
+
+sub chdir {
+    my $newdir = shift || '';	# allow for no arg (chdir to HOME dir)
+    $newdir =~ s|///*|/|g;
+    chdir_init() unless $chdir_init;
+    return 0 unless CORE::chdir $newdir;
+    if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
+
+    if ($newdir =~ m#^/#) {
+	$ENV{'PWD'} = $newdir;
+    } else {
+	my @curdir = split(m#/#,$ENV{'PWD'});
+	@curdir = ('') unless @curdir;
+	my $component;
+	foreach $component (split(m#/#, $newdir)) {
+	    next if $component eq '.';
+	    pop(@curdir),next if $component eq '..';
+	    push(@curdir,$component);
+	}
+	$ENV{'PWD'} = join('/',@curdir) || '/';
+    }
+    1;
+}
+
+
+# --- PORTING SECTION ---
+
+# VMS: $ENV{'DEFAULT'} points to default directory at all times
+# 06-Mar-1996  Charles Bailey  bailey@genetics.upenn.edu
+# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
+#   in the process logical name table as the default device and directory 
+#   seen by Perl. This may not be the same as the default device 
+#   and directory seen by DCL after Perl exits, since the effects
+#   the CRTL chdir() function persist only until Perl exits.
+
+sub _vms_cwd {
+    return $ENV{'DEFAULT'}
+}
+sub _os2_cwd {
+    $ENV{'PWD'} = `cmd /c cd`;
+    chop $ENV{'PWD'};
+    $ENV{'PWD'} =~ s:\\:/:g ;
+    return $ENV{'PWD'};
+}
+
+my($oldw) = $^W;
+$^W = 0;  # assignments trigger 'subroutine redefined' warning
+if ($^O eq 'VMS') {
+
+    *cwd        = \&_vms_cwd;
+    *getcwd     = \&_vms_cwd;
+    *fastcwd    = \&_vms_cwd;
+    *fastgetcwd = \&_vms_cwd;
+}
+elsif ($^O eq 'NT') {
+
+    *getcwd     = \&cwd;
+    *fastgetcwd = \&cwd;
+}
+elsif ($^O eq 'os2') {
+    *cwd     = \&_os2_cwd;
+    *getcwd     = \&_os2_cwd;
+    *fastgetcwd = \&_os2_cwd;
+    *fastcwd = \&_os2_cwd;
+}
+$^W = $oldw;
+
+# package main; eval join('',<DATA>) || die $@;	# quick test
+
+1;
+
+__END__
+BEGIN { import Cwd qw(:DEFAULT chdir); }
+print join("\n", cwd, getcwd, fastcwd, "");
+chdir('..');
+print join("\n", cwd, getcwd, fastcwd, "");
+print "$ENV{PWD}\n";
diff --git a/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm b/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm
new file mode 100644
index 00000000000..fc7ee4b5110
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Devel/SelfStubber.pm
@@ -0,0 +1,139 @@
+package Devel::SelfStubber;
+require SelfLoader;
+@ISA = qw(SelfLoader);
+@EXPORT = 'AUTOLOAD';
+$JUST_STUBS = 1;
+$VERSION = 1.01; sub Version {$VERSION}
+
+# Use as
+# perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)'
+# (LIB defaults to '.') e.g.
+# perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub('Math::BigInt')'
+# would print out stubs needed if you added a __DATA__ before the subs.
+# Setting $Devel::SelfStubber::JUST_STUBS to 0 will print out the whole
+# module with the stubs entered just before the __DATA__
+
+sub _add_to_cache {
+    my($self,$fullname,$pack,$lines, $prototype) = @_;
+    push(@DATA,@{$lines});
+    if($fullname){push(@STUBS,"sub $fullname $prototype;\n")}; # stubs
+    '1;';
+}
+
+sub _package_defined {
+    my($self,$line) = @_;
+    push(@DATA,$line);
+}
+
+sub stub {
+    my($self,$module,$lib) = @_;
+    my($line,$end,$fh,$mod_file,$found_selfloader);
+    $lib ||= '.';
+    ($mod_file = $module) =~ s,::,/,g;
+    
+    $mod_file = "$lib/$mod_file.pm";
+    $fh = "${module}::DATA";
+
+    open($fh,$mod_file) || die "Unable to open $mod_file";
+    while($line = <$fh> and $line !~ m/^__DATA__/) {
+	push(@BEFORE_DATA,$line);
+	$line =~ /use\s+SelfLoader/ && $found_selfloader++;
+    }
+    $line =~ m/^__DATA__/ || die "$mod_file doesn't contain a __DATA__ token";
+    $found_selfloader || 
+	print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n";
+    $self->_load_stubs($module);
+    if ( fileno($fh) ) {
+	$end = 1;
+	while($line = <$fh>) {
+	    push(@AFTER_DATA,$line);
+	}
+    }
+    unless ($JUST_STUBS) {
+    	print @BEFORE_DATA;
+    }
+    print @STUBS;
+    unless ($JUST_STUBS) {
+    	print "1;\n__DATA__\n",@DATA;
+    	if($end) { print "__END__\n",@AFTER_DATA; }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Devel::SelfStubber - generate stubs for a SelfLoading module
+
+=head1 SYNOPSIS
+
+To generate just the stubs:
+
+    use Devel::SelfStubber;
+    Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
+
+or to generate the whole module with stubs inserted correctly
+
+    use Devel::SelfStubber;
+    $Devel::SelfStubber::JUST_STUBS=0;
+    Devel::SelfStubber->stub('MODULENAME','MY_LIB_DIR');
+
+MODULENAME is the Perl module name, e.g. Devel::SelfStubber,
+NOT 'Devel/SelfStubber' or 'Devel/SelfStubber.pm'.
+
+MY_LIB_DIR defaults to '.' if not present.
+
+=head1 DESCRIPTION
+
+Devel::SelfStubber prints the stubs you need to put in the module
+before the __DATA__ token (or you can get it to print the entire
+module with stubs correctly placed). The stubs ensure that if
+a method is called, it will get loaded. They are needed specifically
+for inherited autoloaded methods.
+
+This is best explained using the following example:
+
+Assume four classes, A,B,C & D.
+
+A is the root class, B is a subclass of A, C is a subclass of B,
+and D is another subclass of A.
+
+                        A
+                       / \
+                      B   D
+                     /
+                    C
+
+If D calls an autoloaded method 'foo' which is defined in class A,
+then the method is loaded into class A, then executed. If C then
+calls method 'foo', and that method was reimplemented in class
+B, but set to be autoloaded, then the lookup mechanism never gets to
+the AUTOLOAD mechanism in B because it first finds the method
+already loaded in A, and so erroneously uses that. If the method
+foo had been stubbed in B, then the lookup mechanism would have
+found the stub, and correctly loaded and used the sub from B.
+
+So, for classes and subclasses to have inheritance correctly
+work with autoloading, you need to ensure stubs are loaded.
+
+The SelfLoader can load stubs automatically at module initialization
+with the statement 'SelfLoader->load_stubs()';, but you may wish to
+avoid having the stub loading overhead associated with your
+initialization (though note that the SelfLoader::load_stubs method
+will be called sooner or later - at latest when the first sub
+is being autoloaded). In this case, you can put the sub stubs
+before the __DATA__ token. This can be done manually, but this
+module allows automatic generation of the stubs.
+
+By default it just prints the stubs, but you can set the
+global $Devel::SelfStubber::JUST_STUBS to 0 and it will
+print out the entire module with the stubs positioned correctly.
+
+At the very least, this is useful to see what the SelfLoader
+thinks are stubs - in order to ensure future versions of the
+SelfStubber remain in step with the SelfLoader, the
+SelfStubber actually uses the SelfLoader to determine which
+stubs are needed.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/DirHandle.pm b/gnu/usr.bin/perl/lib/DirHandle.pm
new file mode 100644
index 00000000000..047755dc17d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/DirHandle.pm
@@ -0,0 +1,72 @@
+package DirHandle;
+
+=head1 NAME 
+
+DirHandle - supply object methods for directory handles
+
+=head1 SYNOPSIS
+
+    use DirHandle;
+    $d = new DirHandle ".";
+    if (defined $d) {
+        while (defined($_ = $d->read)) { something($_); }
+        $d->rewind;
+        while (defined($_ = $d->read)) { something_else($_); }
+        undef $d;
+    }
+
+=head1 DESCRIPTION
+
+The C<DirHandle> method provide an alternative interface to the
+opendir(), closedir(), readdir(), and rewinddir() functions.
+
+The only objective benefit to using C<DirHandle> is that it avoids
+namespace pollution by creating globs to hold directory handles.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new DirHandle [DIRNAME]';
+    my $class = shift;
+    my $dh = gensym;
+    if (@_) {
+	DirHandle::open($dh, $_[0])
+	    or return undef;
+    }
+    bless $dh, $class;
+}
+
+sub DESTROY {
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub open {
+    @_ == 2 or croak 'usage: $dh->open(DIRNAME)';
+    my ($dh, $dirname) = @_;
+    opendir($dh, $dirname);
+}
+
+sub close {
+    @_ == 1 or croak 'usage: $dh->close()';
+    my ($dh) = @_;
+    closedir($dh);
+}
+
+sub read {
+    @_ == 1 or croak 'usage: $dh->read()';
+    my ($dh) = @_;
+    readdir($dh);
+}
+
+sub rewind {
+    @_ == 1 or croak 'usage: $dh->rewind()';
+    my ($dh) = @_;
+    rewinddir($dh);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/English.pm b/gnu/usr.bin/perl/lib/English.pm
new file mode 100644
index 00000000000..ce4520a8911
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/English.pm
@@ -0,0 +1,178 @@
+package English;
+
+require Exporter;
+@ISA = (Exporter);
+
+=head1 NAME
+
+English - use nice English (or awk) names for ugly punctuation variables
+
+=head1 SYNOPSIS
+
+    use English;
+    ...
+    if ($ERRNO =~ /denied/) { ... }
+
+=head1 DESCRIPTION
+
+This module provides aliases for the built-in variables whose
+names no one seems to like to read.  Variables with side-effects
+which get triggered just by accessing them (like $0) will still 
+be affected.
+
+For those variables that have an B<awk> version, both long
+and short English alternatives are provided.  For example, 
+the C<$/> variable can be referred to either $RS or 
+$INPUT_RECORD_SEPARATOR if you are using the English module.
+
+See L<perlvar> for a complete list of these.
+
+=cut
+
+local $^W = 0;
+
+# Grandfather $NAME import
+sub import {
+    my $this = shift;
+    my @list = @_;
+    local $Exporter::ExportLevel = 1;
+    Exporter::import($this,grep {s/^\$/*/} @list);
+}
+
+@EXPORT = qw(
+	*ARG
+	*MATCH
+	*PREMATCH
+	*POSTMATCH
+	*LAST_PAREN_MATCH
+	*INPUT_LINE_NUMBER
+	*NR
+	*INPUT_RECORD_SEPARATOR
+	*RS
+	*OUTPUT_AUTOFLUSH
+	*OUTPUT_FIELD_SEPARATOR
+	*OFS
+	*OUTPUT_RECORD_SEPARATOR
+	*ORS
+	*LIST_SEPARATOR
+	*SUBSCRIPT_SEPARATOR
+	*SUBSEP
+	*FORMAT_PAGE_NUMBER
+	*FORMAT_LINES_PER_PAGE
+	*FORMAT_LINES_LEFT
+	*FORMAT_NAME
+	*FORMAT_TOP_NAME
+	*FORMAT_LINE_BREAK_CHARACTERS
+	*FORMAT_FORMFEED
+	*CHILD_ERROR
+	*OS_ERROR
+	*ERRNO
+	*EXTENDED_OS_ERROR
+	*EVAL_ERROR
+	*PROCESS_ID
+	*PID
+	*REAL_USER_ID
+	*UID
+	*EFFECTIVE_USER_ID
+	*EUID
+	*REAL_GROUP_ID
+	*GID
+	*EFFECTIVE_GROUP_ID
+	*EGID
+	*PROGRAM_NAME
+	*PERL_VERSION
+	*ACCUMULATOR
+	*DEBUGGING
+	*SYSTEM_FD_MAX
+	*INPLACE_EDIT
+	*PERLDB
+	*BASETIME
+	*WARNING
+	*EXECUTABLE_NAME
+	*OSNAME
+);
+
+# The ground of all being.
+
+	*ARG					= *_	;
+
+# Matching.
+
+	*MATCH					= *&	;
+	*PREMATCH				= *`	;
+	*POSTMATCH				= *'	;
+	*LAST_PAREN_MATCH			= *+	;
+
+# Input.
+
+	*INPUT_LINE_NUMBER			= *.	;
+	    *NR					= *.	;
+	*INPUT_RECORD_SEPARATOR			= */	;
+	    *RS					= */	;
+
+# Output.
+
+	*OUTPUT_AUTOFLUSH			= *|	;
+	*OUTPUT_FIELD_SEPARATOR			= *,	;
+	    *OFS				= *,	;
+	*OUTPUT_RECORD_SEPARATOR		= *\	;
+	    *ORS				= *\	;
+
+# Interpolation "constants".
+
+	*LIST_SEPARATOR				= *"	;
+	*SUBSCRIPT_SEPARATOR			= *;	;
+	    *SUBSEP				= *;	;
+
+# Formats
+
+	*FORMAT_PAGE_NUMBER			= *%	;
+	*FORMAT_LINES_PER_PAGE			= *=	;
+	*FORMAT_LINES_LEFT			= *-	;
+	*FORMAT_NAME				= *~	;
+	*FORMAT_TOP_NAME			= *^	;
+	*FORMAT_LINE_BREAK_CHARACTERS		= *:	;
+	*FORMAT_FORMFEED			= *^L	;
+
+# Error status.
+
+	*CHILD_ERROR				= *?	;
+	*OS_ERROR				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
+	    *ERRNO				= *!	;
+	*EVAL_ERROR				= *@	;
+
+# Process info.
+
+	*PROCESS_ID				= *$	;
+	    *PID				= *$	;
+	*REAL_USER_ID				= *<	;
+	    *UID				= *<	;
+	*EFFECTIVE_USER_ID			= *>	;
+	    *EUID				= *>	;
+	*REAL_GROUP_ID				= *(	;
+	    *GID				= *(	;
+	*EFFECTIVE_GROUP_ID			= *)	;
+	    *EGID				= *)	;
+	*PROGRAM_NAME				= *0	;
+
+# Internals.
+
+	*PERL_VERSION				= *]	;
+	*ACCUMULATOR				= *^A	;
+	*DEBUGGING				= *^D	;
+	*SYSTEM_FD_MAX				= *^F	;
+	*INPLACE_EDIT				= *^I	;
+	*PERLDB					= *^P	;
+	*BASETIME				= *^T	;
+	*WARNING				= *^W	;
+	*EXECUTABLE_NAME			= *^X	;
+	*OSNAME					= *^O	;
+
+# Deprecated.
+
+#	*ARRAY_BASE				= *[	;
+#	*OFMT					= *#	;
+#	*MULTILINE_MATCHING			= **	;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Env.pm b/gnu/usr.bin/perl/lib/Env.pm
new file mode 100644
index 00000000000..0e790754a82
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Env.pm
@@ -0,0 +1,74 @@
+package Env;
+
+=head1 NAME
+
+Env - perl module that imports environment variables
+
+=head1 SYNOPSIS
+
+    use Env;
+    use Env qw(PATH HOME TERM);
+
+=head1 DESCRIPTION
+
+Perl maintains environment variables in a pseudo-associative-array
+named %ENV.  For when this access method is inconvenient, the Perl
+module C<Env> allows environment variables to be treated as simple
+variables.
+
+The Env::import() function ties environment variables with suitable
+names to global Perl variables with the same names.  By default it
+does so with all existing environment variables (C<keys %ENV>).  If
+the import function receives arguments, it takes them to be a list of
+environment variables to tie; it's okay if they don't yet exist.
+
+After an environment variable is tied, merely use it like a normal variable.
+You may access its value 
+
+    @path = split(/:/, $PATH);
+
+or modify it
+
+    $PATH .= ":.";
+
+however you'd like.
+To remove a tied environment variable from
+the environment, assign it the undefined value
+
+    undef $PATH;
+
+=head1 AUTHOR
+
+Chip Salzenberg <chip@fin.uucp>
+
+=cut
+
+sub import {
+    my ($callpack) = caller(0);
+    my $pack = shift;
+    my @vars = @_ ? @_ : keys(%ENV);
+
+    foreach (@vars) {
+	tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/;
+    }
+}
+
+sub TIESCALAR {
+    bless \($_[1]);
+}
+
+sub FETCH {
+    my ($self) = @_;
+    $ENV{$$self};
+}
+
+sub STORE {
+    my ($self, $value) = @_;
+    if (defined($value)) {
+	$ENV{$$self} = $value;
+    } else {
+	delete $ENV{$$self};
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Exporter.pm b/gnu/usr.bin/perl/lib/Exporter.pm
new file mode 100644
index 00000000000..343b9fbd174
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Exporter.pm
@@ -0,0 +1,377 @@
+package Exporter;
+
+require 5.001;
+
+$ExportLevel = 0;
+$Verbose = 0 unless $Verbose;
+
+require Carp;
+
+sub export {
+
+    # First make import warnings look like they're coming from the "use".
+    local $SIG{__WARN__} = sub {
+	my $text = shift;
+	$text =~ s/ at \S*Exporter.pm line \d+.*\n//;
+	local $Carp::CarpLevel = 1;	# ignore package calling us too.
+	Carp::carp($text);
+    };
+    local $SIG{__DIE__} = sub {
+	Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
+	    if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
+    };
+
+    my($pkg, $callpkg, @imports) = @_;
+    my($type, $sym, $oops);
+    *exports = *{"${pkg}::EXPORT"};
+
+    if (@imports) {
+	if (!%exports) {
+	    grep(s/^&//, @exports);
+	    @exports{@exports} = (1) x @exports;
+	    my $ok = \@{"${pkg}::EXPORT_OK"};
+	    if (@$ok) {
+		grep(s/^&//, @$ok);
+		@exports{@$ok} = (1) x @$ok;
+	    }
+	}
+
+	if ($imports[0] =~ m#^[/!:]#){
+	    my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
+	    my $tagdata;
+	    my %imports;
+	    my($remove, $spec, @names, @allexports);
+	    # negated first item implies starting with default set:
+	    unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
+	    foreach $spec (@imports){
+		$remove = $spec =~ s/^!//;
+
+		if ($spec =~ s/^://){
+		    if ($spec eq 'DEFAULT'){
+			@names = @exports;
+		    }
+		    elsif ($tagdata = $tagsref->{$spec}) {
+			@names = @$tagdata;
+		    }
+		    else {
+			warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
+			++$oops;
+			next;
+		    }
+		}
+		elsif ($spec =~ m:^/(.*)/$:){
+		    my $patn = $1;
+		    @allexports = keys %exports unless @allexports; # only do keys once
+		    @names = grep(/$patn/, @allexports); # not anchored by default
+		}
+		else {
+		    @names = ($spec); # is a normal symbol name
+		}
+
+		warn "Import ".($remove ? "del":"add").": @names "
+		    if $Verbose;
+
+		if ($remove) {
+		   foreach $sym (@names) { delete $imports{$sym} } 
+		}
+		else {
+		    @imports{@names} = (1) x @names;
+		}
+	    }
+	    @imports = keys %imports;
+	}
+
+	foreach $sym (@imports) {
+	    if (!$exports{$sym}) {
+		if ($sym =~ m/^\d/) {
+		    $pkg->require_version($sym);
+		    # If the version number was the only thing specified
+		    # then we should act as if nothing was specified:
+		    if (@imports == 1) {
+			@imports = @exports;
+			last;
+		    }
+		} elsif ($sym !~ s/^&// || !$exports{$sym}) {
+		    warn qq["$sym" is not exported by the $pkg module];
+		    $oops++;
+		}
+	    }
+	}
+	Carp::croak("Can't continue after import errors") if $oops;
+    }
+    else {
+	@imports = @exports;
+    }
+
+    *fail = *{"${pkg}::EXPORT_FAIL"};
+    if (@fail) {
+	if (!%fail) {
+	    # Build cache of symbols. Optimise the lookup by adding
+	    # barewords twice... both with and without a leading &.
+	    # (Technique could be applied to %exports cache at cost of memory)
+	    my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
+	    warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
+	    @fail{@expanded} = (1) x @expanded;
+	}
+	my @failed;
+	foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+	if (@failed) {
+	    @failed = $pkg->export_fail(@failed);
+	    foreach $sym (@failed) {
+		warn qq["$sym" is not implemented by the $pkg module ],
+			"on this architecture";
+	    }
+	    Carp::croak("Can't continue after import errors") if @failed;
+	}
+    }
+
+    warn "Importing into $callpkg from $pkg: ",
+		join(", ",sort @imports) if $Verbose;
+
+    foreach $sym (@imports) {
+	# shortcut for the common case of no type character
+	(*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
+	    unless $sym =~ s/^(\W)//;
+	$type = $1;
+	*{"${callpkg}::$sym"} =
+	    $type eq '&' ? \&{"${pkg}::$sym"} :
+	    $type eq '$' ? \${"${pkg}::$sym"} :
+	    $type eq '@' ? \@{"${pkg}::$sym"} :
+	    $type eq '%' ? \%{"${pkg}::$sym"} :
+	    $type eq '*' ?  *{"${pkg}::$sym"} :
+		Carp::croak("Can't export symbol: $type$sym");
+    }
+}
+
+sub import {
+    my $pkg = shift;
+    my $callpkg = caller($ExportLevel);
+    export $pkg, $callpkg, @_;
+}
+
+
+# Utility functions
+
+sub _push_tags {
+    my($pkg, $var, $syms) = @_;
+    my $nontag;
+    *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+    push(@{"${pkg}::$var"},
+	map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
+		(@$syms) ? @$syms : keys %export_tags);
+    # This may change to a die one day
+    Carp::carp("Some names are not tags") if $nontag and $^W;
+}
+
+sub export_tags    { _push_tags((caller)[0], "EXPORT",    \@_) }
+sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
+
+
+# Default methods
+
+sub export_fail {
+    @_;
+}
+
+sub require_version {
+    my($self, $wanted) = @_;
+    my $pkg = ref $self || $self;
+    my $version = ${"${pkg}::VERSION"} || "(undef)";
+    Carp::croak("$pkg $wanted required--this is only version $version")
+		if $version < $wanted;
+    $version;
+}
+
+1;
+
+# A simple self test harness. Change 'require Carp' to 'use Carp ()' for testing.
+# package main; eval(join('',<DATA>)) or die $@ unless caller;
+__END__
+package Test;
+$INC{'Exporter.pm'} = 1;
+@ISA = qw(Exporter);
+@EXPORT      = qw(A1 A2 A3 A4 A5);
+@EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+%EXPORT_TAGS = (T1=>[qw(A1 A2 B1 B2)], T2=>[qw(A1 A2 B3 B4)], T3=>[qw(X3)]);
+@EXPORT_FAIL = qw(B4);
+Exporter::export_ok_tags('T3', 'unknown_tag');
+sub export_fail {
+    map { "Test::$_" } @_	# edit symbols just as an example
+}
+
+package main;
+$Exporter::Verbose = 1;
+#import Test;
+#import Test qw(X3);		# export ok via export_ok_tags()
+#import Test qw(:T1 !A2 /5/ !/3/ B5);
+import Test qw(:T2 !B4);
+import Test qw(:T2);		# should fail
+1;
+
+=head1 NAME
+
+Exporter - Implements default import method for modules
+
+=head1 SYNOPSIS
+
+In module ModuleName.pm:
+
+  package ModuleName;
+  require Exporter;
+  @ISA = qw(Exporter);
+
+  @EXPORT = qw(...);            # symbols to export by default
+  @EXPORT_OK = qw(...);         # symbols to export on request
+  %EXPORT_TAGS = tag => [...];  # define names for sets of symbols
+
+In other files which wish to use ModuleName:
+
+  use ModuleName;               # import default symbols into my package
+
+  use ModuleName qw(...);       # import listed symbols into my package
+
+  use ModuleName ();            # do not import any symbols
+
+=head1 DESCRIPTION
+
+The Exporter module implements a default C<import> method which
+many modules choose inherit rather than implement their own.
+
+Perl automatically calls the C<import> method when processing a
+C<use> statement for a module. Modules and C<use> are documented
+in L<perlfunc> and L<perlmod>. Understanding the concept of
+modules and how the C<use> statement operates is important to
+understanding the Exporter.
+
+=head2 Selecting What To Export
+
+Do B<not> export method names!
+
+Do B<not> export anything else by default without a good reason!
+
+Exports pollute the namespace of the module user.  If you must export
+try to use @EXPORT_OK in preference to @EXPORT and avoid short or
+common symbol names to reduce the risk of name clashes.
+
+Generally anything not exported is still accessible from outside the
+module using the ModuleName::item_name (or $blessed_ref->method)
+syntax.  By convention you can use a leading underscore on names to
+informally indicate that they are 'internal' and not for public use.
+
+(It is actually possible to get private functions by saying:
+
+  my $subref = sub { ... };
+  &$subref;
+
+But there's no way to call that directly as a method, since a method
+must have a name in the symbol table.)
+
+As a general rule, if the module is trying to be object oriented
+then export nothing. If it's just a collection of functions then
+@EXPORT_OK anything but use @EXPORT with caution.
+
+Other module design guidelines can be found in L<perlmod>.
+
+=head2 Specialised Import Lists
+
+If the first entry in an import list begins with !, : or / then the
+list is treated as a series of specifications which either add to or
+delete from the list of names to import. They are processed left to
+right. Specifications are in the form:
+
+    [!]name         This name only
+    [!]:DEFAULT     All names in @EXPORT
+    [!]:tag         All names in $EXPORT_TAGS{tag} anonymous list
+    [!]/pattern/    All names in @EXPORT and @EXPORT_OK which match
+
+A leading ! indicates that matching names should be deleted from the
+list of names to import.  If the first specification is a deletion it
+is treated as though preceded by :DEFAULT. If you just want to import
+extra names in addition to the default set you will still need to
+include :DEFAULT explicitly.
+
+e.g., Module.pm defines:
+
+    @EXPORT      = qw(A1 A2 A3 A4 A5);
+    @EXPORT_OK   = qw(B1 B2 B3 B4 B5);
+    %EXPORT_TAGS = (T1 => [qw(A1 A2 B1 B2)], T2 => [qw(A1 A2 B3 B4)]);
+
+    Note that you cannot use tags in @EXPORT or @EXPORT_OK.
+    Names in EXPORT_TAGS must also appear in @EXPORT or @EXPORT_OK.
+
+An application using Module can say something like:
+
+    use Module qw(:DEFAULT :T2 !B3 A3);
+
+Other examples include:
+
+    use Socket qw(!/^[AP]F_/ !SOMAXCONN !SOL_SOCKET);
+    use POSIX  qw(:errno_h :termios_h !TCSADRAIN !/^EXIT/);
+
+Remember that most patterns (using //) will need to be anchored
+with a leading ^, e.g., C</^EXIT/> rather than C</EXIT/>.
+
+You can say C<BEGIN { $Exporter::Verbose=1 }> to see how the
+specifications are being processed and what is actually being imported
+into modules.
+
+=head2 Module Version Checking
+
+The Exporter module will convert an attempt to import a number from a
+module into a call to $module_name->require_version($value). This can
+be used to validate that the version of the module being used is
+greater than or equal to the required version.
+
+The Exporter module supplies a default require_version method which
+checks the value of $VERSION in the exporting module.
+
+Since the default require_version method treats the $VERSION number as
+a simple numeric value it will regard version 1.10 as lower than
+1.9. For this reason it is strongly recommended that you use numbers
+with at least two decimal places, e.g., 1.09.
+
+=head2 Managing Unknown Symbols
+
+In some situations you may want to prevent certain symbols from being
+exported. Typically this applies to extensions which have functions
+or constants that may not exist on some systems.
+
+The names of any symbols that cannot be exported should be listed
+in the C<@EXPORT_FAIL> array.
+
+If a module attempts to import any of these symbols the Exporter will
+will give the module an opportunity to handle the situation before
+generating an error. The Exporter will call an export_fail method
+with a list of the failed symbols:
+
+  @failed_symbols = $module_name->export_fail(@failed_symbols);
+
+If the export_fail method returns an empty list then no error is
+recorded and all the requested symbols are exported. If the returned
+list is not empty then an error is generated for each symbol and the
+export fails. The Exporter provides a default export_fail method which
+simply returns the list unchanged.
+
+Uses for the export_fail method include giving better error messages
+for some symbols and performing lazy architectural checks (put more
+symbols into @EXPORT_FAIL by default and then take them out if someone
+actually tries to use them and an expensive check shows that they are
+usable on that platform).
+
+=head2 Tag Handling Utility Functions
+
+Since the symbols listed within %EXPORT_TAGS must also appear in either
+@EXPORT or @EXPORT_OK, two utility functions are provided which allow
+you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
+
+  %EXPORT_TAGS = (foo => [qw(aa bb cc)], bar => [qw(aa cc dd)]);
+
+  Exporter::export_tags('foo');     # add aa, bb and cc to @EXPORT
+  Exporter::export_ok_tags('bar');  # add aa, cc and dd to @EXPORT_OK
+
+Any names which are not tags are added to @EXPORT or @EXPORT_OK
+unchanged but will trigger a warning (with C<-w>) to avoid misspelt tags
+names being silently added to @EXPORT or @EXPORT_OK. Future versions
+may make this a fatal error.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Install.pm b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
new file mode 100644
index 00000000000..5a0ed7ab2ca
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Install.pm
@@ -0,0 +1,337 @@
+package ExtUtils::Install;
+
+$VERSION = substr q$Revision: 1.1.1.1 $, 10;
+# $Id: Install.pm,v 1.1.1.1 1996/08/19 10:12:39 downsj Exp $
+
+use Exporter;
+use Carp ();
+use Config ();
+use vars qw(@ISA @EXPORT $VERSION);
+@ISA = ('Exporter');
+@EXPORT = ('install','uninstall','pm_to_blib');
+$Is_VMS = $^O eq 'VMS';
+
+my $splitchar = $^O eq 'VMS' ? '|' : $^O eq 'os2' ? ';' : ':';
+my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'};
+my $Inc_uninstall_warn_handler;
+
+#use vars qw( @EXPORT @ISA $Is_VMS );
+#use strict;
+
+sub forceunlink {
+    chmod 0666, $_[0];
+    unlink $_[0] or Carp::croak("Cannot forceunlink $_[0]: $!")
+}
+
+sub install {
+    my($hash,$verbose,$nonono,$inc_uninstall) = @_;
+    $verbose ||= 0;
+    $nonono  ||= 0;
+
+    use Cwd qw(cwd);
+    use ExtUtils::MakeMaker; # to implement a MY class
+    use File::Basename qw(dirname);
+    use File::Copy qw(copy);
+    use File::Find qw(find);
+    use File::Path qw(mkpath);
+    # The following lines were needed with AutoLoader (left for the record)
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install my_cmp.al));
+    # require $my_req;
+    # $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+    # time use we are in a different directory when autoload happens, so
+    # the relativ path to ./blib is ill.
+
+    my(%hash) = %$hash;
+    my(%pack, %write, $dir);
+    local(*DIR, *P);
+    for (qw/read write/) {
+	$pack{$_}=$hash{$_};
+	delete $hash{$_};
+    }
+    my($source_dir_or_file);
+    foreach $source_dir_or_file (sort keys %hash) {
+	#Check if there are files, and if yes, look if the corresponding
+	#target directory is writable for us
+	opendir DIR, $source_dir_or_file or next;
+	for (readdir DIR) {
+	    next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
+	    if (-w $hash{$source_dir_or_file} || mkpath($hash{$source_dir_or_file})) {
+		last;
+	    } else {
+		Carp::croak("You do not have permissions to install into $hash{$source_dir_or_file}");
+	    }
+	}
+	closedir DIR;
+    }
+    if (-f $pack{"read"}) {
+	open P, $pack{"read"} or Carp::croak("Couldn't read $pack{'read'}");
+	# Remember what you found
+	while (<P>) {
+	    chomp;
+	    $write{$_}++;
+	}
+	close P;
+    }
+    my $cwd = cwd();
+    my $umask = umask 0 unless $Is_VMS;
+
+    # This silly reference is just here to be able to call MY->catdir
+    # without a warning (Waiting for a proper path/directory module,
+    # Charles!)
+    my $MY = {};
+    bless $MY, 'MY';
+    my($source);
+    MOD_INSTALL: foreach $source (sort keys %hash) {
+	#copy the tree to the target directory without altering
+	#timestamp and permission and remember for the .packlist
+	#file. The packlist file contains the absolute paths of the
+	#install locations. AFS users may call this a bug. We'll have
+	#to reconsider how to add the means to satisfy AFS users also.
+	chdir($source) or next;
+	find(sub {
+	    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+                         $atime,$mtime,$ctime,$blksize,$blocks) = stat;
+	    return unless -f _;
+	    return if $_ eq ".exists";
+	    my $targetdir = $MY->catdir($hash{$source},$File::Find::dir);
+	    my $targetfile = $MY->catfile($targetdir,$_);
+
+	    my $diff = 0;
+	    if ( -f $targetfile && -s _ == $size) {
+		# We have a good chance, we can skip this one
+		$diff = my_cmp($_,$targetfile);
+	    } else {
+		print "$_ differs\n" if $verbose>1;
+		$diff++;
+	    }
+
+	    if ($diff){
+		if (-f $targetfile){
+		    forceunlink($targetfile) unless $nonono;
+		} else {
+		    mkpath($targetdir,0,0755) unless $nonono;
+		    print "mkpath($targetdir,0,0755)\n" if $verbose>1;
+		}
+		copy($_,$targetfile) unless $nonono;
+		print "Installing $targetfile\n";
+		utime($atime,$mtime + $Is_VMS,$targetfile) unless $nonono>1;
+		print "utime($atime,$mtime,$targetfile)\n" if $verbose>1;
+		$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
+		chmod $mode, $targetfile;
+		print "chmod($mode, $targetfile)\n" if $verbose>1;
+	    } else {
+		print "Skipping $targetfile (unchanged)\n" if $verbose;
+	    }
+	    
+	    if (! defined $inc_uninstall) { # it's called 
+	    } elsif ($inc_uninstall == 0){
+		inc_uninstall($_,$File::Find::dir,$verbose,1); # nonono set to 1
+	    } else {
+		inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
+	    }
+	    $write{$targetfile}++;
+
+	}, ".");
+	chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
+    }
+    umask $umask unless $Is_VMS;
+    if ($pack{'write'}) {
+	$dir = dirname($pack{'write'});
+	mkpath($dir,0,0755);
+	print "Writing $pack{'write'}\n";
+	open P, ">$pack{'write'}" or Carp::croak("Couldn't write $pack{'write'}: $!");
+	for (sort keys %write) {
+	    print P "$_\n";
+	}
+	close P;
+    }
+}
+
+sub my_cmp {
+    my($one,$two) = @_;
+    local(*F,*T);
+    my $diff = 0;
+    open T, $two or return 1;
+    open F, $one or Carp::croak("Couldn't open $one: $!");
+    my($fr, $tr, $fbuf, $tbuf, $size);
+    $size = 1024;
+    # print "Reading $one\n";
+    while ( $fr = read(F,$fbuf,$size)) {
+	unless (
+		$tr = read(T,$tbuf,$size) and 
+		$tbuf eq $fbuf
+	       ){
+	    # print "diff ";
+	    $diff++;
+	    last;
+	}
+	# print "$fr/$tr ";
+    }
+    # print "\n";
+    close F;
+    close T;
+    $diff;
+}
+
+sub uninstall {
+    my($fil,$verbose,$nonono) = @_;
+    die "no packlist file found: $fil" unless -f $fil;
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+    local *P;
+    open P, $fil or Carp::croak("uninstall: Could not read packlist file $fil: $!");
+    while (<P>) {
+	chomp;
+	print "unlink $_\n" if $verbose;
+	forceunlink($_) unless $nonono;
+    }
+    print "unlink $fil\n" if $verbose;
+    forceunlink($fil) unless $nonono;
+}
+
+sub inc_uninstall {
+    my($file,$libdir,$verbose,$nonono) = @_;
+    my($dir);
+    my $MY = {};
+    bless $MY, 'MY';
+    my %seen_dir = ();
+    foreach $dir (@INC, @PERL_ENV_LIB, @Config::Config{qw/archlibexp privlibexp sitearchexp sitelibexp/}) {
+	next if $dir eq ".";
+	next if $seen_dir{$dir}++;
+	my($targetfile) = $MY->catfile($dir,$libdir,$file);
+	next unless -f $targetfile;
+
+	# The reason why we compare file's contents is, that we cannot
+	# know, which is the file we just installed (AFS). So we leave
+	# an identical file in place
+	my $diff = 0;
+	if ( -f $targetfile && -s _ == -s $file) {
+	    # We have a good chance, we can skip this one
+	    $diff = my_cmp($file,$targetfile);
+	} else {
+	    print "#$file and $targetfile differ\n" if $verbose>1;
+	    $diff++;
+	}
+
+	next unless $diff;
+	if ($nonono) {
+	    if ($verbose) {
+		$Inc_uninstall_warn_handler ||= new ExtUtils::Install::Warn;
+		$libdir =~ s|^\./|| ; # That's just cosmetics, no need to port. It looks prettier.
+		$Inc_uninstall_warn_handler->add("$libdir/$file",$targetfile);
+	    }
+	    # if not verbose, we just say nothing
+	} else {
+	    print "Unlinking $targetfile (shadowing?)\n";
+	    forceunlink($targetfile);
+	}
+    }
+}
+
+sub pm_to_blib {
+    my($fromto,$autodir) = @_;
+
+    use File::Basename qw(dirname);
+    use File::Copy qw(copy);
+    use File::Path qw(mkpath);
+    use AutoSplit;
+    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
+    # require $my_req; # Hairy, but for the first
+
+    my $umask = umask 0022 unless $Is_VMS;
+    mkpath($autodir,0,0755);
+    foreach (keys %$fromto) {
+	next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
+	unless (my_cmp($_,$fromto->{$_})){
+	    print "Skip $fromto->{$_} (unchanged)\n";
+	    next;
+	}
+	if (-f $fromto->{$_}){
+	    forceunlink($fromto->{$_});
+	} else {
+	    mkpath(dirname($fromto->{$_}),0,0755);
+	}
+	copy($_,$fromto->{$_});
+	chmod(0444 | ( (stat)[2] & 0111 ? 0111 : 0 ),$fromto->{$_});
+	print "cp $_ $fromto->{$_}\n";
+	next unless /\.pm$/;
+	autosplit($fromto->{$_},$autodir);
+    }
+    umask $umask unless $Is_VMS;
+}
+
+package ExtUtils::Install::Warn;
+
+sub new { bless {}, shift }
+
+sub add {
+    my($self,$file,$targetfile) = @_;
+    push @{$self->{$file}}, $targetfile;
+}
+
+sub DESTROY {
+    my $self = shift;
+    my($file,$i,$plural);
+    foreach $file (sort keys %$self) {
+	$plural = @{$self->{$file}} > 1 ? "s" : "";
+	print "## Differing version$plural of $file found. You might like to\n";
+	for (0..$#{$self->{$file}}) {
+	    print "rm ", $self->{$file}[$_], "\n";
+	    $i++;
+	}
+    }
+    $plural = $i>1 ? "all those files" : "this file";
+    print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Install - install files from here to there
+
+=head1 SYNOPSIS
+
+B<use ExtUtils::Install;>
+
+B<install($hashref,$verbose,$nonono);>
+
+B<uninstall($packlistfile,$verbose,$nonono);>
+
+B<pm_to_blib($hashref);>
+
+=head1 DESCRIPTION
+
+Both install() and uninstall() are specific to the way
+ExtUtils::MakeMaker handles the installation and deinstallation of
+perl modules. They are not designed as general purpose tools.
+
+install() takes three arguments. A reference to a hash, a verbose
+switch and a don't-really-do-it switch. The hash ref contains a
+mapping of directories: each key/value pair is a combination of
+directories to be copied. Key is a directory to copy from, value is a
+directory to copy to. The whole tree below the "from" directory will
+be copied preserving timestamps and permissions.
+
+There are two keys with a special meaning in the hash: "read" and
+"write". After the copying is done, install will write the list of
+target files to the file named by $hashref->{write}. If there is
+another file named by $hashref->{read}, the contents of this file will
+be merged into the written file. The read and the written file may be
+identical, but on AFS it is quite likely, people are installing to a
+different directory than the one where the files later appear.
+
+uninstall() takes as first argument a file containing filenames to be
+unlinked. The second argument is a verbose switch, the third is a
+no-don't-really-do-it-now switch.
+
+pm_to_blib() takes a hashref as the first argument and copies all keys
+of the hash to the corresponding values efficiently. Filenames with
+the extension pm are autosplit. Second argument is the autosplit
+directory.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
new file mode 100644
index 00000000000..103aa167be3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Liblist.pm
@@ -0,0 +1,254 @@
+package ExtUtils::Liblist;
+
+# Broken out of MakeMaker from version 4.11
+
+$ExtUtils::Liblist::VERSION = substr q$Revision: 1.1.1.1 $, 10;
+
+use Config;
+use Cwd 'cwd';
+use File::Basename;
+
+my $Config_libext = $Config{lib_ext} || ".a";
+
+sub ext {
+    my($self,$potential_libs, $Verbose) = @_;
+    if ($^O =~ 'os2' and $Config{libs}) { 
+	# Dynamic libraries are not transitive, so we may need including
+	# the libraries linked against perl.dll again.
+
+	$potential_libs .= " " if $potential_libs;
+	$potential_libs .= $Config{libs};
+    }
+    return ("", "", "", "") unless $potential_libs;
+    print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose;
+
+    my($so)   = $Config{'so'};
+    my($libs) = $Config{'libs'};
+
+    # compute $extralibs, $bsloadlibs and $ldloadlibs from
+    # $potential_libs
+    # this is a rewrite of Andy Dougherty's extliblist in perl
+    # its home is in <distribution>/ext/util
+
+    my(@searchpath); # from "-L/path" entries in $potential_libs
+    my(@libpath) = split " ", $Config{'libpth'};
+    my(@ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen);
+    my($fullname, $thislib, $thispth, @fullname);
+    my($pwd) = cwd(); # from Cwd.pm
+    my($found) = 0;
+
+    foreach $thislib (split ' ', $potential_libs){
+
+	# Handle possible linker path arguments.
+	if ($thislib =~ s/^(-[LR])//){	# save path flag type
+	    my($ptype) = $1;
+	    unless (-d $thislib){
+		print STDOUT "$ptype$thislib ignored, directory does not exist\n"
+			if $Verbose;
+		next;
+	    }
+	    unless ($self->file_name_is_absolute($thislib)) {
+	      print STDOUT "Warning: $ptype$thislib changed to $ptype$pwd/$thislib\n";
+	      $thislib = $self->catdir($pwd,$thislib);
+	    }
+	    push(@searchpath, $thislib);
+	    push(@extralibs,  "$ptype$thislib");
+	    push(@ldloadlibs, "$ptype$thislib");
+	    next;
+	}
+
+	# Handle possible library arguments.
+	unless ($thislib =~ s/^-l//){
+	  print STDOUT "Unrecognized argument in LIBS ignored: '$thislib'\n";
+	  next;
+	}
+
+	my($found_lib)=0;
+	foreach $thispth (@searchpath, @libpath){
+
+		# Try to find the full name of the library.  We need this to
+		# determine whether it's a dynamically-loadable library or not.
+		# This tends to be subject to various os-specific quirks.
+		# For gcc-2.6.2 on linux (March 1995), DLD can not load
+		# .sa libraries, with the exception of libm.sa, so we
+		# deliberately skip them.
+	    if (@fullname = $self->lsdir($thispth,"^lib$thislib\.$so\.[0-9]+")){
+		# Take care that libfoo.so.10 wins against libfoo.so.9.
+		# Compare two libraries to find the most recent version
+		# number.  E.g.  if you have libfoo.so.9.0.7 and
+		# libfoo.so.10.1, first convert all digits into two
+		# decimal places.  Then we'll add ".00" to the shorter
+		# strings so that we're comparing strings of equal length
+		# Thus we'll compare libfoo.so.09.07.00 with
+		# libfoo.so.10.01.00.  Some libraries might have letters
+		# in the version.  We don't know what they mean, but will
+		# try to skip them gracefully -- we'll set any letter to
+		# '0'.  Finally, sort in reverse so we can take the
+		# first element.
+
+		#TODO: iterate through the directory instead of sorting
+
+		$fullname = "$thispth/" .
+		(sort { my($ma) = $a;
+			my($mb) = $b;
+			$ma =~ tr/A-Za-z/0/s;
+			$ma =~ s/\b(\d)\b/0$1/g;
+			$mb =~ tr/A-Za-z/0/s;
+			$mb =~ s/\b(\d)\b/0$1/g;
+			while (length($ma) < length($mb)) { $ma .= ".00"; }
+			while (length($mb) < length($ma)) { $mb .= ".00"; }
+			# Comparison deliberately backwards
+			$mb cmp $ma;} @fullname)[0];
+	    } elsif (-f ($fullname="$thispth/lib$thislib.$so")
+		 && (($Config{'dlsrc'} ne "dl_dld.xs") || ($thislib eq "m"))){
+	    } elsif (-f ($fullname="$thispth/lib${thislib}_s$Config_libext")
+		 && ($thislib .= "_s") ){ # we must explicitly use _s version
+	    } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){
+	    } elsif (-f ($fullname="$thispth/$thislib$Config_libext")){
+	    } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){
+	    } elsif ($^O eq 'dgux'
+		 && -l ($fullname="$thispth/lib$thislib$Config_libext")
+		 && readlink($fullname) =~ /^elink:/) {
+		 # Some of DG's libraries look like misconnected symbolic
+		 # links, but development tools can follow them.  (They
+		 # look like this:
+		 #
+		 #    libm.a -> elink:${SDE_PATH:-/usr}/sde/\
+		 #    ${TARGET_BINARY_INTERFACE:-m88kdgux}/usr/lib/libm.a
+		 #
+		 # , the compilation tools expand the environment variables.)
+	    } else {
+		print STDOUT "$thislib not found in $thispth\n" if $Verbose;
+		next;
+	    }
+	    print STDOUT "'-l$thislib' found at $fullname\n" if $Verbose;
+	    my($fullnamedir) = dirname($fullname);
+	    push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++;
+	    $found++;
+	    $found_lib++;
+
+	    # Now update library lists
+
+	    # what do we know about this library...
+	    my $is_dyna = ($fullname !~ /\Q$Config_libext\E$/);
+	    my $in_perl = ($libs =~ /\B-l\Q$ {thislib}\E\b/s);
+
+	    # Do not add it into the list if it is already linked in
+	    # with the main perl executable.
+	    # We have to special-case the NeXT, because all the math 
+	    # is also in libsys_s
+	    unless ($in_perl || 
+		    ($^O eq 'next' && $thislib eq 'm') ){
+		push(@extralibs, "-l$thislib");
+	    }
+
+	    # We might be able to load this archive file dynamically
+	    if ( $Config{'dlsrc'} =~ /dl_next|dl_dld/){
+		# We push -l$thislib instead of $fullname because
+		# it avoids hardwiring a fixed path into the .bs file.
+		# Mkbootstrap will automatically add dl_findfile() to
+		# the .bs file if it sees a name in the -l format.
+		# USE THIS, when dl_findfile() is fixed: 
+		# push(@bsloadlibs, "-l$thislib");
+		# OLD USE WAS while checking results against old_extliblist
+		push(@bsloadlibs, "$fullname");
+	    } else {
+		if ($is_dyna){
+                    # For SunOS4, do not add in this shared library if
+                    # it is already linked in the main perl executable
+		    push(@ldloadlibs, "-l$thislib")
+			unless ($in_perl and $^O eq 'sunos');
+		} else {
+		    push(@ldloadlibs, "-l$thislib");
+		}
+	    }
+	    last;	# found one here so don't bother looking further
+	}
+	print STDOUT "Warning (will try anyway): No library found for -l$thislib\n"
+	    unless $found_lib>0;
+    }
+    return ('','','','') unless $found;
+    ("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Liblist - determine libraries to use and how to use them
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::Liblist;>
+
+C<ExtUtils::Liblist::ext($potential_libs, $Verbose);>
+
+=head1 DESCRIPTION
+
+This utility takes a list of libraries in the form C<-llib1 -llib2
+-llib3> and prints out lines suitable for inclusion in an extension
+Makefile.  Extra library paths may be included with the form
+C<-L/another/path> this will affect the searches for all subsequent
+libraries.
+
+It returns an array of four scalar values: EXTRALIBS, BSLOADLIBS,
+LDLOADLIBS, and LD_RUN_PATH.
+
+Dependent libraries can be linked in one of three ways:
+
+=over 2
+
+=item * For static extensions
+
+by the ld command when the perl binary is linked with the extension
+library. See EXTRALIBS below.
+
+=item * For dynamic extensions
+
+by the ld command when the shared object is built/linked. See
+LDLOADLIBS below.
+
+=item * For dynamic extensions
+
+by the DynaLoader when the shared object is loaded. See BSLOADLIBS
+below.
+
+=back
+
+=head2 EXTRALIBS
+
+List of libraries that need to be linked with when linking a perl
+binary which includes this extension Only those libraries that
+actually exist are included.  These are written to a file and used
+when linking perl.
+
+=head2 LDLOADLIBS and LD_RUN_PATH
+
+List of those libraries which can or must be linked into the shared
+library when created using ld. These may be static or dynamic
+libraries.  LD_RUN_PATH is a colon separated list of the directories
+in LDLOADLIBS. It is passed as an environment variable to the process
+that links the shared library.
+
+=head2 BSLOADLIBS
+
+List of those libraries that are needed but can be linked in
+dynamically at run time on this platform.  SunOS/Solaris does not need
+this because ld records the information (from LDLOADLIBS) into the
+object file.  This list is used to create a .bs (bootstrap) file.
+
+=head1 PORTABILITY
+
+This module deals with a lot of system dependencies and has quite a
+few architecture specific B<if>s in the code.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
new file mode 100644
index 00000000000..1a1f8b16a04
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_OS2.pm
@@ -0,0 +1,73 @@
+package ExtUtils::MM_OS2;
+
+#use Config;
+#use Cwd;
+#use File::Basename;
+require Exporter;
+
+Exporter::import('ExtUtils::MakeMaker',
+       qw( $Verbose &neatvalue));
+
+$ENV{EMXSHELL} = 'sh'; # to run `commands`
+unshift @MM::ISA, 'ExtUtils::MM_OS2';
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
+    my(@m);
+    (my $boot = $self->{NAME}) =~ s/:/_/g;
+
+    if (not $self->{SKIPHASH}{'dynamic'}) {
+	push(@m,"
+$self->{BASEEXT}.def: Makefile.PL
+",
+     '	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
+     Mksymlists("NAME" => "', $self->{NAME},
+     '", "DLBASE" => "',$self->{DLBASE},
+     '", "DL_FUNCS" => ',neatvalue($funcs),
+     ', "IMPORTS" => ',neatvalue($imports),
+     ', "DL_VARS" => ', neatvalue($vars), ');\'
+');
+    }
+    join('',@m);
+}
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,.,g;
+    $man;
+}
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d _;
+    return "$file.exe" if -x "$file.exe" && ! -d _;
+    return "$file.cmd" if -x "$file.cmd" && ! -d _;
+    return;
+}
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m{^([a-z]:)?[\\/]}i ;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::MM_OS2 - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_OS2; # Done internally by ExtUtils::MakeMaker if needed
+
+=head1 DESCRIPTION
+
+See ExtUtils::MM_Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
new file mode 100644
index 00000000000..d10162c91ff
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_Unix.pm
@@ -0,0 +1,3118 @@
+package ExtUtils::MM_Unix;
+
+$VERSION = substr q$Revision: 1.1.1.1 $, 10;
+# $Id: MM_Unix.pm,v 1.1.1.1 1996/08/19 10:12:39 downsj Exp $
+
+require Exporter;
+use Config;
+use File::Basename qw(basename dirname fileparse);
+use DirHandle;
+
+Exporter::import('ExtUtils::MakeMaker',
+	qw( $Verbose &neatvalue));
+
+$Is_OS2 = $^O =~ m|^os/?2$|i;
+$Is_Mac = $^O eq "MacOS";
+
+if ($Is_VMS = $^O eq 'VMS') {
+    require VMS::Filespec;
+    import VMS::Filespec qw( &vmsify );
+}
+
+=head1 NAME
+
+ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::MM_Unix;>
+
+=head1 DESCRIPTION
+
+The methods provided by this package are designed to be used in
+conjunction with ExtUtils::MakeMaker. When MakeMaker writes a
+Makefile, it creates one or more objects that inherit their methods
+from a package C<MM>. MM itself doesn't provide any methods, but it
+ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
+specific packages take the responsibility for all the methods provided
+by MM_Unix. We are trying to reduce the number of the necessary
+overrides by defining rather primitive operations within
+ExtUtils::MM_Unix.
+
+If you are going to write a platform specific MM package, please try
+to limit the necessary overrides to primitiv methods, and if it is not
+possible to do so, let's work it out how to achieve that gain.
+
+If you are overriding any of these methods in your Makefile.PL (in the
+MY class), please report that to the makemaker mailing list. We are
+trying to minimize the necessary method overrides and switch to data
+driven Makefile.PLs wherever possible. In the long run less methods
+will be overridable via the MY class.
+
+=head1 METHODS
+
+The following description of methods is still under
+development. Please refer to the code for not suitably documented
+sections and complain loudly to the makemaker mailing list.
+
+Not all of the methods below are overridable in a
+Makefile.PL. Overridable methods are marked as (o). All methods are
+overridable by a platform specific MM_*.pm file (See
+L<ExtUtils::MM_VMS>) and L<ExtUtils::MM_OS2>).
+
+=head2 Preloaded methods
+
+=over 2
+
+=item canonpath
+
+No physical check on the filesystem, but a logical cleanup of a
+path. On UNIX eliminated successive slashes and successive "/.".
+
+=cut
+
+sub canonpath {
+    my($self,$path) = @_;
+    $path =~ s|/+|/|g ;                            # xx////xx  -> xx/xx
+    $path =~ s|(/\.)+/|/|g ;                       # xx/././xx -> xx/xx
+    $path =~ s|^(\./)+|| unless $path eq "./";     # ./xx      -> xx
+    $path =~ s|/$|| unless $path eq "/";           # xx/       -> xx
+    $path;
+}
+
+=item catdir
+
+Concatenate two or more directory names to form a complete path ending
+with a directory. But remove the trailing slash from the resulting
+string, because it doesn't look good, isn't necessary and confuses
+OS2. Of course, if this is the root directory, don't cut off the
+trailing slash :-)
+
+=cut
+
+# ';
+
+sub catdir {
+    shift;
+    my @args = @_;
+    for (@args) {
+	# append a slash to each argument unless it has one there
+	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+    }
+    my $result = join('', @args);
+    # remove a trailing slash unless we are root
+    substr($result,length($result)-1,1) = ""
+	if length($result) > 1 && substr($result,length($result)-1,1) eq "/";
+    $result;
+}
+
+=item catfile
+
+Concatenate one or more directory names and a filename to form a
+complete path ending with a filename
+
+=cut
+
+sub catfile {
+    my $self = shift @_;
+    my $file = pop @_;
+    return $file unless @_;
+    my $dir = $self->catdir(@_);
+    for ($dir) {
+	$_ .= "/" unless substr($_,length($_)-1,1) eq "/";
+    }
+    return $dir.$file;
+}
+
+=item curdir
+
+Returns a string representing of the current directory.  "." on UNIX.
+
+=cut
+
+sub curdir {
+    return "." ;
+}
+
+=item rootdir
+
+Returns a string representing of the root directory.  "/" on UNIX.
+
+=cut
+
+sub rootdir {
+    return "/";
+}
+
+=item updir
+
+Returns a string representing of the parent directory.  ".." on UNIX.
+
+=cut
+
+sub updir {
+    return "..";
+}
+
+sub ExtUtils::MM_Unix::c_o ;
+sub ExtUtils::MM_Unix::clean ;
+sub ExtUtils::MM_Unix::const_cccmd ;
+sub ExtUtils::MM_Unix::const_config ;
+sub ExtUtils::MM_Unix::const_loadlibs ;
+sub ExtUtils::MM_Unix::constants ;
+sub ExtUtils::MM_Unix::depend ;
+sub ExtUtils::MM_Unix::dir_target ;
+sub ExtUtils::MM_Unix::dist ;
+sub ExtUtils::MM_Unix::dist_basics ;
+sub ExtUtils::MM_Unix::dist_ci ;
+sub ExtUtils::MM_Unix::dist_core ;
+sub ExtUtils::MM_Unix::dist_dir ;
+sub ExtUtils::MM_Unix::dist_test ;
+sub ExtUtils::MM_Unix::dlsyms ;
+sub ExtUtils::MM_Unix::dynamic ;
+sub ExtUtils::MM_Unix::dynamic_bs ;
+sub ExtUtils::MM_Unix::dynamic_lib ;
+sub ExtUtils::MM_Unix::exescan ;
+sub ExtUtils::MM_Unix::extliblist ;
+sub ExtUtils::MM_Unix::file_name_is_absolute ;
+sub ExtUtils::MM_Unix::find_perl ;
+sub ExtUtils::MM_Unix::force ;
+sub ExtUtils::MM_Unix::guess_name ;
+sub ExtUtils::MM_Unix::has_link_code ;
+sub ExtUtils::MM_Unix::init_dirscan ;
+sub ExtUtils::MM_Unix::init_main ;
+sub ExtUtils::MM_Unix::init_others ;
+sub ExtUtils::MM_Unix::install ;
+sub ExtUtils::MM_Unix::installbin ;
+sub ExtUtils::MM_Unix::libscan ;
+sub ExtUtils::MM_Unix::linkext ;
+sub ExtUtils::MM_Unix::lsdir ;
+sub ExtUtils::MM_Unix::macro ;
+sub ExtUtils::MM_Unix::makeaperl ;
+sub ExtUtils::MM_Unix::makefile ;
+sub ExtUtils::MM_Unix::manifypods ;
+sub ExtUtils::MM_Unix::maybe_command ;
+sub ExtUtils::MM_Unix::maybe_command_in_dirs ;
+sub ExtUtils::MM_Unix::needs_linking ;
+sub ExtUtils::MM_Unix::nicetext ;
+sub ExtUtils::MM_Unix::parse_version ;
+sub ExtUtils::MM_Unix::pasthru ;
+sub ExtUtils::MM_Unix::path ;
+sub ExtUtils::MM_Unix::perl_script ;
+sub ExtUtils::MM_Unix::perldepend ;
+sub ExtUtils::MM_Unix::pm_to_blib ;
+sub ExtUtils::MM_Unix::post_constants ;
+sub ExtUtils::MM_Unix::post_initialize ;
+sub ExtUtils::MM_Unix::postamble ;
+sub ExtUtils::MM_Unix::prefixify ;
+sub ExtUtils::MM_Unix::processPL ;
+sub ExtUtils::MM_Unix::realclean ;
+sub ExtUtils::MM_Unix::replace_manpage_separator ;
+sub ExtUtils::MM_Unix::static ;
+sub ExtUtils::MM_Unix::static_lib ;
+sub ExtUtils::MM_Unix::staticmake ;
+sub ExtUtils::MM_Unix::subdir_x ;
+sub ExtUtils::MM_Unix::subdirs ;
+sub ExtUtils::MM_Unix::test ;
+sub ExtUtils::MM_Unix::test_via_harness ;
+sub ExtUtils::MM_Unix::test_via_script ;
+sub ExtUtils::MM_Unix::tool_autosplit ;
+sub ExtUtils::MM_Unix::tool_xsubpp ;
+sub ExtUtils::MM_Unix::tools_other ;
+sub ExtUtils::MM_Unix::top_targets ;
+sub ExtUtils::MM_Unix::writedoc ;
+sub ExtUtils::MM_Unix::xs_c ;
+sub ExtUtils::MM_Unix::xs_o ;
+sub ExtUtils::MM_Unix::xsubpp_version ;
+
+package ExtUtils::MM_Unix;
+
+#use SelfLoader;
+
+1;
+#__DATA__
+
+=head2 SelfLoaded methods
+
+=item c_o (o)
+
+Defines the suffix rules to compile different flavors of C files to
+object files.
+
+=cut
+
+sub c_o {
+# --- Translation Sections ---
+
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    my(@m);
+    push @m, '
+.c$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+.C$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+
+.cpp$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
+
+.cxx$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx
+
+.cc$(OBJ_EXT):
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc
+';
+    join "", @m;
+}
+
+=item cflags (o)
+
+Does very much the same as the cflags script in the perl
+distribution. It doesn't return the whole compiler command line, but
+initializes all of its parts. The const_cccmd method then actually
+returns the definition of the CCCMD macro which uses these parts.
+
+=cut
+
+#'
+
+sub cflags {
+    my($self,$libperl)=@_;
+    return $self->{CFLAGS} if $self->{CFLAGS};
+    return '' unless $self->needs_linking();
+
+    my($prog, $uc, $perltype, %cflags);
+    $libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
+    $libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
+
+    @cflags{qw(cc ccflags optimize large split shellflags)}
+	= @Config{qw(cc ccflags optimize large split shellflags)};
+    my($optdebug) = "";
+
+    $cflags{shellflags} ||= '';
+
+    my(%map) =  (
+		D =>   '-DDEBUGGING',
+		E =>   '-DEMBED',
+		DE =>  '-DDEBUGGING -DEMBED',
+		M =>   '-DEMBED -DMULTIPLICITY',
+		DM =>  '-DDEBUGGING -DEMBED -DMULTIPLICITY',
+		);
+
+    if ($libperl =~ /libperl(\w*)\Q$self->{LIB_EXT}/){
+	$uc = uc($1);
+    } else {
+	$uc = ""; # avoid warning
+    }
+    $perltype = $map{$uc} ? $map{$uc} : "";
+
+    if ($uc =~ /^D/) {
+	$optdebug = "-g";
+    }
+
+
+    my($name);
+    ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
+    if ($prog = $Config::Config{$name}) {
+	# Expand hints for this extension via the shell
+	print STDOUT "Processing $name hint:\n" if $Verbose;
+	my(@o)=`cc=\"$cflags{cc}\"
+	  ccflags=\"$cflags{ccflags}\"
+	  optimize=\"$cflags{optimize}\"
+	  perltype=\"$cflags{perltype}\"
+	  optdebug=\"$cflags{optdebug}\"
+	  large=\"$cflags{large}\"
+	  split=\"$cflags{'split'}\"
+	  eval '$prog'
+	  echo cc=\$cc
+	  echo ccflags=\$ccflags
+	  echo optimize=\$optimize
+	  echo perltype=\$perltype
+	  echo optdebug=\$optdebug
+	  echo large=\$large
+	  echo split=\$split
+	  `;
+	my($line);
+	foreach $line (@o){
+	    chomp $line;
+	    if ($line =~ /(.*?)=\s*(.*)\s*$/){
+		$cflags{$1} = $2;
+		print STDOUT "	$1 = $2\n" if $Verbose;
+	    } else {
+		print STDOUT "Unrecognised result from hint: '$line'\n";
+	    }
+	}
+    }
+
+    if ($optdebug) {
+	$cflags{optimize} = $optdebug;
+    }
+
+    for (qw(ccflags optimize perltype large split)) {
+	$cflags{$_} =~ s/^\s+//;
+	$cflags{$_} =~ s/\s+/ /g;
+	$cflags{$_} =~ s/\s+$//;
+	$self->{uc $_} ||= $cflags{$_}
+    }
+
+    return $self->{CFLAGS} = qq{
+CCFLAGS = $self->{CCFLAGS}
+OPTIMIZE = $self->{OPTIMIZE}
+PERLTYPE = $self->{PERLTYPE}
+LARGE = $self->{LARGE}
+SPLIT = $self->{SPLIT}
+};
+
+}
+
+=item clean (o)
+
+Defines the clean target.
+
+=cut
+
+sub clean {
+# --- Cleanup and Distribution Sections ---
+
+    my($self, %attribs) = @_;
+    my(@m,$dir);
+    push(@m, '
+# Delete temporary files but do not touch installed files. We don\'t delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean ::
+');
+    # clean subdirectories first
+    for $dir (@{$self->{DIR}}) {
+	push @m, "\t-cd $dir && test -f $self->{MAKEFILE} && \$(MAKE) clean\n";
+    }
+
+    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all
+			 perlmain.c mon.out core so_locations pm_to_blib
+			 *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe
+			 $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def
+			 $(BASEEXT).exp
+			]);
+    push @m, "\t-$self->{RM_RF} @otherfiles\n";
+    # See realclean and ext/utils/make_ext for usage of Makefile.old
+    push(@m,
+	 "\t-$self->{MV} $self->{MAKEFILE} $self->{MAKEFILE}.old 2>/dev/null\n");
+    push(@m,
+	 "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
+    join("", @m);
+}
+
+=item const_cccmd (o)
+
+Returns the full compiler call for C programs and stores the
+definition in CONST_CCCMD.
+
+=cut
+
+sub const_cccmd {
+    my($self,$libperl)=@_;
+    return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
+    return '' unless $self->needs_linking();
+    return $self->{CONST_CCCMD} =
+	q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\
+	$(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \\
+	$(XS_DEFINE_VERSION)};
+}
+
+=item const_config (o)
+
+Defines a couple of constants in the Makefile that are imported from
+%Config.
+
+=cut
+
+sub const_config {
+# --- Constants Sections ---
+
+    my($self) = shift;
+    my(@m,$m);
+    push(@m,"\n# These definitions are from config.sh (via $INC{'Config.pm'})\n");
+    push(@m,"\n# They may have been overridden via Makefile.PL or on the command line\n");
+    my(%once_only);
+    foreach $m (@{$self->{CONFIG}}){
+	# SITE*EXP macros are defined in &constants; avoid duplicates here
+	next if $once_only{$m} or $m eq 'sitelibexp' or $m eq 'sitearchexp';
+	push @m, "\U$m\E = ".$self->{uc $m}."\n";
+	$once_only{$m} = 1;
+    }
+    join('', @m);
+}
+
+=item const_loadlibs (o)
+
+Defines EXTRALIBS, LDLOADLIBS, BSLOADLIBS, LD_RUN_PATH. See
+L<ExtUtils::Liblist> for details.
+
+=cut
+
+sub const_loadlibs {
+    my($self) = shift;
+    return "" unless $self->needs_linking;
+    my @m;
+    push @m, qq{
+# $self->{NAME} might depend on some other libraries:
+# See ExtUtils::Liblist for details
+#
+};
+    my($tmp);
+    for $tmp (qw/
+	 EXTRALIBS LDLOADLIBS BSLOADLIBS LD_RUN_PATH
+	 /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+    return join "", @m;
+}
+
+=item constants (o)
+
+Initializes lots of constants and .SUFFIXES and .PHONY
+
+=cut
+
+sub constants {
+    my($self) = @_;
+    my(@m,$tmp);
+
+    for $tmp (qw/
+
+	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
+	      VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB
+	      INST_ARCHLIB INST_SCRIPT PREFIX INSTALLDIRS
+	      INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB
+	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
+	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
+	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC
+	      PERL_INC PERL FULLPERL
+
+	      / ) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, qq{
+VERSION_MACRO = VERSION
+DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
+};
+
+    push @m, qq{
+MAKEMAKER = $INC{'ExtUtils/MakeMaker.pm'}
+MM_VERSION = $ExtUtils::MakeMaker::VERSION
+};
+
+    push @m, q{
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD)  !!! Deprecated from MM 5.32  !!!
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+};
+
+    for $tmp (qw/
+	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
+	      LDFROM LINKTYPE
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, "
+# Handy lists of source code files:
+XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})."
+C_FILES = ".join(" \\\n\t", @{$self->{C}})."
+O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})."
+H_FILES = ".join(" \\\n\t", @{$self->{H}})."
+MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})."
+MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
+";
+
+    for $tmp (qw/
+	      INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+	      /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    push @m, q{
+.NO_CONFIG_REC: Makefile
+} if $ENV{CLEARCASE_ROOT};
+
+    # why not q{} ? -- emacs
+    push @m, qq{
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
+
+.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT)
+
+# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
+# some make implementations will delete the Makefile when we rebuild it. Because
+# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
+# does so. Our milage may vary.
+# .PRECIOUS: Makefile    # seems to be not necessary anymore
+
+.PHONY: all config static dynamic test linkext manifest
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = \$(PERL_ARCHLIB)/Config.pm \$(PERL_INC)/config.h
+};
+
+    my @parentdir = split(/::/, $self->{PARENT_NAME});
+    push @m, q{
+# Where to put things:
+INST_LIBDIR      = }. $self->catdir('$(INST_LIB)',@parentdir)        .q{
+INST_ARCHLIBDIR  = }. $self->catdir('$(INST_ARCHLIB)',@parentdir)    .q{
+
+INST_AUTODIR     = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)')       .q{
+INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)')   .q{
+};
+
+    if ($self->has_link_code()) {
+	push @m, '
+INST_STATIC  = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
+INST_BOOT    = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
+';
+    } else {
+	push @m, '
+INST_STATIC  =
+INST_DYNAMIC =
+INST_BOOT    =
+';
+    }
+
+    if ($Is_OS2) {
+	$tmp = "$self->{BASEEXT}.def";
+    } else {
+	$tmp = "";
+    }
+    push @m, "
+EXPORT_LIST = $tmp
+";
+
+    if ($Is_OS2) {
+	$tmp = "\$(PERL_INC)/libperl\$(LIB_EXT)";
+    } else {
+	$tmp = "";
+    }
+    push @m, "
+PERL_ARCHIVE = $tmp
+";
+
+#    push @m, q{
+#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{
+#
+#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
+#};
+
+    push @m, q{
+TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{
+
+PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
+};
+
+    join('',@m);
+}
+
+=item depend (o)
+
+Same as macro for the depend attribute.
+
+=cut
+
+sub depend {
+    my($self,%attribs) = @_;
+    my(@m,$key,$val);
+    while (($key,$val) = each %attribs){
+	last unless defined $key;
+	push @m, "$key: $val\n";
+    }
+    join "", @m;
+}
+
+=item dir_target (o)
+
+Takes an array of directories that need to exist and returns a
+Makefile entry for a .exists file in these directories. Returns
+nothing, if the entry has already been processed. We're helpless
+though, if the same directory comes as $(FOO) _and_ as "bar". Both of
+them get an entry, that's why we use "::".
+
+=cut
+
+sub dir_target {
+# --- Make-Directories section (internal method) ---
+# dir_target(@array) returns a Makefile entry for the file .exists in each
+# named directory. Returns nothing, if the entry has already been processed.
+# We're helpless though, if the same directory comes as $(FOO) _and_ as "bar".
+# Both of them get an entry, that's why we use "::". I chose '$(PERL)' as the
+# prerequisite, because there has to be one, something that doesn't change
+# too often :)
+
+    my($self,@dirs) = @_;
+    my(@m,$dir);
+    foreach $dir (@dirs) {
+	my($src) = $self->catfile($self->{PERL_INC},'perl.h');
+	my($targ) = $self->catfile($dir,'.exists');
+	my($targdir) = $targ;       # Necessary because catfile may have
+	$targdir =~ s:/?.exists$::; # adapted syntax of $dir to target OS
+	next if $self->{DIR_TARGET}{$self}{$targdir}++;
+	push @m, qq{
+$targ :: $src
+	$self->{NOECHO}\$(MKPATH) $targdir
+	$self->{NOECHO}\$(EQUALIZE_TIMESTAMP) $src $targ
+};
+	push(@m,qq{
+	-$self->{NOECHO}\$(CHMOD) 755 $targdir
+}) unless $Is_VMS;
+    }
+    join "", @m;
+}
+
+=item dist (o)
+
+Defines a lot of macros for distribution support.
+
+=cut
+
+sub dist {
+    my($self, %attribs) = @_;
+
+    my(@m);
+    # VERSION should be sanitised before use as a file name
+    my($version)  = $attribs{VERSION}  || '$(VERSION)';
+    my($name)     = $attribs{NAME}     || '$(DISTNAME)';
+    my($tar)      = $attribs{TAR}      || 'tar';        # eg /usr/bin/gnutar
+    my($tarflags) = $attribs{TARFLAGS} || 'cvf';
+    my($zip)      = $attribs{ZIP}      || 'zip';        # eg pkzip Yuck!
+    my($zipflags) = $attribs{ZIPFLAGS} || '-r';
+    my($compress) = $attribs{COMPRESS} || 'compress';   # eg gzip
+    my($suffix)   = $attribs{SUFFIX}   || '.Z';          # eg .gz
+    my($shar)     = $attribs{SHAR}     || 'shar';       # eg "shar --gzip"
+    my($preop)    = $attribs{PREOP}    || "$self->{NOECHO}\$(NOOP)"; # eg update MANIFEST
+    my($postop)   = $attribs{POSTOP}   || "$self->{NOECHO}\$(NOOP)"; # eg remove the distdir
+
+    my($to_unix)  = $attribs{TO_UNIX} || ($Is_OS2
+					  ? "$self->{NOECHO}"
+					  . 'test -f tmp.zip && $(RM) tmp.zip;'
+					  . ' $(ZIP) -ll -mr tmp.zip $(DISTVNAME) && unzip -o tmp.zip && $(RM) tmp.zip'
+					  : "$self->{NOECHO}\$(NOOP)");
+
+    my($ci)       = $attribs{CI}       || 'ci -u';
+    my($rcs_label)= $attribs{RCS_LABEL}|| 'rcs -Nv$(VERSION_SYM): -q';
+    my($dist_cp)  = $attribs{DIST_CP}  || 'best';
+    my($dist_default) = $attribs{DIST_DEFAULT} || 'tardist';
+
+    push @m, "
+DISTVNAME = ${name}-$version
+TAR  = $tar
+TARFLAGS = $tarflags
+ZIP  = $zip
+ZIPFLAGS = $zipflags
+COMPRESS = $compress
+SUFFIX = $suffix
+SHAR = $shar
+PREOP = $preop
+POSTOP = $postop
+TO_UNIX = $to_unix
+CI = $ci
+RCS_LABEL = $rcs_label
+DIST_CP = $dist_cp
+DIST_DEFAULT = $dist_default
+";
+    join "", @m;
+}
+
+=item dist_basics (o)
+
+Defines the targets distclean, distcheck, skipcheck, manifest.
+
+=cut
+
+sub dist_basics {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+distclean :: realclean distcheck
+};
+
+    push @m, q{
+distcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&fullcheck";' \\
+		-e 'fullcheck();'
+};
+
+    push @m, q{
+skipcheck :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&skipcheck";' \\
+		-e 'skipcheck();'
+};
+
+    push @m, q{
+manifest :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&mkmanifest";' \\
+		-e 'mkmanifest();'
+};
+    join "", @m;
+}
+
+=item dist_ci (o)
+
+Defines a check in target for RCS.
+
+=cut
+
+sub dist_ci {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+ci :
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use ExtUtils::Manifest "&maniread";' \\
+		-e '@all = keys %{ maniread() };' \\
+		-e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \\
+		-e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+};
+    join "", @m;
+}
+
+=item dist_core (o)
+
+Defeines the targets dist, tardist, zipdist, uutardist, shdist
+
+=cut
+
+sub dist_core {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+dist : $(DIST_DEFAULT)
+	}.$self->{NOECHO}.q{$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
+	    -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "}.$self->{MAKEFILE}.q{";'
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+
+zipdist : $(DISTVNAME).zip
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+	uuencode $(DISTVNAME).tar$(SUFFIX) \\
+		$(DISTVNAME).tar$(SUFFIX) > \\
+		$(DISTVNAME).tar$(SUFFIX)_uu
+
+shdist : distdir
+	$(PREOP)
+	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+};
+    join "", @m;
+}
+
+=item dist_dir (o)
+
+Defines the scratch directory target that will hold the distribution
+before tar-ing (or shar-ing).
+
+=cut
+
+sub dist_dir {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+distdir :
+	$(RM_RF) $(DISTVNAME)
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \\
+		-e 'manicopy(maniread(),"$(DISTVNAME)", "$(DIST_CP)");'
+};
+    join "", @m;
+}
+
+=item dist_test (o)
+
+Defines a target that produces the distribution in the
+scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that
+subdirectory.
+
+=cut
+
+sub dist_test {
+    my($self) = shift;
+    my @m;
+    push @m, q{
+disttest : distdir
+	cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
+	cd $(DISTVNAME) && $(MAKE)
+	cd $(DISTVNAME) && $(MAKE) test
+};
+    join "", @m;
+}
+
+=item dlsyms (o)
+
+Used by AIX and VMS to define DL_FUNCS and DL_VARS and write the *.exp
+files.
+
+=cut
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    return '' unless ($^O eq 'aix' && $self->needs_linking() );
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+    my(@m);
+
+    push(@m,"
+dynamic :: $self->{BASEEXT}.exp
+
+") unless $self->{SKIPHASH}{'dynamic'}; # dynamic and static are subs, so...
+
+    push(@m,"
+static :: $self->{BASEEXT}.exp
+
+") unless $self->{SKIPHASH}{'static'};  # we avoid a warning if we tick them
+
+    push(@m,"
+$self->{BASEEXT}.exp: Makefile.PL
+",'	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
+	Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
+	neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\'
+');
+
+    join('',@m);
+}
+
+=item dynamic (o)
+
+Defines the dynamic target.
+
+=cut
+
+sub dynamic {
+# --- Dynamic Loading Sections ---
+
+    my($self) = shift;
+    '
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make dynamic"
+#dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
+dynamic :: '.$self->{MAKEFILE}.' $(INST_DYNAMIC) $(INST_BOOT)
+	'.$self->{NOECHO}.'$(NOOP)
+';
+}
+
+=item dynamic_bs (o)
+
+Defines targets for bootstrap files.
+
+=cut
+
+sub dynamic_bs {
+    my($self, %attribs) = @_;
+    return '
+BOOTSTRAP =
+' unless $self->has_link_code();
+
+    return '
+BOOTSTRAP = '."$self->{BASEEXT}.bs".'
+
+# As Mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)/.exists
+	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+		-e \'use ExtUtils::Mkbootstrap;\' \
+		-e \'Mkbootstrap("$(BASEEXT)","$(BSLOADLIBS)");\'
+	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
+	$(CHMOD) 644 $@
+
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
+	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
+	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
+	$(CHMOD) 644 $@
+';
+}
+
+=item dynamic_lib (o)
+
+Defines how to produce the *.so (or equivalent) files.
+
+=cut
+
+sub dynamic_lib {
+    my($self, %attribs) = @_;
+    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my($armaybe) = $attribs{ARMAYBE} || $self->{ARMAYBE} || ":";
+    my($ldfrom) = '$(LDFROM)';
+    $armaybe = 'ar' if ($^O eq 'dec_osf' and $armaybe eq ':');
+    my(@m);
+    push(@m,'
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+ARMAYBE = '.$armaybe.'
+OTHERLDFLAGS = '.$otherldflags.'
+INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+');
+    if ($armaybe ne ':'){
+	$ldfrom = 'tmp$(LIB_EXT)';
+	push(@m,'	$(ARMAYBE) cr '.$ldfrom.' $(OBJECT)'."\n");
+	push(@m,'	$(RANLIB) '."$ldfrom\n");
+    }
+    $ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
+    push(@m,'	LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) '.$ldfrom.
+		' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
+    push @m, '
+	$(CHMOD) 755 $@
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+=item exescan
+
+Deprecated method. Use libscan instead.
+
+=cut
+
+sub exescan {
+    my($self,$path) = @_;
+    $path;
+}
+
+=item extliblist
+
+Called by init_others, and calls ext ExtUtils::Liblist. See
+L<ExtUtils::Liblist> for details.
+
+=cut
+
+sub extliblist {
+    my($self,$libs) = @_;
+    require ExtUtils::Liblist;
+    $self->ext($libs, $Verbose);
+}
+
+=item file_name_is_absolute
+
+Takes as argument a path and returns true, it it is an absolute path.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file) = @_;
+    $file =~ m:^/: ;
+}
+
+=item find_perl
+
+Finds the executables PERL and FULLPERL
+
+=cut
+
+sub find_perl {
+    my($self, $ver, $names, $dirs, $trace) = @_;
+    my($name, $dir);
+    if ($trace >= 2){
+	print "Looking for perl $ver by these names:
+@$names
+in these dirs:
+@$dirs
+";
+    }
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my $abs;
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->canonpath($self->catfile($self->curdir, $name));
+	    }
+	    print "Checking $abs\n" if ($trace >= 2);
+	    next unless $self->maybe_command($abs);
+	    print "Executing $abs\n" if ($trace >= 2);
+	    if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+	        print "Using PERL=$abs\n" if $trace;
+	        return $abs;
+	    }
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+=head2 Methods to actually produce chunks of text for the Makefile
+
+The methods here are called in the order specified by
+@ExtUtils::MakeMaker::MM_Sections. This manpage reflects the order as
+well as possible. Some methods call each other, so in doubt refer to
+the code.
+
+=item force (o)
+
+Just writes FORCE:
+
+=cut
+
+sub force {
+    my($self) = shift;
+    '# Phony target to force checking subdirectories.
+FORCE:
+';
+}
+
+=item guess_name
+
+Guess the name of this package by examining the working directory's
+name. MakeMaker calls this only if the developer has not supplied a
+NAME attribute.
+
+=cut
+
+# ';
+
+sub guess_name {
+    my($self) = @_;
+    use Cwd 'cwd';
+    my $name = basename(cwd());
+    $name =~ s|[\-_][\d\.\-]+$||;   # this is new with MM 5.00, we
+                                    # strip minus or underline
+                                    # followed by a float or some such
+    print "Warning: Guessing NAME [$name] from current directory name.\n";
+    $name;
+}
+
+=item has_link_code
+
+Returns true if C, XS, MYEXTLIB or similar objects exist within this
+object that need a compiler. Does not descend into subdirectories as
+needs_linking() does.
+
+=cut
+
+sub has_link_code {
+    my($self) = shift;
+    return $self->{HAS_LINK_CODE} if defined $self->{HAS_LINK_CODE};
+    if ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB}){
+	$self->{HAS_LINK_CODE} = 1;
+	return 1;
+    }
+    return $self->{HAS_LINK_CODE} = 0;
+}
+
+=item init_dirscan
+
+Initializes DIR, XS, PM, C, O_FILES, H, PL_FILES, MAN*PODS, EXE_FILES.
+
+=cut
+
+sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
+    my($self) = @_;
+    my($name, %dir, %xs, %c, %h, %ignore, %pl_files, %manifypods);
+    local(%pm); #the sub in find() has to see this hash
+    $ignore{'test.pl'} = 1;
+    $ignore{'makefile.pl'} = 1 if $Is_VMS;
+    foreach $name ($self->lsdir($self->curdir)){
+	next if $name eq $self->curdir or $name eq $self->updir or $ignore{$name};
+	next unless $self->libscan($name);
+	if (-d $name){
+	    next if -l $name; # We do not support symlinks at all
+	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
+	} elsif ($name =~ /\.xs$/){
+	    my($c); ($c = $name) =~ s/\.xs$/.c/;
+	    $xs{$name} = $c;
+	    $c{$c} = 1;
+	} elsif ($name =~ /\.c(pp|xx|c)?$/i){  # .c .C .cpp .cxx .cc
+	    $c{$name} = 1
+		unless $name =~ m/perlmain\.c/; # See MAP_TARGET
+	} elsif ($name =~ /\.h$/i){
+	    $h{$name} = 1;
+	} elsif ($name =~ /\.(p[ml]|pod)$/){
+	    $pm{$name} = $self->catfile('$(INST_LIBDIR)',$name);
+	} elsif ($name =~ /\.PL$/ && $name ne "Makefile.PL") {
+	    ($pl_files{$name} = $name) =~ s/\.PL$// ;
+	} elsif ($Is_VMS && $name =~ /\.pl$/ && $name ne 'makefile.pl' &&
+	         $name ne 'test.pl') {  # case-insensitive filesystem
+	    ($pl_files{$name} = $name) =~ s/\.pl$// ;
+	}
+    }
+
+    # Some larger extensions often wish to install a number of *.pm/pl
+    # files into the library in various locations.
+
+    # The attribute PMLIBDIRS holds an array reference which lists
+    # subdirectories which we should search for library files to
+    # install. PMLIBDIRS defaults to [ 'lib', $self->{BASEEXT} ].  We
+    # recursively search through the named directories (skipping any
+    # which don't exist or contain Makefile.PL files).
+
+    # For each *.pm or *.pl file found $self->libscan() is called with
+    # the default installation path in $_[1]. The return value of
+    # libscan defines the actual installation location.  The default
+    # libscan function simply returns the path.  The file is skipped
+    # if libscan returns false.
+
+    # The default installation location passed to libscan in $_[1] is:
+    #
+    #  ./*.pm		=> $(INST_LIBDIR)/*.pm
+    #  ./xyz/...	=> $(INST_LIBDIR)/xyz/...
+    #  ./lib/...	=> $(INST_LIB)/...
+    #
+    # In this way the 'lib' directory is seen as the root of the actual
+    # perl library whereas the others are relative to INST_LIBDIR
+    # (which includes PARENT_NAME). This is a subtle distinction but one
+    # that's important for nested modules.
+
+    $self->{PMLIBDIRS} = ['lib', $self->{BASEEXT}]
+	unless $self->{PMLIBDIRS};
+
+    #only existing directories that aren't in $dir are allowed
+
+    # Avoid $_ wherever possible:
+    # @{$self->{PMLIBDIRS}} = grep -d && !$dir{$_}, @{$self->{PMLIBDIRS}};
+    my (@pmlibdirs) = @{$self->{PMLIBDIRS}};
+    my ($pmlibdir);
+    @{$self->{PMLIBDIRS}} = ();
+    foreach $pmlibdir (@pmlibdirs) {
+	-d $pmlibdir && !$dir{$pmlibdir} && push @{$self->{PMLIBDIRS}}, $pmlibdir;
+    }
+
+    if (@{$self->{PMLIBDIRS}}){
+	print "Searching PMLIBDIRS: @{$self->{PMLIBDIRS}}\n"
+	    if ($Verbose >= 2);
+	require File::Find;
+	File::Find::find(sub {
+	    if (-d $_){
+		if ($_ eq "CVS" || $_ eq "RCS"){
+		    $File::Find::prune = 1;
+		}
+		return;
+	    }
+	    my($path, $prefix) = ($File::Find::name, '$(INST_LIBDIR)');
+	    my($striplibpath,$striplibname);
+	    $prefix =  '$(INST_LIB)' if (($striplibpath = $path) =~ s:^(\W*)lib\W:$1:);
+	    ($striplibname,$striplibpath) = fileparse($striplibpath);
+	    my($inst) = $self->catfile($prefix,$striplibpath,$striplibname);
+	    local($_) = $inst; # for backwards compatibility
+	    $inst = $self->libscan($inst);
+	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
+	    return unless $inst;
+	    $pm{$path} = $inst;
+	}, @{$self->{PMLIBDIRS}});
+    }
+
+    $self->{DIR} = [sort keys %dir] unless $self->{DIR};
+    $self->{XS}  = \%xs             unless $self->{XS};
+    $self->{PM}  = \%pm             unless $self->{PM};
+    $self->{C}   = [sort keys %c]   unless $self->{C};
+    my(@o_files) = @{$self->{C}};
+    $self->{O_FILES} = [grep s/\.c(pp|xx|c)?$/$self->{OBJ_EXT}/i, @o_files] ;
+    $self->{H}   = [sort keys %h]   unless $self->{H};
+    $self->{PL_FILES} = \%pl_files unless $self->{PL_FILES};
+
+    # Set up names of manual pages to generate from pods
+    if ($self->{MAN1PODS}) {
+    } elsif ( $self->{INST_MAN1DIR} =~ /^(none|\s*)$/ ) {
+    	$self->{MAN1PODS} = {};
+    } else {
+	my %manifypods = ();
+	if ( exists $self->{EXE_FILES} ) {
+	    foreach $name (@{$self->{EXE_FILES}}) {
+#		use FileHandle ();
+#		my $fh = new FileHandle;
+		local *FH;
+		my($ispod)=0;
+		# one day test, if $/ can be set to '' safely (is the bug fixed that was in 5.001m?)
+#		if ($fh->open("<$name")) {
+		if (open(FH,"<$name")) {
+#		    while (<$fh>) {
+		    while (<FH>) {
+			if (/^=head1\s+\w+/) {
+			    $ispod=1;
+			    last;
+			}
+		    }
+#		    $fh->close;
+		    close FH;
+		} else {
+		    # If it doesn't exist yet, we assume, it has pods in it
+		    $ispod = 1;
+		}
+		if( $ispod ) {
+		    $manifypods{$name} = $self->catfile('$(INST_MAN1DIR)',basename($name).'.$(MAN1EXT)');
+		}
+	    }
+	}
+	$self->{MAN1PODS} = \%manifypods;
+    }
+    if ($self->{MAN3PODS}) {
+    } elsif ( $self->{INST_MAN3DIR} =~ /^(none|\s*)$/ ) {
+    	$self->{MAN3PODS} = {};
+    } else {
+	my %manifypods = (); # we collect the keys first, i.e. the files
+			     # we have to convert to pod
+	foreach $name (keys %{$self->{PM}}) {
+	    if ($name =~ /\.pod$/ ) {
+		$manifypods{$name} = $self->{PM}{$name};
+	    } elsif ($name =~ /\.p[ml]$/ ) {
+#		use FileHandle ();
+#		my $fh = new FileHandle;
+		local *FH;
+		my($ispod)=0;
+#		$fh->open("<$name");
+		if (open(FH,"<$name")) {
+		    #		while (<$fh>) {
+		    while (<FH>) {
+			if (/^=head1\s+\w+/) {
+			    $ispod=1;
+			    last;
+			}
+		    }
+		    #		$fh->close;
+		    close FH;
+		} else {
+		    $ispod = 1;
+		}
+		if( $ispod ) {
+		    $manifypods{$name} = $self->{PM}{$name};
+		}
+	    }
+	}
+
+	# Remove "Configure.pm" and similar, if it's not the only pod listed
+	# To force inclusion, just name it "Configure.pod", or override MAN3PODS
+	foreach $name (keys %manifypods) {
+	    if ($name =~ /(config|setup).*\.pm/i) {
+		delete $manifypods{$name};
+		next;
+	    }
+	    my($manpagename) = $name;
+	    unless ($manpagename =~ s!^\W*lib\W+!!) { # everything below lib is ok
+		$manpagename = $self->catfile(split(/::/,$self->{PARENT_NAME}),$manpagename);
+	    }
+	    $manpagename =~ s/\.p(od|m|l)$//;
+	    $manpagename = $self->replace_manpage_separator($manpagename);
+	    $manifypods{$name} = $self->catfile("\$(INST_MAN3DIR)","$manpagename.\$(MAN3EXT)");
+	}
+	$self->{MAN3PODS} = \%manifypods;
+    }
+}
+
+=item init_main
+
+Initializes NAME, FULLEXT, BASEEXT, PARENT_NAME, DLBASE, PERL_SRC,
+PERL_LIB, PERL_ARCHLIB, PERL_INC, INSTALLDIRS, INST_*, INSTALL*,
+PREFIX, CONFIG, AR, AR_STATIC_ARGS, LD, OBJ_EXT, LIB_EXT, MAP_TARGET,
+LIBPERL_A, VERSION_FROM, VERSION, DISTNAME, VERSION_SYM.
+
+=cut
+
+sub init_main {
+    my($self) = @_;
+
+    # --- Initialize Module Name and Paths
+
+    # NAME    = Foo::Bar::Oracle
+    # FULLEXT = Foo/Bar/Oracle
+    # BASEEXT = Oracle
+    # ROOTEXT = Directory part of FULLEXT with leading /. !!! Deprecated from MM 5.32 !!!
+    # PARENT_NAME = Foo::Bar
+### Only UNIX:
+###    ($self->{FULLEXT} =
+###     $self->{NAME}) =~ s!::!/!g ; #eg. BSD/Foo/Socket
+    $self->{FULLEXT} = $self->catdir(split /::/, $self->{NAME});
+
+
+    # Copied from DynaLoader:
+
+    my(@modparts) = split(/::/,$self->{NAME});
+    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.
+    if (defined &DynaLoader::mod2fname) {
+        $modfname = &DynaLoader::mod2fname(\@modparts);
+    } elsif ($Is_OS2) {                # Need manual correction if run with miniperl:-(
+        $modfname = substr($modfname, 0, 7) . '_';
+    }
+
+
+    ($self->{PARENT_NAME}, $self->{BASEEXT}) = $self->{NAME} =~ m!([\w:]+::)?(\w+)$! ;
+
+    if (defined &DynaLoader::mod2fname or $Is_OS2) {
+	# As of 5.001m, dl_os2 appends '_'
+	$self->{DLBASE} = $modfname;
+    } else {
+	$self->{DLBASE} = '$(BASEEXT)';
+    }
+
+
+    ### ROOTEXT deprecated from MM 5.32
+###    ($self->{ROOTEXT} =
+###     $self->{FULLEXT}) =~ s#/?\Q$self->{BASEEXT}\E$## ;      #eg. /BSD/Foo
+###    $self->{ROOTEXT} = ($Is_VMS ? '' : '/') . $self->{ROOTEXT} if $self->{ROOTEXT};
+
+
+    # --- Initialize PERL_LIB, INST_LIB, PERL_SRC
+
+    # *Real* information: where did we get these two from? ...
+    my $inc_config_dir = dirname($INC{'Config.pm'});
+    my $inc_carp_dir   = dirname($INC{'Carp.pm'});
+
+    unless ($self->{PERL_SRC}){
+	my($dir);
+	foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir())){
+	    if (
+		-f $self->catfile($dir,"config.sh")
+		&&
+		-f $self->catfile($dir,"perl.h")
+		&&
+		-f $self->catfile($dir,"lib","Exporter.pm")
+	       ) {
+		$self->{PERL_SRC}=$dir ;
+		last;
+	    }
+	}
+    }
+    if ($self->{PERL_SRC}){
+	$self->{PERL_LIB}     ||= $self->catdir("$self->{PERL_SRC}","lib");
+	$self->{PERL_ARCHLIB} = $self->{PERL_LIB};
+	$self->{PERL_INC}     = $self->{PERL_SRC};
+	# catch a situation that has occurred a few times in the past:
+
+	warn <<EOM unless (-s $self->catfile($self->{PERL_SRC},'cflags') or $Is_VMS && -s $self->catfile($self->{PERL_SRC},'perlshr_attr.opt') or $Is_Mac);
+You cannot build extensions below the perl source tree after executing
+a 'make clean' in the perl source tree.
+
+To rebuild extensions distributed with the perl source you should
+simply Configure (to include those extensions) and then build perl as
+normal. After installing perl the source tree can be deleted. It is
+not needed for building extensions by running 'perl Makefile.PL'
+usually without extra arguments.
+
+It is recommended that you unpack and build additional extensions away
+from the perl source tree.
+EOM
+    } else {
+	# we should also consider $ENV{PERL5LIB} here
+	$self->{PERL_LIB}     ||= $Config::Config{privlibexp};
+	$self->{PERL_ARCHLIB} ||= $Config::Config{archlibexp};
+	$self->{PERL_INC}     = $self->catdir("$self->{PERL_ARCHLIB}","CORE"); # wild guess for now
+	my $perl_h;
+	die <<EOM unless (-f ($perl_h = $self->catfile($self->{PERL_INC},"perl.h")));
+Error: Unable to locate installed Perl libraries or Perl source code.
+
+It is recommended that you install perl in a standard location before
+building extensions. You can say:
+
+    $^X Makefile.PL PERL_SRC=/path/to/perl/source/directory
+
+if you have not yet installed perl but still want to build this
+extension now.
+(You get this message, because MakeMaker could not find "$perl_h")
+EOM
+
+#	 print STDOUT "Using header files found in $self->{PERL_INC}\n"
+#	     if $Verbose && $self->needs_linking();
+
+    }
+
+    # We get SITELIBEXP and SITEARCHEXP directly via
+    # Get_from_Config. When we are running standard modules, these
+    # won't matter, we will set INSTALLDIRS to "perl". Otherwise we
+    # set it to "site". I prefer that INSTALLDIRS be set from outside
+    # MakeMaker.
+    $self->{INSTALLDIRS} ||= "site";
+
+    # INST_LIB typically pre-set if building an extension after
+    # perl has been built and installed. Setting INST_LIB allows
+    # you to build directly into, say $Config::Config{privlibexp}.
+    unless ($self->{INST_LIB}){
+
+
+	##### XXXXX We have to change this nonsense
+
+	if (defined $self->{PERL_SRC} and $self->{INSTALLDIRS} eq "perl") {
+	    $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
+	} else {
+	    $self->{INST_LIB} = $self->catdir($self->curdir,"blib","lib");
+	}
+    }
+    $self->{INST_ARCHLIB} ||= $self->catdir($self->curdir,"blib","arch");
+    $self->{INST_BIN} ||= $self->catdir($self->curdir,'blib','bin');
+
+    # INST_EXE is deprecated, should go away March '97
+    $self->{INST_EXE} ||= $self->catdir($self->curdir,'blib','script');
+    $self->{INST_SCRIPT} ||= $self->catdir($self->curdir,'blib','script');
+
+    # The user who requests an installation directory explicitly
+    # should not have to tell us a architecture installation directory
+    # as well We look if a directory exists that is named after the
+    # architecture. If not we take it as a sign that it should be the
+    # same as the requested installation directory. Otherwise we take
+    # the found one.
+    # We do the same thing twice: for privlib/archlib and for sitelib/sitearch
+    my($libpair);
+    for $libpair ({l=>"privlib", a=>"archlib"}, {l=>"sitelib", a=>"sitearch"}) {
+	my $lib = "install$libpair->{l}";
+	my $Lib = uc $lib;
+	my $Arch = uc "install$libpair->{a}";
+	if( $self->{$Lib} && ! $self->{$Arch} ){
+	    my($ilib) = $Config{$lib};
+	    $ilib = VMS::Filespec::unixify($ilib) if $Is_VMS;
+
+	    $self->prefixify($Arch,$ilib,$self->{$Lib});
+
+	    unless (-d $self->{$Arch}) {
+		print STDOUT "Directory $self->{$Arch} not found, thusly\n" if $Verbose;
+		$self->{$Arch} = $self->{$Lib};
+	    }
+	    print STDOUT "Defaulting $Arch to $self->{$Arch}\n" if $Verbose;
+	}
+    }
+
+    # we have to look at the relation between $Config{prefix} and the
+    # requested values. We're going to set the $Config{prefix} part of
+    # all the installation path variables to literally $(PREFIX), so
+    # the user can still say make PREFIX=foo
+    my($prefix) = $Config{'prefix'};
+    $prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
+    unless ($self->{PREFIX}){
+	$self->{PREFIX} = $prefix;
+    }
+    my($install_variable);
+    for $install_variable (qw/
+
+			   INSTALLPRIVLIB INSTALLARCHLIB INSTALLBIN
+			   INSTALLMAN1DIR INSTALLMAN3DIR INSTALLSCRIPT
+			   INSTALLSITELIB INSTALLSITEARCH
+
+			   /) {
+	$self->prefixify($install_variable,$prefix,q[$(PREFIX)]);
+    }
+
+
+    # Now we head at the manpages. Maybe they DO NOT want manpages
+    # installed
+    $self->{INSTALLMAN1DIR} = $Config::Config{installman1dir}
+	unless defined $self->{INSTALLMAN1DIR};
+    unless (defined $self->{INST_MAN1DIR}){
+	if ($self->{INSTALLMAN1DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN1DIR} = $self->{INSTALLMAN1DIR};
+	} else {
+	    $self->{INST_MAN1DIR} = $self->catdir($self->curdir,'blib','man1');
+	}
+    }
+    $self->{MAN1EXT} ||= $Config::Config{man1ext};
+
+    $self->{INSTALLMAN3DIR} = $Config::Config{installman3dir}
+	unless defined $self->{INSTALLMAN3DIR};
+    unless (defined $self->{INST_MAN3DIR}){
+	if ($self->{INSTALLMAN3DIR} =~ /^(none|\s*)$/){
+	    $self->{INST_MAN3DIR} = $self->{INSTALLMAN3DIR};
+	} else {
+	    $self->{INST_MAN3DIR} = $self->catdir($self->curdir,'blib','man3');
+	}
+    }
+    $self->{MAN3EXT} ||= $Config::Config{man3ext};
+
+
+    # Get some stuff out of %Config if we haven't yet done so
+    print STDOUT "CONFIG must be an array ref\n"
+	if ($self->{CONFIG} and ref $self->{CONFIG} ne 'ARRAY');
+    $self->{CONFIG} = [] unless (ref $self->{CONFIG});
+    push(@{$self->{CONFIG}}, @ExtUtils::MakeMaker::Get_from_Config);
+    push(@{$self->{CONFIG}}, 'shellflags') if $Config::Config{shellflags};
+    my(%once_only,$m);
+    foreach $m (@{$self->{CONFIG}}){
+	next if $once_only{$m};
+	print STDOUT "CONFIG key '$m' does not exist in Config.pm\n"
+		unless exists $Config::Config{$m};
+	$self->{uc $m} ||= $Config::Config{$m};
+	$once_only{$m} = 1;
+    }
+
+# This is too dangerous:
+#    if ($^O eq "next") {
+#	$self->{AR} = "libtool";
+#	$self->{AR_STATIC_ARGS} = "-o";
+#    }
+# But I leave it as a placeholder
+
+    $self->{AR_STATIC_ARGS} ||= "cr";
+
+    # These should never be needed
+    $self->{LD} ||= 'ld';
+    $self->{OBJ_EXT} ||= '.o';
+    $self->{LIB_EXT} ||= '.a';
+
+    $self->{MAP_TARGET} ||= "perl";
+
+    $self->{LIBPERL_A} ||= "libperl$self->{LIB_EXT}";
+
+    # make a simple check if we find Exporter
+    warn "Warning: PERL_LIB ($self->{PERL_LIB}) seems not to be a perl library directory
+        (Exporter.pm not found)"
+	unless -f $self->catfile("$self->{PERL_LIB}","Exporter.pm") ||
+        $self->{NAME} eq "ExtUtils::MakeMaker";
+
+    # Determine VERSION and VERSION_FROM
+    ($self->{DISTNAME}=$self->{NAME}) =~ s#(::)#-#g unless $self->{DISTNAME};
+    if ($self->{VERSION_FROM}){
+	$self->{VERSION} = $self->parse_version($self->{VERSION_FROM}) or
+	    Carp::carp "WARNING: Setting VERSION via file '$self->{VERSION_FROM}' failed\n"
+    }
+
+    # strip blanks
+    if ($self->{VERSION}) {
+	$self->{VERSION} =~ s/^\s+//;
+	$self->{VERSION} =~ s/\s+$//;
+    }
+
+    $self->{VERSION} ||= "0.10";
+    ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
+
+
+    # Graham Barr and Paul Marquess had some ideas how to ensure
+    # version compatibility between the *.pm file and the
+    # corresponding *.xs file. The bottomline was, that we need an
+    # XS_VERSION macro that defaults to VERSION:
+    $self->{XS_VERSION} ||= $self->{VERSION};
+
+    # --- Initialize Perl Binary Locations
+
+    # Find Perl 5. The only contract here is that both 'PERL' and 'FULLPERL'
+    # will be working versions of perl 5. miniperl has priority over perl
+    # for PERL to ensure that $(PERL) is usable while building ./ext/*
+    my ($component,@defpath);
+    foreach $component ($self->{PERL_SRC}, $self->path(), $Config::Config{binexp}) {
+	push @defpath, $component if defined $component;
+    }
+    $self->{PERL} =
+        $self->find_perl(5.0, [ $^X, 'miniperl','perl','perl5',"perl$]" ],
+	    \@defpath, $Verbose ) unless ($self->{PERL});
+    # don't check if perl is executable, maybe they have decided to
+    # supply switches with perl
+
+    # Define 'FULLPERL' to be a non-miniperl (used in test: target)
+    ($self->{FULLPERL} = $self->{PERL}) =~ s/miniperl/perl/i
+	unless ($self->{FULLPERL});
+}
+
+=item init_others
+
+Initializes EXTRALIBS, BSLOADLIBS, LDLOADLIBS, LIBS, LD_RUN_PATH,
+OBJECT, BOOTDEP, PERLMAINCC, LDFROM, LINKTYPE, NOOP, FIRST_MAKEFILE,
+MAKEFILE, NOECHO, RM_F, RM_RF, TOUCH, CP, MV, CHMOD, UMASK_NULL
+
+=cut
+
+sub init_others {	# --- Initialize Other Attributes
+    my($self) = shift;
+
+    # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS}
+    # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or
+    # undefined. In any case we turn it into an anon array:
+
+    # May check $Config{libs} too, thus not empty.
+    $self->{LIBS}=[''] unless $self->{LIBS};
+
+    $self->{LIBS}=[$self->{LIBS}] if ref \$self->{LIBS} eq SCALAR;
+    $self->{LD_RUN_PATH} = "";
+    my($libs);
+    foreach $libs ( @{$self->{LIBS}} ){
+	$libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace
+	my(@libs) = $self->extliblist($libs);
+	if ($libs[0] or $libs[1] or $libs[2]){
+	    # LD_RUN_PATH now computed by ExtUtils::Liblist
+	    ($self->{EXTRALIBS}, $self->{BSLOADLIBS}, $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs;
+	    last;
+	}
+    }
+
+    if ( $self->{OBJECT} ) {
+	$self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
+    } else {
+	# init_dirscan should have found out, if we have C files
+	$self->{OBJECT} = "";
+	$self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]};
+    }
+    $self->{OBJECT} =~ s/\n+/ \\\n\t/g;
+    $self->{BOOTDEP}  = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : "";
+    $self->{PERLMAINCC} ||= '$(CC)';
+    $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM};
+
+    # Sanity check: don't define LINKTYPE = dynamic if we're skipping
+    # the 'dynamic' section of MM.  We don't have this problem with
+    # 'static', since we either must use it (%Config says we can't
+    # use dynamic loading) or the caller asked for it explicitly.
+    if (!$self->{LINKTYPE}) {
+       $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'}
+                        ? 'static'
+                        : ($Config::Config{usedl} ? 'dynamic' : 'static');
+    };
+
+    # These get overridden for VMS and maybe some other systems
+    $self->{NOOP}  ||= "sh -c true";
+    $self->{FIRST_MAKEFILE} ||= "Makefile";
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{MAKE_APERL_FILE} ||= "Makefile.aperl";
+    $self->{NOECHO} = '@' unless defined $self->{NOECHO};
+    $self->{RM_F}  ||= "rm -f";
+    $self->{RM_RF} ||= "rm -rf";
+    $self->{TOUCH} ||= "touch";
+    $self->{CP} ||= "cp";
+    $self->{MV} ||= "mv";
+    $self->{CHMOD} ||= "chmod";
+    $self->{UMASK_NULL} ||= "umask 0";
+}
+
+=item install (o)
+
+Defines the install target.
+
+=cut
+
+sub install {
+    my($self, %attribs) = @_;
+    my(@m);
+
+    push @m, q{
+install :: all pure_install doc_install
+
+install_perl :: all pure_perl_install doc_perl_install
+
+install_site :: all pure_site_install doc_site_install
+
+install_ :: install_site
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_install :: pure_$(INSTALLDIRS)_install
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+
+pure__install : pure_site_install
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+	@echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
+		read }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(INSTALLPRIVLIB) \
+		$(INST_ARCHLIB) $(INSTALLARCHLIB) \
+		$(INST_BIN) $(INSTALLBIN) \
+		$(INST_SCRIPT) $(INSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(INSTALLMAN3DIR)
+	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(SITEARCHEXP)','auto','$(FULLEXT)').q{
+
+
+pure_site_install ::
+	}.$self->{NOECHO}.q{$(MOD_INSTALL) \
+		read }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{ \
+		write }.$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q{ \
+		$(INST_LIB) $(INSTALLSITELIB) \
+		$(INST_ARCHLIB) $(INSTALLSITEARCH) \
+		$(INST_BIN) $(INSTALLBIN) \
+		$(INST_SCRIPT) $(INSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(INSTALLMAN3DIR)
+	}.$self->{NOECHO}.q{$(WARN_IF_OLD_PACKLIST) \
+		}.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{
+
+doc_perl_install ::
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"$(NAME)" \
+		"installed into" "$(INSTALLPRIVLIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+doc_site_install ::
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"Module $(NAME)" \
+		"installed into" "$(INSTALLSITELIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+};
+
+    push @m, q{
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+
+uninstall_from_perldirs ::
+	}.$self->{NOECHO}.
+	q{$(UNINSTALL) }.$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q{
+
+uninstall_from_sitedirs ::
+	}.$self->{NOECHO}.
+	q{$(UNINSTALL) }.$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q{
+};
+
+    join("",@m);
+}
+
+=item installbin (o)
+
+Defines targets to install EXE_FILES.
+
+=cut
+
+sub installbin {
+    my($self) = shift;
+    return "" unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
+    return "" unless @{$self->{EXE_FILES}};
+    my(@m, $from, $to, %fromto, @to);
+    push @m, $self->dir_target(qw[$(INST_SCRIPT)]);
+    for $from (@{$self->{EXE_FILES}}) {
+	my($path)= $self->catfile('$(INST_SCRIPT)', basename($from));
+	local($_) = $path; # for backwards compatibility
+	$to = $self->libscan($path);
+	print "libscan($from) => '$to'\n" if ($Verbose >=2);
+	$fromto{$from}=$to;
+    }
+    @to   = values %fromto;
+    push(@m, "
+EXE_FILES = @{$self->{EXE_FILES}}
+
+all :: @to
+
+realclean ::
+	$self->{RM_F} @to
+");
+
+    while (($from,$to) = each %fromto) {
+	last unless defined $from;
+	my $todir = dirname($to);
+	push @m, "
+$to: $from $self->{MAKEFILE} $todir/.exists
+	$self->{NOECHO}$self->{RM_F} $to
+	$self->{CP} $from $to
+";
+    }
+    join "", @m;
+}
+
+=item libscan (o)
+
+Takes a path to a file that is found by init_dirscan and returns false
+if we don't want to include this file in the library. Mainly used to
+exclude RCS, CVS, and SCCS directories from installation.
+
+=cut
+
+# ';
+
+sub libscan {
+    my($self,$path) = @_;
+    return '' if $path =~ m:\b(RCS|CVS|SCCS)\b: ;
+    $path;
+}
+
+=item linkext (o)
+
+Defines the linkext target which in turn defines the LINKTYPE.
+
+=cut
+
+sub linkext {
+    my($self, %attribs) = @_;
+    # LINKTYPE => static or dynamic or ''
+    my($linktype) = defined $attribs{LINKTYPE} ?
+      $attribs{LINKTYPE} : '$(LINKTYPE)';
+    "
+linkext :: $linktype
+	$self->{NOECHO}\$(NOOP)
+";
+}
+
+=item lsdir
+
+Takes as arguments a directory name and a regular expression. Returns
+all entries in the directory that match the regular expression.
+
+=cut
+
+sub lsdir {
+    my($self) = shift;
+    my($dir, $regex) = @_;
+    my(@ls);
+    my $dh = new DirHandle;
+    $dh->open($dir || ".") or return ();
+    @ls = $dh->read;
+    $dh->close;
+    @ls = grep(/$regex/, @ls) if $regex;
+    @ls;
+}
+
+=item macro (o)
+
+Simple subroutine to insert the macros defined by the macro attribute
+into the Makefile.
+
+=cut
+
+sub macro {
+    my($self,%attribs) = @_;
+    my(@m,$key,$val);
+    while (($key,$val) = each %attribs){
+	last unless defined $key;
+	push @m, "$key = $val\n";
+    }
+    join "", @m;
+}
+
+=item makeaperl (o)
+
+Called by staticmake. Defines how to write the Makefile to produce a
+static new perl.
+
+=cut
+
+sub makeaperl {
+    my($self, %attribs) = @_;
+    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) =
+	@attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
+    my(@m);
+    push @m, "
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = $target
+FULLPERL      = $self->{FULLPERL}
+";
+    return join '', @m if $self->{PARENT};
+
+    my($dir) = join ":", @{$self->{DIR}};
+
+    unless ($self->{MAKEAPERL}) {
+	push @m, q{
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+	$(MAKE) -f $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+	}.$self->{NOECHO}.q{echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+	}.$self->{NOECHO}.q{$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+		Makefile.PL DIR=}, $dir, q{ \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=};
+
+	foreach (@ARGV){
+		if( /\s/ ){
+			s/=(.*)/='$1'/;
+		}
+		push @m, " \\\n\t\t$_";
+	}
+#	push @m, map( " \\\n\t\t$_", @ARGV );
+	push @m, "\n";
+
+	return join '', @m;
+    }
+
+
+
+    my($cccmd, $linkcmd, $lperl);
+
+
+    $cccmd = $self->const_cccmd($libperl);
+    $cccmd =~ s/^CCCMD\s*=\s*//;
+    $cccmd =~ s/\$\(INC\)/ -I$self->{PERL_INC} /;
+    $cccmd .= " $Config::Config{cccdlflags}" if ($Config::Config{d_shrplib});
+    $cccmd =~ s/\(CC\)/\(PERLMAINCC\)/;
+
+    # The front matter of the linkcommand...
+    $linkcmd = join ' ', "\$(CC)",
+	    grep($_, @Config{qw(large split ldflags ccdlflags)});
+    $linkcmd =~ s/\s+/ /g;
+
+    # Which *.a files could we make use of...
+    local(%static);
+    require File::Find;
+    File::Find::find(sub {
+	return unless m/\Q$self->{LIB_EXT}\E$/;
+	return if m/^libperl/;
+
+	if( exists $self->{INCLUDE_EXT} ){
+		my $found = 0;
+		my $incl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything not explicitly marked for inclusion.
+		# DynaLoader is implied.
+		foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
+			if( $xx eq $incl ){
+				$found++;
+				last;
+			}
+		}
+		return unless $found;
+	}
+	elsif( exists $self->{EXCLUDE_EXT} ){
+		my $excl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything explicitly marked for exclusion
+		foreach $excl (@{$self->{EXCLUDE_EXT}}){
+			return if( $xx eq $excl );
+		}
+	}
+
+	# don't include the installed version of this extension. I
+	# leave this line here, although it is not necessary anymore:
+	# I patched minimod.PL instead, so that Miniperl.pm won't
+	# enclude duplicates
+
+	# Once the patch to minimod.PL is in the distribution, I can
+	# drop it
+	return if $File::Find::name =~ m:auto/$self->{FULLEXT}/$self->{BASEEXT}$self->{LIB_EXT}$:;
+	use Cwd 'cwd';
+	$static{cwd() . "/" . $_}++;
+    }, grep( -d $_, @{$searchdirs || []}) );
+
+    # We trust that what has been handed in as argument, will be buildable
+    $static = [] unless $static;
+    @static{@{$static}} = (1) x @{$static};
+
+    $extra = [] unless $extra && ref $extra eq 'ARRAY';
+    for (sort keys %static) {
+	next unless /\Q$self->{LIB_EXT}\E$/;
+	$_ = dirname($_) . "/extralibs.ld";
+	push @$extra, $_;
+    }
+
+    grep(s/^/-I/, @{$perlinc || []});
+
+    $target = "perl" unless $target;
+    $tmp = "." unless $tmp;
+
+# MAP_STATIC doesn't look into subdirs yet. Once "all" is made and we
+# regenerate the Makefiles, MAP_STATIC and the dependencies for
+# extralibs.all are computed correctly
+    push @m, "
+MAP_LINKCMD   = $linkcmd
+MAP_PERLINC   = @{$perlinc || []}
+MAP_STATIC    = ",
+join(" \\\n\t", reverse sort keys %static), "
+
+MAP_PRELIBS   = $Config::Config{libs} $Config::Config{cryptlib}
+";
+
+    if (defined $libperl) {
+	($lperl = $libperl) =~ s/\$\(A\)/$self->{LIB_EXT}/;
+    }
+    unless ($libperl && -f $lperl) { # Ilya's code...
+	my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
+	$libperl ||= "libperl$self->{LIB_EXT}";
+	$libperl   = "$dir/$libperl";
+	$lperl   ||= "libperl$self->{LIB_EXT}";
+	$lperl     = "$dir/$lperl";
+	print STDOUT "Warning: $libperl not found
+    If you're going to build a static perl binary, make sure perl is installed
+    otherwise ignore this warning\n"
+		unless (-f $lperl || defined($self->{PERL_SRC}));
+    }
+
+    push @m, "
+MAP_LIBPERL = $libperl
+";
+
+    push @m, "
+\$(INST_ARCHAUTODIR)/extralibs.all: \$(INST_ARCHAUTODIR)/.exists ".join(" \\\n\t", @$extra)."
+	$self->{NOECHO}$self->{RM_F} \$\@
+	$self->{NOECHO}\$(TOUCH) \$\@
+";
+
+    my $catfile;
+    foreach $catfile (@$extra){
+	push @m, "\tcat $catfile >> \$\@\n";
+    }
+
+    push @m, "
+\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
+	\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
+	$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
+	$self->{NOECHO}echo '    make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
+	$self->{NOECHO}echo 'To remove the intermediate files say'
+	$self->{NOECHO}echo '    make -f $makefilename map_clean'
+
+$tmp/perlmain\$(OBJ_EXT): $tmp/perlmain.c
+";
+    push @m, "\tcd $tmp && $cccmd -I\$(PERL_INC) perlmain.c\n";
+
+    push @m, qq{
+$tmp/perlmain.c: $makefilename}, q{
+	}.$self->{NOECHO}.q{echo Writing $@
+	}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -e 'use ExtUtils::Miniperl; \\
+		writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)' > $@.tmp && mv $@.tmp $@
+
+};
+
+    push @m, q{
+doc_inst_perl:
+	}.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+	}.$self->{NOECHO}.q{$(DOC_INSTALL) \
+		"Perl binary $(MAP_TARGET)" \
+		MAP_STATIC "$(MAP_STATIC)" \
+		MAP_EXTRA "`cat $(INST_ARCHAUTODIR)/extralibs.all`" \
+		MAP_LIBPERL "$(MAP_LIBPERL)" \
+		>> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{
+
+};
+
+    push @m, q{
+inst_perl: pure_inst_perl doc_inst_perl
+
+pure_inst_perl: $(MAP_TARGET)
+	}.$self->{CP}.q{ $(MAP_TARGET) }.$self->catfile('$(INSTALLBIN)','$(MAP_TARGET)').q{
+
+clean :: map_clean
+
+map_clean :
+	}.$self->{RM_F}.qq{ $tmp/perlmain\$(OBJ_EXT) $tmp/perlmain.c \$(MAP_TARGET) $makefilename \$(INST_ARCHAUTODIR)/extralibs.all
+};
+
+    join '', @m;
+}
+
+=item makefile (o)
+
+Defines how to rewrite the Makefile.
+
+=cut
+
+sub makefile {
+    my($self) = shift;
+    my @m;
+    # We do not know what target was originally specified so we
+    # must force a manual rerun to be sure. But as it should only
+    # happen very rarely it is not a significant problem.
+    push @m, '
+$(OBJECT) : $(FIRST_MAKEFILE)
+' if $self->{OBJECT};
+
+    push @m, q{
+# We take a very conservative approach here, but it\'s worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+}.$self->{MAKEFILE}.q{ : Makefile.PL $(CONFIGDEP)
+	}.$self->{NOECHO}.q{echo "Makefile out-of-date with respect to $?"
+	}.$self->{NOECHO}.q{echo "Cleaning current config before rebuilding Makefile..."
+	-}.$self->{NOECHO}.q{mv }."$self->{MAKEFILE} $self->{MAKEFILE}.old".q{
+	-$(MAKE) -f }.$self->{MAKEFILE}.q{.old clean >/dev/null 2>&1 || true
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL }.join(" ",map(qq["$_"],@ARGV)).q{
+	}.$self->{NOECHO}.q{echo ">>> Your Makefile has been rebuilt. <<<"
+	}.$self->{NOECHO}.q{echo ">>> Please rerun the make command.  <<<"; false
+
+# To change behavior to :: would be nice, but would break Tk b9.02
+# so you find such a warning below the dist target.
+#}.$self->{MAKEFILE}.q{ :: $(VERSION_FROM)
+#	}.$self->{NOECHO}.q{echo "Warning: Makefile possibly out of date with $(VERSION_FROM)"
+};
+
+    join "", @m;
+}
+
+=item manifypods (o)
+
+Defines targets and routines to translate the pods into manpages and
+put them into the INST_* directories.
+
+=cut
+
+sub manifypods {
+    my($self, %attribs) = @_;
+    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
+    } else {
+	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
+    }
+    unless ($self->perl_script($pod2man_exe)) {
+	# No pod2man but some MAN3PODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program. Please make sure,
+         your pod2man program is in your PATH before you execute 'make'
+
+END
+        $pod2man_exe = "-S pod2man";
+    }
+    my(@m);
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
+q[POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \\
+-e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "].$self->{MAKEFILE}.q[";' \\
+-e 'print "Manifying $$m{$$_}\n";' \\
+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\\047t install $$m{$$_}\n";' \\
+-e 'chmod 0644, $$m{$$_} or warn "chmod 644 $$m{$$_}: $$!\n";}'
+];
+    push @m, "\nmanifypods : ";
+    push @m, join " \\\n\t", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
+
+    push(@m,"\n");
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	push @m, "\t$self->{NOECHO}\$(POD2MAN) \\\n\t";
+	push @m, join " \\\n\t", %{$self->{MAN1PODS}}, %{$self->{MAN3PODS}};
+    }
+    join('', @m);
+}
+
+=item maybe_command
+
+Returns true, if the argument is likely to be a command.
+
+=cut
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d $file;
+    return;
+}
+
+=item maybe_command_in_dirs
+
+method under development. Not yet used. Ask Ilya :-)
+
+=cut
+
+sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
+# Ilya's suggestion. Not yet used, want to understand it first, but at least the code is here
+    my($self, $names, $dirs, $trace, $ver) = @_;
+    my($name, $dir);
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my($abs,$tryabs);
+	    if ($self->file_name_is_absolute($name)) { # /foo/bar
+		$abs = $name;
+	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # bar
+		$abs = $self->catfile($dir, $name);
+	    } else { # foo/bar
+		$abs = $self->catfile($self->curdir, $name);
+	    }
+	    print "Checking $abs for $name\n" if ($trace >= 2);
+	    next unless $tryabs = $self->maybe_command($abs);
+	    print "Substituting $tryabs instead of $abs\n"
+		if ($trace >= 2 and $tryabs ne $abs);
+	    $abs = $tryabs;
+	    if (defined $ver) {
+		print "Executing $abs\n" if ($trace >= 2);
+		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+		    print "Using PERL=$abs\n" if $trace;
+		    return $abs;
+		}
+	    } else { # Do not look for perl
+		return $abs;
+	    }
+	}
+    }
+}
+
+=item needs_linking (o)
+
+Does this module need linking? Looks into subdirectory objects (see
+also has_link_code())
+
+=cut
+
+sub needs_linking {
+    my($self) = shift;
+    my($child,$caller);
+    $caller = (caller(0))[3];
+    Carp::confess("Needs_linking called too early") if $caller =~ /^ExtUtils::MakeMaker::/;
+    return $self->{NEEDS_LINKING} if defined $self->{NEEDS_LINKING};
+    if ($self->has_link_code or $self->{MAKEAPERL}){
+	$self->{NEEDS_LINKING} = 1;
+	return 1;
+    }
+    foreach $child (keys %{$self->{CHILDREN}}) {
+	if ($self->{CHILDREN}->{$child}->needs_linking) {
+	    $self->{NEEDS_LINKING} = 1;
+	    return 1;
+	}
+    }
+    return $self->{NEEDS_LINKING} = 0;
+}
+
+=item nicetext
+
+misnamed method (will have to be changed). The MM_Unix method just
+returns the argument without further processing.
+
+On VMS used to insure that colons marking targets are preceded by
+space - most Unix Makes don't need this, but it's necessary under VMS
+to distinguish the target delimiter from a colon appearing as part of
+a filespec.
+
+=cut
+
+sub nicetext {
+    my($self,$text) = @_;
+    $text;
+}
+
+=item parse_version
+
+parse a file and return what you think is $VERSION in this file set to
+
+=cut
+
+sub parse_version {
+    my($self,$parsefile) = @_;
+    my $result;
+    local *FH;
+    local $/ = "\n";
+    open(FH,$parsefile) or die "Could not open '$parsefile': $!";
+    my $inpod = 0;
+    while (<FH>) {
+	$inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod;
+	next if $inpod;
+	chop;
+	next unless /\$(([\w\:\']*)\bVERSION)\b.*\=/;
+	local $ExtUtils::MakeMaker::module_version_variable = $1;
+	my($thispackage) = $2 || $current_package;
+	$thispackage =~ s/:+$//;
+	my($eval) = "$_;";
+	eval $eval;
+	die "Could not eval '$eval' in $parsefile: $@" if $@;
+	$result = $ {$ExtUtils::MakeMaker::module_version_variable} || 0;
+	last;
+    }
+    close FH;
+    return $result;
+}
+
+
+=item pasthru (o)
+
+Defines the string that is passed to recursive make calls in
+subdirectories.
+
+=cut
+
+sub pasthru {
+    my($self) = shift;
+    my(@m,$key);
+
+    my(@pasthru);
+
+    foreach $key (qw(LIBPERL_A LINKTYPE PREFIX OPTIMIZE)){
+	push @pasthru, "$key=\"\$($key)\"";
+    }
+
+    push @m, "\nPASTHRU = ", join ("\\\n\t", @pasthru), "\n";
+    join "", @m;
+}
+
+=item path
+
+Takes no argument, returns the environment variable PATH as an array.
+
+=cut
+
+sub path {
+    my($self) = @_;
+    my $path_sep = $Is_OS2 ? ";" : ":";
+    my $path = $ENV{PATH};
+    $path =~ s:\\:/:g if $Is_OS2;
+    my @path = split $path_sep, $path;
+}
+
+=item perl_script
+
+Takes one argument, a file name, and returns the file name, if the
+argument is likely to be a perl script. On MM_Unix this is true for
+any ordinary, readable file.
+
+=cut
+
+sub perl_script {
+    my($self,$file) = @_;
+    return $file if -r $file && -f _;
+    return;
+}
+
+=item perldepend (o)
+
+Defines the dependency from all *.h files that come with the perl
+distribution.
+
+=cut
+
+sub perldepend {
+    my($self) = shift;
+    my(@m);
+    push @m, q{
+# Check for unpropogated config.sh changes. Should never happen.
+# We do NOT just update config.h because that is not sufficient.
+# An out of date config.h is not fatal but complains loudly!
+$(PERL_INC)/config.h: $(PERL_SRC)/config.sh
+	-}.$self->{NOECHO}.q{echo "Warning: $(PERL_INC)/config.h out of date with $(PERL_SRC)/config.sh"; false
+
+$(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh
+	}.$self->{NOECHO}.q{echo "Warning: $(PERL_ARCHLIB)/Config.pm may be out of date with $(PERL_SRC)/config.sh"
+	cd $(PERL_SRC) && $(MAKE) lib/Config.pm
+} if $self->{PERL_SRC};
+
+    return join "", @m unless $self->needs_linking;
+
+    push @m, q{
+PERL_HDRS = \
+$(PERL_INC)/EXTERN.h       $(PERL_INC)/gv.h           $(PERL_INC)/pp.h       \
+$(PERL_INC)/INTERN.h       $(PERL_INC)/handy.h        $(PERL_INC)/proto.h    \
+$(PERL_INC)/XSUB.h         $(PERL_INC)/hv.h           $(PERL_INC)/regcomp.h  \
+$(PERL_INC)/av.h           $(PERL_INC)/keywords.h     $(PERL_INC)/regexp.h   \
+$(PERL_INC)/config.h       $(PERL_INC)/mg.h           $(PERL_INC)/scope.h    \
+$(PERL_INC)/cop.h          $(PERL_INC)/op.h           $(PERL_INC)/sv.h	     \
+$(PERL_INC)/cv.h           $(PERL_INC)/opcode.h       $(PERL_INC)/unixish.h  \
+$(PERL_INC)/dosish.h       $(PERL_INC)/patchlevel.h   $(PERL_INC)/util.h     \
+$(PERL_INC)/embed.h        $(PERL_INC)/perl.h				     \
+$(PERL_INC)/form.h         $(PERL_INC)/perly.h
+
+$(OBJECT) : $(PERL_HDRS)
+} if $self->{OBJECT};
+
+    push @m, join(" ", values %{$self->{XS}})." : \$(XSUBPPDEPS)\n"  if %{$self->{XS}};
+
+    join "\n", @m;
+}
+
+=item pm_to_blib
+
+Defines target that copies all files in the hash PM to their
+destination and autosplits them. See L<ExtUtils::Install/pm_to_blib>
+
+=cut
+
+sub pm_to_blib {
+    my $self = shift;
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
+    return q{
+pm_to_blib: $(TO_INST_PM)
+	}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
+	"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
+        -e 'pm_to_blib({qw{$(PM_TO_BLIB)}},"}.$autodir.q{")'
+	}.$self->{NOECHO}.q{$(TOUCH) $@
+};
+}
+
+=item post_constants (o)
+
+Returns an empty string per default. Dedicated to overrides from
+within Makefile.PL after all constants have been defined.
+
+=cut
+
+sub post_constants{
+    my($self) = shift;
+    "";
+}
+
+=item post_initialize (o)
+
+Returns an ampty string per default. Used in Makefile.PLs to add some
+chunk of text to the Makefile after the object is initialized.
+
+=cut
+
+sub post_initialize {
+    my($self) = shift;
+    "";
+}
+
+=item postamble (o)
+
+Returns an empty string. Can be used in Makefile.PLs to write some
+text to the Makefile at the end.
+
+=cut
+
+sub postamble {
+    my($self) = shift;
+    "";
+}
+
+=item prefixify
+
+Check a path variable in $self from %Config, if it contains a prefix,
+and replace it with another one.
+
+Takes as arguments an attribute name, a search prefix and a
+replacement prefix. Changes the attribute in the object.
+
+=cut
+
+sub prefixify {
+    my($self,$var,$sprefix,$rprefix) = @_;
+    $self->{uc $var} ||= $Config{lc $var};
+    $self->{uc $var} = VMS::Filespec::unixpath($self->{uc $var}) if $Is_VMS;
+    $self->{uc $var} =~ s/\Q$sprefix\E/$rprefix/;
+}
+
+=item processPL (o)
+
+Defines targets to run *.PL files.
+
+=cut
+
+sub processPL {
+    my($self) = shift;
+    return "" unless $self->{PL_FILES};
+    my(@m, $plfile);
+    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+	push @m, "
+all :: $self->{PL_FILES}->{$plfile}
+
+$self->{PL_FILES}->{$plfile} :: $plfile
+	\$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
+";
+    }
+    join "", @m;
+}
+
+=item realclean (o)
+
+Defines the realclean target.
+
+=cut
+
+sub realclean {
+    my($self, %attribs) = @_;
+    my(@m);
+    push(@m,'
+# Delete temporary files (via clean) and also delete installed files
+realclean purge ::  clean
+');
+    # realclean subdirectories first (already cleaned)
+    my $sub = "\t-cd %s && test -f %s && \$(MAKE) %s realclean\n";
+    foreach(@{$self->{DIR}}){
+	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old"));
+	push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",''));
+    }
+    push(@m, "	$self->{RM_RF} \$(INST_AUTODIR) \$(INST_ARCHAUTODIR)\n");
+    if( $self->has_link_code ){
+        push(@m, "	$self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n");
+        push(@m, "	$self->{RM_F} \$(INST_STATIC)\n");
+    }
+    push(@m, "	$self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n");
+    my(@otherfiles) = ($self->{MAKEFILE},
+		       "$self->{MAKEFILE}.old"); # Makefiles last
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@m, "	$self->{RM_RF} @otherfiles\n") if @otherfiles;
+    push(@m, "	$attribs{POSTOP}\n")       if $attribs{POSTOP};
+    join("", @m);
+}
+
+=item replace_manpage_separator
+
+Takes the name of a package, which may be a nested package, in the
+form Foo/Bar and replaces the slash with C<::>. Returns the replacement.
+
+=cut
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man =~ s,/+,::,g;
+    $man;
+}
+
+=item static (o)
+
+Defines the static target.
+
+=cut
+
+sub static {
+# --- Static Loading Sections ---
+
+    my($self) = shift;
+    '
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+#static :: '.$self->{MAKEFILE}.' $(INST_STATIC) $(INST_PM)
+static :: '.$self->{MAKEFILE}.' $(INST_STATIC)
+	'.$self->{NOECHO}.'$(NOOP)
+';
+}
+
+=item static_lib (o)
+
+Defines how to produce the *.a (or equivalent) files.
+
+=cut
+
+sub static_lib {
+    my($self) = @_;
+# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
+#    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code;
+
+    my(@m);
+    push(@m, <<'END');
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+	$(RM_RF) $@
+END
+    # If this extension has it's own library (eg SDBM_File)
+    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
+    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
+
+    push @m,
+q{	$(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+	$(CHMOD) 755 $@
+};
+
+# Old mechanism - still available:
+
+    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)/ext.libs}."\n\n"
+	if $self->{PERL_SRC};
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('', "\n",@m);
+}
+
+=item staticmake (o)
+
+Calls makeaperl.
+
+=cut
+
+sub staticmake {
+    my($self, %attribs) = @_;
+    my(@static);
+
+    my(@searchdirs)=($self->{PERL_ARCHLIB}, $self->{SITEARCHEXP},  $self->{INST_ARCHLIB});
+
+    # And as it's not yet built, we add the current extension
+    # but only if it has some C code (or XS code, which implies C code)
+    if (@{$self->{C}}) {
+	@static = $self->catfile($self->{INST_ARCHLIB},
+				 "auto",
+				 $self->{FULLEXT},
+				 "$self->{BASEEXT}$self->{LIB_EXT}"
+				);
+    }
+
+    # Either we determine now, which libraries we will produce in the
+    # subdirectories or we do it at runtime of the make.
+
+    # We could ask all subdir objects, but I cannot imagine, why it
+    # would be necessary.
+
+    # Instead we determine all libraries for the new perl at
+    # runtime.
+    my(@perlinc) = ($self->{INST_ARCHLIB}, $self->{INST_LIB}, $self->{PERL_ARCHLIB}, $self->{PERL_LIB});
+
+    $self->makeaperl(MAKE	=> $self->{MAKEFILE},
+		     DIRS	=> \@searchdirs,
+		     STAT	=> \@static,
+		     INCL	=> \@perlinc,
+		     TARGET	=> $self->{MAP_TARGET},
+		     TMP	=> "",
+		     LIBPERL	=> $self->{LIBPERL_A}
+		    );
+}
+
+=item subdir_x (o)
+
+Helper subroutine for subdirs
+
+=cut
+
+sub subdir_x {
+    my($self, $subdir) = @_;
+    my(@m);
+    qq{
+
+subdirs ::
+	$self->{NOECHO}cd $subdir && \$(MAKE) all \$(PASTHRU)
+
+};
+}
+
+=item subdirs (o)
+
+Defines targets to process subdirectories.
+
+=cut
+
+sub subdirs {
+# --- Sub-directory Sections ---
+    my($self) = shift;
+    my(@m,$dir);
+    # This method provides a mechanism to automatically deal with
+    # subdirectories containing further Makefile.PL scripts.
+    # It calls the subdir_x() method for each subdirectory.
+    foreach $dir (@{$self->{DIR}}){
+	push(@m, $self->subdir_x($dir));
+####	print "Including $dir subdirectory\n";
+    }
+    if (@m){
+	unshift(@m, "
+# The default clean, realclean and test targets in this Makefile
+# have automatically been given entries for each subdir.
+
+");
+    } else {
+	push(@m, "\n# none")
+    }
+    join('',@m);
+}
+
+=item test (o)
+
+Defines the test targets.
+
+=cut
+
+sub test {
+# --- Test and Installation Sections ---
+
+    my($self, %attribs) = @_;
+    my($tests) = $attribs{TESTS} || (-d "t" ? "t/*.t" : "");
+    my(@m);
+    push(@m,"
+TEST_VERBOSE=0
+TEST_TYPE=test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TESTDB_SW = -d
+
+testdb :: testdb_\$(LINKTYPE)
+
+test :: \$(TEST_TYPE)
+");
+    push(@m, map("\t$self->{NOECHO}cd $_ && test -f $self->{MAKEFILE} && \$(MAKE) test \$(PASTHRU)\n",
+		 @{$self->{DIR}}));
+    push(@m, "\t$self->{NOECHO}echo 'No tests defined for \$(NAME) extension.'\n")
+	unless $tests or -f "test.pl" or @{$self->{DIR}};
+    push(@m, "\n");
+
+    push(@m, "test_dynamic :: pure_all\n");
+    push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "\n");
+
+    push(@m, "testdb_dynamic :: pure_all\n");
+    push(@m, $self->test_via_script('$(FULLPERL) $(TESTDB_SW)', '$(TEST_FILE)'));
+    push(@m, "\n");
+
+    # Occasionally we may face this degenerate target:
+    push @m, "test_ : test_dynamic\n\n";
+
+    if ($self->needs_linking()) {
+	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
+	push(@m, $self->test_via_harness('./$(MAP_TARGET)', $tests)) if $tests;
+	push(@m, $self->test_via_script('./$(MAP_TARGET)', 'test.pl')) if -f "test.pl";
+	push(@m, "\n");
+	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
+	push(@m, $self->test_via_script('./$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
+	push(@m, "\n");
+    } else {
+	push @m, "test_static :: test_dynamic\n";
+	push @m, "testdb_static :: testdb_dynamic\n";
+    }
+    join("", @m);
+}
+
+=item test_via_harness (o)
+
+Helper method to write the test targets
+
+=cut
+
+sub test_via_harness {
+    my($self, $perl, $tests) = @_;
+    "\tPERL_DL_NONLAZY=1 $perl".q! -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' !."$tests\n";
+}
+
+=item test_via_script (o)
+
+Other helper method for test.
+
+=cut
+
+sub test_via_script {
+    my($self, $perl, $script) = @_;
+    qq{\tPERL_DL_NONLAZY=1 $perl}.q{ -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) }.qq{$script
+};
+}
+
+=item tool_autosplit (o)
+
+Defines a simple perl call that runs autosplit. May be deprecated by
+pm_to_blib soon.
+
+=cut
+
+sub tool_autosplit {
+# --- Tool Sections ---
+
+    my($self, %attribs) = @_;
+    my($asl) = "";
+    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
+    q{
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;}.$asl.q{autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
+};
+}
+
+=item tools_other (o)
+
+Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
+the Makefile. Also defines the perl programs MKPATH,
+WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
+
+=cut
+
+sub tools_other {
+    my($self) = shift;
+    my @m;
+    my $bin_sh = $Config{sh} || '/bin/sh';
+    push @m, qq{
+SHELL = $bin_sh
+};
+
+    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TOUCH UMASK_NULL / ) {
+	push @m, "$_ = $self->{$_}\n";
+    }
+
+
+    push @m, q{
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -wle '$$"="/"; foreach $$p (@ARGV){' \\
+-e 'next if -d $$p; my(@p); foreach(split(/\//,$$p)){' \\
+-e 'push(@p,$$_); next if -d "@p/"; print "mkdir @p" if 0;' \\
+-e 'mkdir("@p",0777)||die $$! } } exit 0;'
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -we 'open F, ">$$ARGV[1]"; close F;' \\
+-e 'utime ((stat("$$ARGV[0]"))[8,9], $$ARGV[1])'
+};
+
+    return join "", @m if $self->{PARENT};
+
+    push @m, q{
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\
+-e 'print "WARNING: I have found an old package in\n";' \\
+-e 'print "\t$$ARGV[0].\n";' \\
+-e 'print "Please make sure the two installations are not conflicting\n";'
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e 'install({@ARGV},"$(VERBINST)",0,"$(UNINST)");'
+
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";print "=head3 ", scalar(localtime), ": C<", shift, ">";' \
+-e 'print "=over 4";' \
+-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
+-e 'print "=back";'
+
+UNINSTALL =   $(PERL) -MExtUtils::Install \
+-e 'uninstall($$ARGV[0],1);'
+
+};
+
+    return join "", @m;
+}
+
+=item tool_xsubpp (o)
+
+Determines typemaps, xsubpp version, prototype behaviour.
+
+=cut
+
+sub tool_xsubpp {
+    my($self) = shift;
+    return "" unless $self->needs_linking;
+    my($xsdir)  = $self->catdir($self->{PERL_LIB},"ExtUtils");
+    my(@tmdeps) = $self->catdir('$(XSUBPPDIR)','typemap');
+    if( $self->{TYPEMAPS} ){
+	my $typemap;
+	foreach $typemap (@{$self->{TYPEMAPS}}){
+		if( ! -f  $typemap ){
+			warn "Typemap $typemap not found.\n";
+		}
+		else{
+			push(@tmdeps,  $typemap);
+		}
+	}
+    }
+    push(@tmdeps, "typemap") if -f "typemap";
+    my(@tmargs) = map("-typemap $_", @tmdeps);
+    if( exists $self->{XSOPT} ){
+ 	unshift( @tmargs, $self->{XSOPT} );
+    }
+
+
+    my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,"xsubpp"));
+
+    # What are the correct thresholds for version 1 && 2 Paul?
+    if ( $xsubpp_version > 1.923 ){
+	$self->{XSPROTOARG} = "" unless defined $self->{XSPROTOARG};
+    } else {
+	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
+	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
+	Your version of xsubpp is $xsubpp_version and cannot handle this.
+	Please upgrade to a more recent version of xsubpp.
+};
+	} else {
+	    $self->{XSPROTOARG} = "";
+	}
+    }
+
+    return qq{
+XSUBPPDIR = $xsdir
+XSUBPP = \$(XSUBPPDIR)/xsubpp
+XSPROTOARG = $self->{XSPROTOARG}
+XSUBPPDEPS = @tmdeps
+XSUBPPARGS = @tmargs
+};
+};
+
+sub xsubpp_version
+{
+    my($self,$xsubpp) = @_;
+    return $Xsubpp_Version if defined $Xsubpp_Version; # global variable
+
+    my ($version) ;
+
+    # try to figure out the version number of the xsubpp on the system
+
+    # first try the -v flag, introduced in 1.921 & 2.000a2
+
+    return "" unless $self->needs_linking;
+
+    my $command = "$self->{PERL} -I$self->{PERL_LIB} $xsubpp -v 2>&1";
+    print "Running $command\n" if $Verbose >= 2;
+    $version = `$command` ;
+    warn "Running '$command' exits with status " . ($?>>8) if $?;
+    chop $version ;
+
+    return $Xsubpp_Version = $1 if $version =~ /^xsubpp version (.*)/ ;
+
+    # nope, then try something else
+
+    my $counter = '000';
+    my ($file) = 'temp' ;
+    $counter++ while -e "$file$counter"; # don't overwrite anything
+    $file .= $counter;
+
+    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
+    print F <<EOM ;
+MODULE = fred PACKAGE = fred
+
+int
+fred(a)
+        int     a;
+EOM
+
+    close F ;
+
+    $command = "$self->{PERL} $xsubpp $file 2>&1";
+    print "Running $command\n" if $Verbose >= 2;
+    my $text = `$command` ;
+    warn "Running '$command' exits with status " . ($?>>8) if $?;
+    unlink $file ;
+
+    # gets 1.2 -> 1.92 and 2.000a1
+    return $Xsubpp_Version = $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+
+    # it is either 1.0 or 1.1
+    return $Xsubpp_Version = 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+
+    # none of the above, so 1.0
+    return $Xsubpp_Version = "1.0" ;
+}
+
+=item top_targets (o)
+
+Defines the targets all, subdirs, config, and O_FILES
+
+=cut
+
+sub top_targets {
+# --- Target Sections ---
+
+    my($self) = shift;
+    my(@m);
+    push @m, '
+#all ::	config $(INST_PM) subdirs linkext manifypods
+
+all :: pure_all manifypods
+	'.$self->{NOECHO}.'$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+	'.$self->{NOECHO}.'$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: $(INST_ARCHAUTODIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+
+config :: $(INST_AUTODIR)/.exists
+	'.$self->{NOECHO}.'$(NOOP)
+';
+
+    push @m, qq{
+config :: Version_check
+	$self->{NOECHO}\$(NOOP)
+
+} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
+
+    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
+
+    if (%{$self->{MAN1PODS}}) {
+	push @m, qq[
+config :: \$(INST_MAN1DIR)/.exists
+	$self->{NOECHO}\$(NOOP)
+
+];
+	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    }
+    if (%{$self->{MAN3PODS}}) {
+	push @m, qq[
+config :: \$(INST_MAN3DIR)/.exists
+	$self->{NOECHO}\$(NOOP)
+
+];
+	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
+    }
+
+    push @m, '
+$(O_FILES): $(H_FILES)
+' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
+
+    push @m, q{
+help:
+	perldoc ExtUtils::MakeMaker
+};
+
+    push @m, q{
+Version_check:
+	}.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+		-MExtUtils::MakeMaker=Version_check \
+		-e 'Version_check("$(MM_VERSION)")'
+};
+
+    join('',@m);
+}
+
+=item writedoc
+
+Obsolete, depecated method. Not used since Version 5.21.
+
+=cut
+
+sub writedoc {
+# --- perllocal.pod section ---
+    my($self,$what,$name,@attribs)=@_;
+    my $time = localtime;
+    print "=head2 $time: $what C<$name>\n\n=over 4\n\n=item *\n\n";
+    print join "\n\n=item *\n\n", map("C<$_>",@attribs);
+    print "\n\n=back\n\n";
+}
+
+=item xs_c (o)
+
+Defines the suffix rules to compile XS files to C.
+
+=cut
+
+sub xs_c {
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    '
+.xs.c:
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && mv $*.tc $@
+';
+}
+
+=item xs_o (o)
+
+Defines suffix rules to go from XS to object files directly. This is
+only intended for broken make implementations.
+
+=cut
+
+sub xs_o {	# many makes are too dumb to use xs_c then c_o
+    my($self) = shift;
+    return '' unless $self->needs_linking();
+    '
+.xs$(OBJ_EXT):
+	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && mv xstmp.c $*.c
+	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+';
+}
+
+1;
+
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+__END__
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
new file mode 100644
index 00000000000..9a382284d11
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MM_VMS.pm
@@ -0,0 +1,2254 @@
+#   MM_VMS.pm
+#   MakeMaker default methods for VMS
+#   This package is inserted into @ISA of MakeMaker's MM before the
+#   built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
+#
+#   Author:  Charles Bailey  bailey@genetics.upenn.edu
+
+package ExtUtils::MM_VMS;
+$ExtUtils::MM_VMS::Revision=$ExtUtils::MM_VMS::Revision = '5.35 (23-Jun-1996)';
+unshift @MM::ISA, 'ExtUtils::MM_VMS';
+
+use Config;
+require Exporter;
+use VMS::Filespec;
+use File::Basename;
+
+Exporter::import('ExtUtils::MakeMaker', '$Verbose', '&neatvalue');
+
+=head1 NAME
+
+ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
+
+=head1 SYNOPSIS
+
+ use ExtUtils::MM_VMS; # Done internally by ExtUtils::MakeMaker if needed
+
+=head1 DESCRIPTION
+
+See ExtUtils::MM_Unix for a documentation of the methods provided
+there. This package overrides the implementation of these methods, not
+the semantics.
+
+=head2 Methods always loaded
+
+=item eliminate_macros
+
+Expands MM[KS]/Make macros in a text string, using the contents of
+identically named elements of C<%$self>, and returns the result
+as a file specification in Unix syntax.
+
+=cut
+
+sub eliminate_macros {
+    my($self,$path) = @_;
+    unless ($path) {
+	print "eliminate_macros('') = ||\n" if $Verbose >= 3;
+	return '';
+    }
+    my($npath) = unixify($path);
+    my($head,$macro,$tail);
+
+    # perform m##g in scalar context so it acts as an iterator
+    while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#g) { 
+        if ($self->{$2}) {
+            ($head,$macro,$tail) = ($1,$2,$3);
+            ($macro = unixify($self->{$macro})) =~ s#/$##;
+            $npath = "$head$macro$tail";
+        }
+    }
+    print "eliminate_macros($path) = |$npath|\n" if $Verbose >= 3;
+    $npath;
+}
+
+=item fixpath
+
+Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
+in any directory specification, in order to avoid juxtaposing two
+VMS-syntax directories when MM[SK] is run.  Also expands expressions which
+are all macro, so that we can tell how long the expansion is, and avoid
+overrunning DCL's command buffer when MM[KS] is running.
+
+If optional second argument has a TRUE value, then the return string is
+a VMS-syntax directory specification, otherwise it is a VMS-syntax file
+specification.
+
+=cut
+
+sub fixpath {
+    my($self,$path,$force_path) = @_;
+    unless ($path) {
+	print "eliminate_macros('') = ||\n" if $Verbose >= 3;
+	return '';
+    }
+    my($fixedpath,$prefix,$name);
+
+    if ($path =~ m#^\$\(.+\)$# || $path =~ m#[/:>\]]#) { 
+        if ($force_path or $path =~ /(?:DIR\)|\])$/) {
+            $fixedpath = vmspath($self->eliminate_macros($path));
+        }
+        else {
+            $fixedpath = vmsify($self->eliminate_macros($path));
+        }
+    }
+    elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#)) && $self->{$prefix}) {
+        my($vmspre) = vmspath($self->{$prefix}) || ''; # is it a dir or just a name?
+        $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    else {
+        $fixedpath = $path;
+        $fixedpath = vmspath($fixedpath) if $force_path;
+    }
+    # Convert names without directory or type to paths
+    if (!$force_path and $fixedpath !~ /[:>(.\]]/) { $fixedpath = vmspath($fixedpath); }
+    print "fixpath($path) = |$fixedpath|\n" if $Verbose >= 3;
+    $fixedpath;
+}
+
+=item catdir
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax directory specification.
+
+=cut
+
+sub catdir {
+    my($self,@dirs) = @_;
+    my($dir) = pop @dirs;
+    @dirs = grep($_,@dirs);
+    my($rslt);
+    if (@dirs) {
+      my($path) = (@dirs == 1 ? $dirs[0] : $self->catdir(@dirs));
+      my($spath,$sdir) = ($path,$dir);
+      $spath =~ s/.dir$//; $sdir =~ s/.dir$//; 
+      $sdir = $self->eliminate_macros($sdir) unless $sdir =~ /^[\w\-]+$/;
+      $rslt = vmspath($self->eliminate_macros($spath)."/$sdir");
+    }
+    else { $rslt = vmspath($dir); }
+    print "catdir(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
+    $rslt;
+}
+
+=item catfile
+
+Concatenates a list of file specifications, and returns the result as a
+VMS-syntax directory specification.
+
+=cut
+
+sub catfile {
+    my($self,@files) = @_;
+    my($file) = pop @files;
+    @files = grep($_,@files);
+    my($rslt);
+    if (@files) {
+      my($path) = (@files == 1 ? $files[0] : $self->catdir(@files));
+      my($spath) = $path;
+      $spath =~ s/.dir$//;
+      if ( $spath =~ /^[^\)\]\/:>]+\)$/ && basename($file) eq $file) { $rslt = "$spath$file"; }
+      else {
+          $rslt = $self->eliminate_macros($spath);
+          $rslt = vmsify($rslt.($rslt ? '/' : '').unixify($file));
+      }
+    }
+    else { $rslt = vmsify($file); }
+    print "catfile(",join(',',@_[1..$#_]),") = |$rslt|\n" if $Verbose >= 3;
+    $rslt;
+}
+
+=item curdir (override)
+
+Returns a string representing of the current directory.
+
+=cut
+
+sub curdir {
+    return '[]';
+}
+
+=item rootdir (override)
+
+Returns a string representing of the root directory.
+
+=cut
+
+sub rootdir {
+    return '';
+}
+
+=item updir (override)
+
+Returns a string representing of the parent directory.
+
+=cut
+
+sub updir {
+    return '[-]';
+}
+
+package ExtUtils::MM_VMS;
+
+sub ExtUtils::MM_VMS::guess_name;
+sub ExtUtils::MM_VMS::find_perl;
+sub ExtUtils::MM_VMS::path;
+sub ExtUtils::MM_VMS::maybe_command;
+sub ExtUtils::MM_VMS::maybe_command_in_dirs;
+sub ExtUtils::MM_VMS::perl_script;
+sub ExtUtils::MM_VMS::file_name_is_absolute;
+sub ExtUtils::MM_VMS::replace_manpage_separator;
+sub ExtUtils::MM_VMS::init_others;
+sub ExtUtils::MM_VMS::constants;
+sub ExtUtils::MM_VMS::const_loadlibs;
+sub ExtUtils::MM_VMS::cflags;
+sub ExtUtils::MM_VMS::const_cccmd;
+sub ExtUtils::MM_VMS::pm_to_blib;
+sub ExtUtils::MM_VMS::tool_autosplit;
+sub ExtUtils::MM_VMS::tool_xsubpp;
+sub ExtUtils::MM_VMS::xsubpp_version;
+sub ExtUtils::MM_VMS::tools_other;
+sub ExtUtils::MM_VMS::dist;
+sub ExtUtils::MM_VMS::c_o;
+sub ExtUtils::MM_VMS::xs_c;
+sub ExtUtils::MM_VMS::xs_o;
+sub ExtUtils::MM_VMS::top_targets;
+sub ExtUtils::MM_VMS::dlsyms;
+sub ExtUtils::MM_VMS::dynamic_lib;
+sub ExtUtils::MM_VMS::dynamic_bs;
+sub ExtUtils::MM_VMS::static_lib;
+sub ExtUtils::MM_VMS::manifypods;
+sub ExtUtils::MM_VMS::processPL;
+sub ExtUtils::MM_VMS::installbin;
+sub ExtUtils::MM_VMS::subdir_x;
+sub ExtUtils::MM_VMS::clean;
+sub ExtUtils::MM_VMS::realclean;
+sub ExtUtils::MM_VMS::dist_basics;
+sub ExtUtils::MM_VMS::dist_core;
+sub ExtUtils::MM_VMS::dist_dir;
+sub ExtUtils::MM_VMS::dist_test;
+sub ExtUtils::MM_VMS::install;
+sub ExtUtils::MM_VMS::perldepend;
+sub ExtUtils::MM_VMS::makefile;
+sub ExtUtils::MM_VMS::test;
+sub ExtUtils::MM_VMS::test_via_harness;
+sub ExtUtils::MM_VMS::test_via_script;
+sub ExtUtils::MM_VMS::makeaperl;
+sub ExtUtils::MM_VMS::ext;
+sub ExtUtils::MM_VMS::nicetext;
+
+#use SelfLoader;
+sub AUTOLOAD {
+    my $code;
+    if (defined fileno(DATA)) {
+	my $fh = select DATA;
+	my $o = $/;			# For future reads from the file.
+	$/ = "\n__END__\n";
+	$code = <DATA>;
+	$/ = $o;
+	select $fh;
+	close DATA;
+	eval $code;
+	if ($@) {
+	    $@ =~ s/ at .*\n//;
+	    Carp::croak $@;
+	}
+    } else {
+	warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; 
+    }
+    defined(&$AUTOLOAD) or die "Myloader inconsistency error";
+    goto &$AUTOLOAD;
+}
+
+1;
+
+#__DATA__
+
+=head2 SelfLoaded methods
+
+Those methods which override default MM_Unix methods are marked
+"(override)", while methods unique to MM_VMS are marked "(specific)".
+For overridden methods, documentation is limited to an explanation
+of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
+documentation for more details.
+
+=item guess_name (override)
+
+Try to determine name of extension being built.  We begin with the name
+of the current directory.  Since VMS filenames are case-insensitive,
+however, we look for a F<.pm> file whose name matches that of the current
+directory (presumably the 'main' F<.pm> file for this extension), and try
+to find a C<package> statement from which to obtain the Mixed::Case
+package name.
+
+=cut
+
+sub guess_name {
+    my($self) = @_;
+    my($defname,$defpm);
+    local *PM;
+
+    $defname = basename(fileify($ENV{'DEFAULT'}));
+    $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
+    $defpm = $defname;
+    if (open(PM,"${defpm}.pm")){
+        while (<PM>) {
+            if (/^\s*package\s+([^;]+)/i) {
+                $defname = $1;
+                last;
+            }
+        }
+        print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
+                     "defaulting package name to $defname\n"
+            if eof(PM);
+        close PM;
+    }
+    else {
+        print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
+                     "defaulting package name to $defname\n";
+    }
+    $defname =~ s#[\d.\-_]+$##;
+    $defname;
+}
+
+=item find_perl (override)
+
+Use VMS file specification syntax and CLI commands to find and
+invoke Perl images.
+
+=cut
+
+sub find_perl{
+    my($self, $ver, $names, $dirs, $trace) = @_;
+    my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
+    # Check in relative directories first, so we pick up the current
+    # version of Perl if we're running MakeMaker as part of the main build.
+    @sdirs = sort { my($absb) = file_name_is_absolute($a);
+                    my($absb) = file_name_is_absolute($b);
+                    if ($absa && $absb) { return $a cmp $b }
+                    else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
+                  } @$dirs;
+    # Check miniperl before perl, and check names likely to contain
+    # version numbers before "generic" names, so we pick up an
+    # executable that's less likely to be from an old installation.
+    @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
+                     my($bb) = $b =~ m!([^:>\]/]+)$!;
+                     substr($ba,0,1) cmp substr($bb,0,1)
+                     or -1*(length($ba) <=> length($bb)) } @$names;
+    if ($trace){
+	print "Looking for perl $ver by these names:\n";
+	print "\t@snames,\n";
+	print "in these dirs:\n";
+	print "\t@sdirs\n";
+    }
+    foreach $dir (@sdirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@snames){
+	    if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
+	    else                     { push(@cand,$self->fixpath($name));      }
+	}
+    }
+    foreach $name (@cand) {
+	print "Checking $name\n" if ($trace >= 2);
+	next unless $vmsfile = $self->maybe_command($name);
+	$vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
+	print "Executing $vmsfile\n" if ($trace >= 2);
+	if (`MCR $vmsfile -e "require $ver; print ""VER_OK\n"""` =~ /VER_OK/) {
+	    print "Using PERL=MCR $vmsfile\n" if $trace;
+	    return "MCR $vmsfile"
+	}
+    }
+    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
+    0; # false and not empty
+}
+
+=item path (override)
+
+Translate logical name DCL$PATH as a searchlist, rather than trying
+to C<split> string value of C<$ENV{'PATH'}>.
+
+=cut
+
+sub path {
+    my(@dirs,$dir,$i);
+    while ($dir = $ENV{'DCL$PATH;' . $i++}) { push(@dirs,$dir); }
+    @dirs;
+}
+
+=item maybe_command (override)
+
+Follows VMS naming conventions for executable files.
+If the name passed in doesn't exactly match an executable file,
+appends F<.Exe> to check for executable image, and F<.Com> to check
+for DCL procedure.  If this fails, checks F<Sys$Share:> for an
+executable file having the name specified.  Finally, appends F<.Exe>
+and checks again.
+
+=cut
+
+sub maybe_command {
+    my($self,$file) = @_;
+    return $file if -x $file && ! -d _;
+    return "$file.exe" if -x "$file.exe";
+    return "$file.com" if -x "$file.com";
+    if ($file !~ m![/:>\]]!) {
+	my($shrfile) = 'Sys$Share:' . $file;
+	return $file if -x $shrfile && ! -d _;
+	return "$file.exe" if -x "$shrfile.exe";
+    }
+    return 0;
+}
+
+=item maybe_command_in_dirs (override)
+
+Uses DCL argument quoting on test command line.
+
+=cut
+
+sub maybe_command_in_dirs {	# $ver is optional argument if looking for perl
+    my($self, $names, $dirs, $trace, $ver) = @_;
+    my($name, $dir);
+    foreach $dir (@$dirs){
+	next unless defined $dir; # $self->{PERL_SRC} may be undefined
+	foreach $name (@$names){
+	    my($abs,$tryabs);
+	    if ($self->file_name_is_absolute($name)) {
+		$abs = $name;
+	    } else {
+		$abs = $self->catfile($dir, $name);
+	    }
+	    print "Checking $abs for $name\n" if ($trace >= 2);
+	    next unless $tryabs = $self->maybe_command($abs);
+	    print "Substituting $tryabs instead of $abs\n" 
+		if ($trace >= 2 and $tryabs ne $abs);
+	    $abs = $tryabs;
+	    if (defined $ver) {
+		print "Executing $abs\n" if ($trace >= 2);
+		if (`$abs -e 'require $ver; print "VER_OK\n" ' 2>&1` =~ /VER_OK/) {
+		    print "Using PERL=$abs\n" if $trace;
+		    return $abs;
+		}
+	    } else { # Do not look for perl
+		return $abs;
+	    }
+	}
+    }
+}
+
+=item perl_script (override)
+
+If name passed in doesn't specify a readable file, appends F<.pl> and
+tries again, since it's customary to have file types on all files
+under VMS.
+
+=cut
+
+sub perl_script {
+    my($self,$file) = @_;
+    return $file if -r $file && ! -d _;
+    return "$file.pl" if -r "$file.pl" && ! -d _;
+    return '';
+}
+
+=item file_name_is_absolute (override)
+
+Checks for VMS directory spec as well as Unix separators.
+
+=cut
+
+sub file_name_is_absolute {
+    my($self,$file);
+    $file =~ m!^/! or $file =~ m![:<\[][^.\-]!;
+}
+
+=item replace_manpage_separator
+
+Use as separator a character which is legal in a VMS-syntax file name.
+
+=cut
+
+sub replace_manpage_separator {
+    my($self,$man) = @_;
+    $man = unixify($man);
+    $man =~ s#/+#__#g;
+    $man;
+}
+
+=item init_others (override)
+
+Provide VMS-specific forms of various utility commands, then hand
+off to the default MM_Unix method.
+
+=cut
+
+sub init_others {
+    my($self) = @_;
+
+    $self->{NOOP} = "\t@ Continue";
+    $self->{FIRST_MAKEFILE} ||= 'Descrip.MMS';
+    $self->{MAKE_APERL_FILE} ||= 'Makeaperl.MMS';
+    $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
+    $self->{NOECHO} ||= '@ ';
+    $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"';
+    $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"';
+    $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"';
+    $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"';  # expect Unix syntax from MakeMaker
+    $self->{CP} = 'Copy/NoConfirm';
+    $self->{MV} = 'Rename/NoConfirm';
+    $self->{UMASK_NULL} = "\t!";  
+    &ExtUtils::MM_Unix::init_others;
+}
+
+=item constants (override)
+
+Fixes up numerous file and directory macros to insure VMS syntax
+regardless of input syntax.  Also adds a few VMS-specific macros
+and makes lists of files comma-separated.
+
+=cut
+
+sub constants {
+    my($self) = @_;
+    my(@m,$def,$macro);
+
+    if ($self->{DEFINE} ne '') {
+	my(@defs) = split(/\s+/,$self->{DEFINE});
+	foreach $def (@defs) {
+	    next unless $def;
+	    $def =~ s/^-D//;
+	    $def = "\"$def\"" if $def =~ /=/;
+	}
+	$self->{DEFINE} = join ',',@defs;
+    }
+
+    if ($self->{OBJECT} =~ /\s/) {
+	$self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
+	$self->{OBJECT} = map($self->fixpath($_),split(/,?\s+/,$self->{OBJECT}));
+    }
+    $self->{LDFROM} = join(' ',map($self->fixpath($_),split(/,?\s+/,$self->{LDFROM})));
+
+    if ($self->{'INC'} && $self->{INC} !~ m!/Include=!i) {
+	my(@val) = ( '/Include=(' );
+	my(@includes) = split(/\s+/,$self->{INC});
+	my($plural);
+	foreach (@includes) {
+	    s/^-I//;
+	    push @val,', ' if $plural++;
+	    push @val,$self->fixpath($_,1);
+	}
+	$self->{INC} = join('',@val,')');
+    }
+
+    # Fix up directory specs
+    $self->{ROOTEXT} = $self->{ROOTEXT} ? $self->fixpath($self->{ROOTEXT},1)
+                                        : '[]';
+    foreach $macro ( qw [
+            INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB
+            INSTALLARCHLIB INSTALLSCRIPT INSTALLBIN PERL_LIB PERL_ARCHLIB
+            PERL_INC PERL_SRC FULLEXT INST_MAN1DIR INSTALLMAN1DIR
+            INST_MAN3DIR INSTALLMAN3DIR INSTALLSITELIB INSTALLSITEARCH
+            SITELIBEXP SITEARCHEXP ] ) {
+	next unless defined $self->{$macro};
+	$self->{$macro} = $self->fixpath($self->{$macro},1);
+    }
+    $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC},q(VMS))
+	if ($self->{PERL_SRC});
+                        
+
+
+    # Fix up file specs
+    foreach $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKE_APERL_FILE MYEXTLIB] ) {
+	next unless defined $self->{$macro};
+	$self->{$macro} = $self->fixpath($self->{$macro});
+    }
+
+    foreach $macro (qw/
+	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION
+	      INST_BIN INST_EXE INST_LIB INST_ARCHLIB INST_SCRIPT PREFIX
+	      INSTALLDIRS INSTALLPRIVLIB  INSTALLARCHLIB INSTALLSITELIB
+	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
+	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
+	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS
+	      PERL_INC PERL FULLPERL
+	      / ) {
+	next unless defined $self->{$macro};
+	push @m, "$macro = $self->{$macro}\n";
+    }
+
+
+    push @m, q[
+VERSION_MACRO = VERSION
+DEFINE_VERSION = "$(VERSION_MACRO)=""$(VERSION)"""
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = "$(XS_VERSION_MACRO)=""$(XS_VERSION)"""
+
+MAKEMAKER = ],$self->catfile($self->{PERL_LIB},'ExtUtils','MakeMaker.pm'),qq[
+MM_VERSION = $ExtUtils::MakeMaker::VERSION
+MM_REVISION = $ExtUtils::MakeMaker::Revision
+MM_VMS_REVISION = $ExtUtils::MM_VMS::Revision
+
+# FULLEXT = Pathname for extension directory (eg DBD/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT.
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+];
+
+    for $tmp (qw/
+	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
+	      LDFROM LINKTYPE
+	      /	) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+    for $tmp (qw/ XS MAN1PODS MAN3PODS PM /) {
+	next unless defined $self->{$tmp};
+	my(%tmp,$key);
+	for $key (keys %{$self->{$tmp}}) {
+	    $tmp{$self->fixpath($key)} = $self->fixpath($self->{$tmp}{$key});
+	}
+	$self->{$tmp} = \%tmp;
+    }
+
+    for $tmp (qw/ C O_FILES H /) {
+	next unless defined $self->{$tmp};
+	my(@tmp,$val);
+	for $val (@{$self->{$tmp}}) {
+	    push(@tmp,$self->fixpath($val));
+	}
+	$self->{$tmp} = \@tmp;
+    }
+
+    push @m,'
+
+# Handy lists of source code files:
+XS_FILES = ',join(', ', sort keys %{$self->{XS}}),'
+C_FILES  = ',join(', ', @{$self->{C}}),'
+O_FILES  = ',join(', ', @{$self->{O_FILES}} ),'
+H_FILES  = ',join(', ', @{$self->{H}}),'
+MAN1PODS = ',join(', ', sort keys %{$self->{MAN1PODS}}),'
+MAN3PODS = ',join(', ', sort keys %{$self->{MAN3PODS}}),'
+
+';
+
+    for $tmp (qw/
+	      INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT
+	      /) {
+	next unless defined $self->{$tmp};
+	push @m, "$tmp = $self->{$tmp}\n";
+    }
+
+push @m,"
+.SUFFIXES : \$(OBJ_EXT) .c .cpp .cxx .xs
+
+# Here is the Config.pm that we are using/depend on
+CONFIGDEP = \$(PERL_ARCHLIB)Config.pm, \$(PERL_INC)config.h \$(VERSION_FROM)
+
+# Where to put things:
+INST_LIBDIR = ",($self->{'INST_LIBDIR'} = $self->catdir($self->{INST_LIB},$self->{ROOTEXT})),"
+INST_ARCHLIBDIR = ",($self->{'INST_ARCHLIBDIR'} = $self->catdir($self->{INST_ARCHLIB},$self->{ROOTEXT})),"
+
+INST_AUTODIR = ",($self->{'INST_AUTODIR'} = $self->catdir($self->{INST_LIB},'auto',$self->{FULLEXT})),'
+INST_ARCHAUTODIR = ',($self->{'INST_ARCHAUTODIR'} = $self->catdir($self->{INST_ARCHLIB},'auto',$self->{FULLEXT})),'
+';
+
+    if ($self->has_link_code()) {
+	push @m,'
+INST_STATIC = $(INST_ARCHAUTODIR)$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)$(BASEEXT).$(DLEXT)
+INST_BOOT = $(INST_ARCHAUTODIR)$(BASEEXT).bs
+';
+    } else {
+	push @m,'
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+EXPORT_LIST = $(BASEEXT).opt
+PERL_ARCHIVE = ',($ENV{'PERLSHR'} ? $ENV{'PERLSHR'} : 'Sys$Share:PerlShr.Exe'),'
+';
+    }
+
+    $self->{TO_INST_PM} = [ sort keys %{$self->{PM}} ];
+    $self->{PM_TO_BLIB} = [ %{$self->{PM}} ];
+    push @m,'
+TO_INST_PM = ',join(', ',@{$self->{TO_INST_PM}}),'
+
+PM_TO_BLIB = ',join(', ',@{$self->{PM_TO_BLIB}}),'
+';
+
+    join('',@m);
+}
+
+=item const_loadlibs (override)
+
+Basically a stub which passes through library specfications provided
+by the caller.  Will be updated or removed when VMS support is added
+to ExtUtils::Liblist.
+
+=cut
+
+sub const_loadlibs{
+    my($self) = @_;
+    my (@m);
+    push @m, "
+# $self->{NAME} might depend on some other libraries.
+# (These comments may need revising:)
+#
+# Dependent libraries can be linked in one of three ways:
+#
+#  1.  (For static extensions) by the ld command when the perl binary
+#      is linked with the extension library. See EXTRALIBS below.
+#
+#  2.  (For dynamic extensions) by the ld command when the shared
+#      object is built/linked. See LDLOADLIBS below.
+#
+#  3.  (For dynamic extensions) by the DynaLoader when the shared
+#      object is loaded. See BSLOADLIBS below.
+#
+# EXTRALIBS =	List of libraries that need to be linked with when
+#		linking a perl binary which includes this extension
+#		Only those libraries that actually exist are included.
+#		These are written to a file and used when linking perl.
+#
+# LDLOADLIBS =	List of those libraries which can or must be linked into
+#		the shared library when created using ld. These may be
+#		static or dynamic libraries.
+#		LD_RUN_PATH is a colon separated list of the directories
+#		in LDLOADLIBS. It is passed as an environment variable to
+#		the process that links the shared library.
+#
+# BSLOADLIBS =	List of those libraries that are needed but can be
+#		linked in dynamically at run time on this platform.
+#		SunOS/Solaris does not need this because ld records
+#		the information (from LDLOADLIBS) into the object file.
+#		This list is used to create a .bs (bootstrap) file.
+#
+EXTRALIBS  = ",map($self->fixpath($_) . ' ',$self->{'EXTRALIBS'}),"
+BSLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'BSLOADLIBS'}),"
+LDLOADLIBS = ",map($self->fixpath($_) . ' ',$self->{'LDLOADLIBS'}),"\n";
+
+    join('',@m);
+}
+
+=item cflags (override)
+
+Bypass shell script and produce qualifiers for CC directly (but warn
+user if a shell script for this extension exists).  Fold multiple
+/Defines into one, and do the same with /Includes, since some C
+compilers pay attention to only one instance of these qualifiers
+on the command line.
+
+=cut
+
+sub cflags {
+    my($self,$libperl) = @_;
+    my($quals) = $Config{'ccflags'};
+    my($name,$sys,@m);
+    my($optimize) = '/Optimize';
+
+    ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
+    print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
+         " required to modify CC command for $self->{'BASEEXT'}\n"
+    if ($Config{$name});
+
+    # Deal with $self->{DEFINE} here since some C compilers pay attention
+    # to only one /Define clause on command line, so we have to
+    # conflate the ones from $Config{'cc'} and $self->{DEFINE}
+    if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
+	$quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
+	         "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
+    }
+    else {
+	$quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
+	          '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))';
+    }
+
+    $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
+    if ($libperl =~ /libperl(\w+)\./i) {
+        my($type) = uc $1;
+        my(%map) = ( 'D'  => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
+                     'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
+                     'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
+        $quals =~ s:/define=\(([^\)]+)\):/Define=($1,$map{$type}):i
+    }
+
+    # Likewise with $self->{INC} and /Include
+    my($incstr) = '/Include=($(PERL_INC)';
+    if ($self->{'INC'}) {
+	my(@includes) = split(/\s+/,$self->{INC});
+	foreach (@includes) {
+	    s/^-I//;
+	    $incstr .= ', '.$self->fixpath($_,1);
+	}
+    }
+    if ($quals =~ m:(.*)/include=\(?([^\(\/\)\s]+)\)?(.*):i) {
+	$quals = "$1$incstr,$2)$3";
+    }
+    else { $quals .= "$incstr)"; }
+
+    $optimize = '/Debug/NoOptimize'
+	if ($self->{OPTIMIZE} =~ /-g/ or $self->{OPTIMIZE} =~ m!/Debug!i);
+
+    return $self->{CFLAGS} = qq{
+CCFLAGS = $quals
+OPTIMIZE = $optimize
+PERLTYPE =
+SPLIT =
+LARGE =
+};
+}
+
+=item const_cccmd (override)
+
+Adds directives to point C preprocessor to the right place when
+handling #include <sys/foo.h> directives.  Also constructs CC
+command line a bit differently than MM_Unix method.
+
+=cut
+
+sub const_cccmd {
+    my($self,$libperl) = @_;
+    my(@m);
+
+    return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
+    return '' unless $self->needs_linking();
+    if ($Config{'vms_cc_type'} eq 'gcc') {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
+    }
+    elsif ($Config{'vms_cc_type'} eq 'vaxc') {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
+    }
+    else {
+        push @m,'
+.FIRST
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
+		($Config{'arch'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
+	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
+    }
+
+    push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
+
+    $self->{CONST_CCCMD} = join('',@m);
+}
+
+=item pm_to_blib (override)
+
+DCL I<still> accepts a maximum of 255 characters on a command
+line, so we write the (potentially) long list of file names
+to a temp file, then persuade Perl to read it instead of the
+command line to find args.
+
+=cut
+
+sub pm_to_blib {
+    my($self) = @_;
+    my($line,$from,$to,@m);
+    my($autodir) = $self->catdir('$(INST_LIB)','auto');
+    my(@files) = @{$self->{PM_TO_BLIB}};
+
+    push @m, q{
+# As always, keep under DCL's 255-char limit
+pm_to_blib : $(TO_INST_PM)
+	},$self->{NOECHO},q{$(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
+};
+
+    $line = '';  # avoid uninitialized var warning
+    while ($from = shift(@files),$to = shift(@files)) {
+	$line .= " $from $to";
+	if (length($line) > 128) {
+	    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
+	    $line = '';
+	}
+    }
+    push(@m,"\t$self->{NOECHO}\$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;
+
+    push(@m,q[	$(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]);
+    push(@m,qq[
+	$self->{NOECHO}Delete/NoLog/NoConfirm .MM_tmp;
+	$self->{NOECHO}\$(TOUCH) pm_to_blib.ts
+]);
+
+    join('',@m);
+}
+
+=item tool_autosplit (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub tool_autosplit{
+    my($self, %attribs) = @_;
+    my($asl) = "";
+    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
+    q{
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use AutoSplit;}.$asl.q{ AutoSplit::autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
+};
+}
+
+=item tool_sxubpp (override)
+
+Use VMS-style quoting on xsubpp command line.
+
+=cut
+
+sub tool_xsubpp {
+    my($self) = @_;
+    return '' unless $self->needs_linking;
+    my($xsdir) = $self->catdir($self->{PERL_LIB},'ExtUtils');
+    # drop back to old location if xsubpp is not in new location yet
+    $xsdir = $self->catdir($self->{PERL_SRC},'ext') unless (-f $self->catfile($xsdir,'xsubpp'));
+    my(@tmdeps) = '$(XSUBPPDIR)typemap';
+    if( $self->{TYPEMAPS} ){
+	my $typemap;
+	foreach $typemap (@{$self->{TYPEMAPS}}){
+		if( ! -f  $typemap ){
+			warn "Typemap $typemap not found.\n";
+		}
+		else{
+			push(@tmdeps, $self->fixpath($typemap));
+		}
+	}
+    }
+    push(@tmdeps, "typemap") if -f "typemap";
+    my(@tmargs) = map("-typemap $_", @tmdeps);
+    if( exists $self->{XSOPT} ){
+	unshift( @tmargs, $self->{XSOPT} );
+    }
+
+    my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp'));
+
+    # What are the correct thresholds for version 1 && 2 Paul?
+    if ( $xsubpp_version > 1.923 ){
+	$self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
+    } else {
+	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
+	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
+	Your version of xsubpp is $xsubpp_version and cannot handle this.
+	Please upgrade to a more recent version of xsubpp.
+};
+	} else {
+	    $self->{XSPROTOARG} = "";
+	}
+    }
+
+    "
+XSUBPPDIR = $xsdir
+XSUBPP = \$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" \$(XSUBPPDIR)xsubpp
+XSPROTOARG = $self->{XSPROTOARG}
+XSUBPPDEPS = @tmdeps
+XSUBPPARGS = @tmargs
+";
+}
+
+=item xsubpp_version (override)
+
+Test xsubpp exit status according to VMS rules ($sts & 1 ==> good)
+rather than Unix rules ($sts == 0 ==> good).
+
+=cut
+
+sub xsubpp_version
+{
+    my($self,$xsubpp) = @_;
+    my ($version) ;
+    return '' unless $self->needs_linking;
+
+    # try to figure out the version number of the xsubpp on the system
+
+    # first try the -v flag, introduced in 1.921 & 2.000a2
+
+    my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
+    print "Running: $command\n" if $Verbose;
+    $version = `$command` ;
+    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    chop $version ;
+
+    return $1 if $version =~ /^xsubpp version (.*)/ ;
+
+    # nope, then try something else
+
+    my $counter = '000';
+    my ($file) = 'temp' ;
+    $counter++ while -e "$file$counter"; # don't overwrite anything
+    $file .= $counter;
+
+    local(*F);
+    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
+    print F <<EOM ;
+MODULE = fred PACKAGE = fred
+
+int
+fred(a)
+	int	a;
+EOM
+
+    close F ;
+
+    $command = "$self->{PERL} $xsubpp $file";
+    print "Running: $command\n" if $Verbose;
+    my $text = `$command` ;
+    warn "Running '$command' exits with status " . $? unless ($? & 1);
+    unlink $file ;
+
+    # gets 1.2 -> 1.92 and 2.000a1
+    return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;
+
+    # it is either 1.0 or 1.1
+    return 1.1 if $text =~ /^Warning: ignored semicolon/ ;
+
+    # none of the above, so 1.0
+    return "1.0" ;
+}
+
+=item tools_other (override)
+
+Adds a few MM[SK] macros, and shortens some the installatin commands,
+in order to stay under DCL's 255-character limit.  Also changes
+EQUALIZE_TIMESTAMP to set revision date of target file to one second
+later than source file, since MMK interprets precisely equal revision
+dates for a source and target file as a sign that the target needs
+to be updated.
+
+=cut
+
+sub tools_other {
+    my($self) = @_;
+    qq!
+# Assumes \$(MMS) invokes MMS or MMK
+# (It is assumed in some cases later that the default makefile name
+# (Descrip.MMS for MM[SK]) is used.)
+USEMAKEFILE = /Descrip=
+USEMACROS = /Macro=(
+MACROEND = )
+MAKEFILE = Descrip.MMS
+SHELL = Posix
+TOUCH = $self->{TOUCH}
+CHMOD = $self->{CHMOD}
+CP = $self->{CP}
+MV = $self->{MV}
+RM_F  = $self->{RM_F}
+RM_RF = $self->{RM_RF}
+UMASK_NULL = $self->{UMASK_NULL}
+NOOP = $self->{NOOP}
+MKPATH = Create/Directory
+EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
+!. ($self->{PARENT} ? '' : 
+qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
+MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
+DOC_INSTALL = \$(PERL) -e "\@ARGV=split('|',<STDIN>);print '=head3 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
+UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1);"
+!);
+}
+
+=item dist (override)
+
+Provide VMSish defaults for some values, then hand off to
+default MM_Unix method.
+
+=cut
+
+sub dist {
+    my($self, %attribs) = @_;
+    $attribs{VERSION}      ||= $self->{VERSION_SYM};
+    $attribs{ZIPFLAGS}     ||= '-Vu';
+    $attribs{COMPRESS}     ||= 'gzip';
+    $attribs{SUFFIX}       ||= '-gz';
+    $attribs{SHAR}         ||= 'vms_share';
+    $attribs{DIST_DEFAULT} ||= 'zipdist';
+
+    return ExtUtils::MM_Unix::dist($self,%attribs);
+}
+
+=item c_o (override)
+
+Use VMS syntax on command line.  In particular, $(DEFINE) and
+$(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
+
+=cut
+
+sub c_o {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.c$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
+
+.cpp$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
+
+.cxx$(OBJ_EXT) :
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
+
+';
+}
+
+=item xs_c (override)
+
+Use MM[SK] macros.
+
+=cut
+
+sub xs_c {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.xs.c :
+	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
+';
+}
+
+=item xs_o (override)
+
+Use MM[SK] macros, and VMS command line for C compiler.
+
+=cut
+
+sub xs_o {	# many makes are too dumb to use xs_c then c_o
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+    '
+.xs$(OBJ_EXT) :
+	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
+	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
+';
+}
+
+=item top_targets (override)
+
+Use VMS quoting on command line for Version_check.
+
+=cut
+
+sub top_targets {
+    my($self) = shift;
+    my(@m);
+    push @m, '
+all :: pure_all manifypods
+	$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+	$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	$(NOOP)
+
+config :: $(MAKEFILE) $(INST_LIBDIR).exists
+	$(NOOP)
+
+config :: $(INST_ARCHAUTODIR).exists
+	$(NOOP)
+
+config :: $(INST_AUTODIR).exists
+	$(NOOP)
+';
+
+    push @m, q{
+config :: Version_check
+	$(NOOP)
+
+} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC};
+
+
+    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
+    if (%{$self->{MAN1PODS}}) {
+	push @m, q[
+config :: $(INST_MAN1DIR).exists
+	$(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
+    }
+    if (%{$self->{MAN3PODS}}) {
+	push @m, q[
+config :: $(INST_MAN3DIR).exists
+	$(NOOP)
+];
+	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
+    }
+
+    push @m, '
+$(O_FILES) : $(H_FILES)
+' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
+
+    push @m, q{
+help :
+	perldoc ExtUtils::MakeMaker
+};
+
+    push @m, q{
+Version_check :
+	},$self->{NOECHO},q{$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	"-MExtUtils::MakeMaker=Version_check" -e "&Version_check('$(MM_VERSION)')"
+};
+
+    join('',@m);
+}
+
+=item dlsyms (override)
+
+Create VMS linker options files specifying universal symbols for this
+extension's shareable image, and listing other shareable images or 
+libraries to which it should be linked.
+
+=cut
+
+sub dlsyms {
+    my($self,%attribs) = @_;
+
+    return '' unless $self->needs_linking();
+
+    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
+    my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
+    my($srcdir)= $attribs{PERL_SRC} || $self->{PERL_SRC} || '';
+    my(@m);
+
+    unless ($self->{SKIPHASH}{'dynamic'}) {
+	push(@m,'
+dynamic :: rtls.opt $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOOP)
+');
+	if ($srcdir) {
+	   my($popt) = $self->catfile($srcdir,'perlshr.opt');
+	   my($lopt) = $self->catfile($srcdir,'crtl.opt');
+	   push(@m,"# Depend on $(BASEEXT).opt to insure we copy here *after* autogenerating (wrong) rtls.opt in Mksymlists
+rtls.opt : $popt $lopt \$(BASEEXT).opt
+	Copy/Log $popt Sys\$Disk:[]rtls.opt
+	Append/Log $lopt Sys\$Disk:[]rtls.opt
+");
+	}
+	else {
+	    push(@m,'
+# rtls.opt is built in the same step as $(BASEEXT).opt
+rtls.opt : $(BASEEXT).opt
+	$(TOUCH) $(MMS$TARGET)
+');
+	}
+    }
+
+    push(@m,'
+static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
+	$(NOOP)
+') unless $self->{SKIPHASH}{'static'};
+
+    push(@m,'
+$(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
+	$(CP) $(MMS$SOURCE) $(MMS$TARGET)
+
+$(BASEEXT).opt : Makefile.PL
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
+	',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
+	neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
+	$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
+');
+
+    join('',@m);
+}
+
+=item dynamic_lib (override)
+
+Use VMS Link command.
+
+=cut
+
+sub dynamic_lib {
+    my($self, %attribs) = @_;
+    return '' unless $self->needs_linking(); #might be because of a subdir
+
+    return '' unless $self->has_link_code();
+
+    my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
+    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
+    my(@m);
+    push @m,"
+
+OTHERLDFLAGS = $otherldflags
+INST_DYNAMIC_DEP = $inst_dynamic_dep
+
+";
+    push @m, '
+$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+	',$self->{NOECHO},'$(MKPATH) $(INST_ARCHAUTODIR)
+	Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option
+';
+
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+=item dynamic_bs (override)
+
+Use VMS-style quoting on Mkbootstrap command line.
+
+=cut
+
+sub dynamic_bs {
+    my($self, %attribs) = @_;
+    return '
+BOOTSTRAP =
+' unless $self->has_link_code();
+    '
+BOOTSTRAP = '."$self->{BASEEXT}.bs".'
+
+# As MakeMaker mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
+	'.$self->{NOECHO}.'Write Sys$Output "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
+	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
+	'.$self->{NOECHO}.' $(TOUCH) $(MMS$TARGET)
+
+$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
+	'.$self->{NOECHO}.'$(RM_RF) $(INST_BOOT)
+	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
+';
+}
+
+=item static_lib (override)
+
+Use VMS commands to manipulate object library.
+
+=cut
+
+sub static_lib {
+    my($self) = @_;
+    return '' unless $self->needs_linking();
+
+    return '
+$(INST_STATIC) :
+	$(NOOP)
+' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
+
+    my(@m);
+    push @m,'
+# Rely on suffix rule for update action
+$(OBJECT) : $(INST_ARCHAUTODIR).exists
+
+$(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
+';
+    # If this extension has it's own library (eg SDBM_File)
+    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
+    push(@m, '	$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
+
+    push(@m,'
+	If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
+	Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)
+	',$self->{NOECHO},'$(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq[$(EXTRALIBS)\n];close F;"
+');
+    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
+    join('',@m);
+}
+
+
+# sub installpm_x { # called by installpm perl file
+#     my($self, $dist, $inst, $splitlib) = @_;
+#     if ($inst =~ m!#!) {
+# 	warn "Warning: MM[SK] would have problems processing this file: $inst, SKIPPED\n";
+# 	return '';
+#     }
+#     $inst = $self->fixpath($inst);
+#     $dist = $self->fixpath($dist);
+#     my($instdir) = $inst =~ /([^\)]+\))[^\)]*$/ ? $1 : dirname($inst);
+#     my(@m);
+# 
+#     push(@m, "
+# $inst : $dist \$(MAKEFILE) ${instdir}.exists \$(INST_ARCHAUTODIR).exists
+# ",'	',$self->{NOECHO},'$(RM_F) $(MMS$TARGET)
+# 	',$self->{NOECHO},'$(CP) ',"$dist $inst",'
+# 	$(CHMOD) 644 $(MMS$TARGET)
+# ');
+#     push(@m, '	$(AUTOSPLITFILE) $(MMS$TARGET) ',
+#               $self->catdir($splitlib,'auto')."\n\n")
+#         if ($splitlib and $inst =~ /\.pm$/);
+#     push(@m,$self->dir_target($instdir));
+# 
+#     join('',@m);
+# }
+
+=item manifypods (override)
+
+Use VMS-style quoting on command line, and VMS logical name
+to specify fallback location at build time if we can't find pod2man.
+
+=cut
+
+
+sub manifypods {
+    my($self, %attribs) = @_;
+    return "\nmanifypods :\n\t\$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
+    my($dist);
+    my($pod2man_exe);
+    if (defined $self->{PERL_SRC}) {
+	$pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
+    } else {
+	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
+    }
+    if ($pod2man_exe = $self->perl_script($pod2man_exe)) { $found_pod2man = 1; }
+    else {
+	# No pod2man but some MAN3PODS to be installed
+	print <<END;
+
+Warning: I could not locate your pod2man program.  As a last choice,
+         I will look for the file to which the logical name POD2MAN
+         points when MMK is invoked.
+
+END
+        $pod2man_exe = "pod2man";
+    }
+    my(@m);
+    push @m,
+qq[POD2MAN_EXE = $pod2man_exe\n],
+q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
+-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
+];
+    push @m, "\nmanifypods : ";
+    push @m, join " ", keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}};
+    push(@m,"\n");
+    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
+	my($pod);
+	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN1PODS}{$pod}\n";
+	}
+	foreach $pod (sort keys %{$self->{MAN3PODS}}) {
+	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
+	    push @m, "$pod $self->{MAN3PODS}{$pod}\n";
+	}
+    }
+    join('', @m);
+}
+
+=item processPL (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub processPL {
+    my($self) = @_;
+    return "" unless $self->{PL_FILES};
+    my(@m, $plfile);
+    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+	push @m, "
+all :: $self->{PL_FILES}->{$plfile}
+	\$(NOOP)
+
+$self->{PL_FILES}->{$plfile} :: $plfile
+",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $plfile
+";
+    }
+    join "", @m;
+}
+
+=item installbin (override)
+
+Stay under DCL's 255 character command line limit once again by
+splitting potentially long list of files across multiple lines
+in C<realclean> target.
+
+=cut
+
+sub installbin {
+    my($self) = @_;
+    return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
+    return '' unless @{$self->{EXE_FILES}};
+    my(@m, $from, $to, %fromto, @to, $line);
+    for $from (@{$self->{EXE_FILES}}) {
+	my($path) = '$(INST_SCRIPT)' . basename($from);
+	local($_) = $path;  # backward compatibility
+	$to = $self->libscan($path);
+	print "libscan($from) => '$to'\n" if ($Verbose >=2);
+	$fromto{$from}=$to;
+    }
+    @to   = values %fromto;
+    push @m, "
+EXE_FILES = @{$self->{EXE_FILES}}
+
+all :: @to
+	\$(NOOP)
+
+realclean ::
+";
+    $line = '';  #avoid unitialized var warning
+    foreach $to (@to) {
+	if (length($line) + length($to) > 80) {
+	    push @m, "\t\$(RM_F) $line\n";
+	    $line = $to;
+	}
+	else { $line .= " $to"; }
+    }
+    push @m, "\t\$(RM_F) $line\n\n" if $line;
+
+    while (($from,$to) = each %fromto) {
+	last unless defined $from;
+	my $todir;
+	if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
+	else                   { ($todir = $to) =~ s/[^\)]+$//; }
+	$todir = $self->fixpath($todir,1);
+	push @m, "
+$to : $from \$(MAKEFILE) ${todir}.exists
+	\$(CP) $from $to
+
+", $self->dir_target($todir);
+    }
+    join "", @m;
+}
+
+=item subdir_x (override)
+
+Use VMS commands to change default directory.
+
+=cut
+
+sub subdir_x {
+    my($self, $subdir) = @_;
+    my(@m,$key);
+    $subdir = $self->fixpath($subdir,1);
+    push @m, '
+
+subdirs ::
+	olddef = F$Environment("Default")
+	Set Default ',$subdir,'
+	- $(MMS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
+	Set Default \'olddef\'
+';
+    join('',@m);
+}
+
+=item clean (override)
+
+Split potentially long list of files across multiple commands (in
+order to stay under the magic command line limit).  Also use MM[SK]
+commands for handling subdirectories.
+
+=cut
+
+sub clean {
+    my($self, %attribs) = @_;
+    my(@m,$dir);
+    push @m, '
+# Delete temporary files but do not touch installed files. We don\'t delete
+# the Descrip.MMS here so that a later make realclean still has it to use.
+clean ::
+';
+    foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
+	my($vmsdir) = $self->fixpath($dir,1);
+	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)") Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) clean`;"',"\n");
+    }
+    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso
+';
+
+    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
+    push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
+    push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
+    push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
+    my($file,$line);
+    $line = '';  #avoid unitialized var warning
+    foreach $file (@otherfiles) {
+	$file = $self->fixpath($file);
+	if (length($line) + length($file) > 80) {
+	    push @m, "\t\$(RM_RF) $line\n";
+	    $line = "$file";
+	}
+	else { $line .= " $file"; }
+    }
+    push @m, "\t\$(RM_RF) $line\n" if line;
+    push(@m, "	$attribs{POSTOP}\n") if $attribs{POSTOP};
+    join('', @m);
+}
+
+=item realclean (override)
+
+Guess what we're working around?  Also, use MM[SK] for subdirectories.
+
+=cut
+
+sub realclean {
+    my($self, %attribs) = @_;
+    my(@m);
+    push(@m,'
+# Delete temporary files (via clean) and also delete installed files
+realclean :: clean
+');
+    foreach(@{$self->{DIR}}){
+	my($vmsdir) = $self->fixpath($_,1);
+	push(@m, '	If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
+	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS) realclean`;"',"\n");
+    }
+    push @m,'	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
+';
+    # We can't expand several of the MMS macros here, since they don't have
+    # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
+    # combination of macros).  In order to stay below DCL's 255 char limit,
+    # we put only 2 on a line.
+    my($file,$line,$fcnt);
+    my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
+    if ($self->has_link_code) {
+	push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
+    }
+    push(@files, values %{$self->{PM}});
+    $line = '';  #avoid unitialized var warning
+    foreach $file (@files) {
+	$file = $self->fixpath($file);
+	if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
+	    push @m, "\t\$(RM_F) $line\n";
+	    $line = "$file";
+	    $fcnt = 0;
+	}
+	else { $line .= " $file"; }
+    }
+    push @m, "\t\$(RM_F) $line\n" if $line;
+    if ($attribs{FILES} && ref $attribs{FILES} eq 'ARRAY') {
+	$line = '';
+	foreach $file (@{$attribs{'FILES'}}) {
+	    $file = $self->fixpath($file);
+	    if (length($line) + length($file) > 80) {
+		push @m, "\t\$(RM_RF) $line\n";
+		$line = "$file";
+	    }
+	    else { $line .= " $file"; }
+	}
+	push @m, "\t\$(RM_RF) $line\n" if $line;
+    }
+    push(@m, "	$attribs{POSTOP}\n")                     if $attribs{POSTOP};
+    join('', @m);
+}
+
+=item dist_basics (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub dist_basics {
+    my($self) = @_;
+'
+distclean :: realclean distcheck
+	$(NOOP)
+
+distcheck :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"
+
+skipcheck :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; skipcheck()"
+
+manifest :
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
+';
+}
+
+=item dist_core (override)
+
+Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
+so C<shdist> target actions are VMS-specific.
+
+=cut
+
+sub dist_core {
+    my($self) = @_;
+q[
+dist : $(DIST_DEFAULT)
+	].$self->{NOECHO}.q[$(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)'"
+
+zipdist : $(DISTVNAME).zip
+	$(NOOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) $(SRC)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) "$(TARFLAGS)" $(DISTVNAME).tar $(SRC)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+shdist : distdir
+	$(PREOP)
+	$(SHARE) $(SRC) $(DISTVNAME).share
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+];
+}
+
+=item dist_dir (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub dist_dir {
+    my($self) = @_;
+q{
+distdir :
+	$(RM_RF) $(DISTVNAME)
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\
+	-e "manicopy(maniread(),'$(DISTVNAME)','$(DIST_CP)');"
+};
+}
+
+=item dist_test (override)
+
+Use VMS commands to change default directory, and use VMS-style
+quoting on command line.
+
+=cut
+
+sub dist_test {
+    my($self) = @_;
+q{
+disttest : distdir
+	startdir = F$Environment("Default")
+	Set Default [.$(DISTVNAME)]
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
+	$(MMS)
+	$(MMS) test
+	Set Default 'startdir'
+};
+}
+
+# --- Test and Installation Sections ---
+
+=item install (override)
+
+Work around DCL's 255 character limit several times,and use
+VMS-style command line quoting in a few cases.
+
+=cut
+
+sub install {
+    my($self, %attribs) = @_;
+    my(@m,@docfiles);
+
+    if ($self->{EXE_FILES}) {
+	my($line,$file) = ('','');
+	foreach $file (@{$self->{EXE_FILES}}) {
+	    $line .= "$file ";
+	    if (length($line) > 128) {
+		push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]);
+		$line = '';
+	    }
+	}
+	push(@docfiles,qq[\t\$(PERL) -e "print $line" >>.MM_tmp\n]) if $line;
+    }
+
+    push @m, q[
+install :: all pure_install doc_install
+	$(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+	$(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+	$(NOOP)
+
+install_ :: install_site
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+pure_install :: pure_$(INSTALLDIRS)_install
+	$(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	],$self->{NOECHO},q[Write Sys$Output "Appending installation info to $(INST_ARCHLIB)perllocal.pod"
+
+pure__install : pure_site_install
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+doc__install : doc_site_install
+	],$self->{NOECHO},q[Write Sys$Output "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
+
+# This hack brought to you by DCL's 255-character command line limit
+pure_perl_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[
+
+# Likewise
+pure_site_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'read ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').q[ '" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'write ].$self->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').q[ '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp
+	$(MOD_INSTALL) <.MM_tmp
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+	].$self->{NOECHO}.q[$(WARN_IF_OLD_PACKLIST) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+# Ditto
+doc_perl_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
+# And again
+doc_site_install ::
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLSITELIB)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|'" >>.MM_tmp
+],@docfiles,q[	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+
+];
+
+    push @m, q[
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+	$(NOOP)
+
+uninstall_from_perldirs ::
+	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').q[
+
+uninstall_from_sitedirs ::
+	].$self->{NOECHO}.q[$(UNINSTALL) ].$self->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist')."\n";
+
+    join('',@m);
+}
+
+=item perldepend (override)
+
+Use VMS-style syntax for files; it's cheaper to just do it directly here
+than to have the MM_Unix method call C<catfile> repeatedly.  Also use
+config.vms as source of original config data if the Perl distribution
+is available; config.sh is an ancillary file under VMS.  Finally, if
+we have to rebuild Config.pm, use MM[SK] to do it.
+
+=cut
+
+sub perldepend {
+    my($self) = @_;
+    my(@m);
+
+    push @m, '
+$(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h, $(PERL_INC)av.h
+$(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h, $(PERL_INC)form.h
+$(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h, $(PERL_INC)keywords.h
+$(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)op.h, $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
+$(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)proto.h
+$(OBJECT) : $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
+$(OBJECT) : $(PERL_INC)vmsish.h, $(PERL_INC)util.h, $(PERL_INC)config.h
+
+' if $self->{OBJECT}; 
+
+    if ($self->{PERL_SRC}) {
+	my(@macros);
+	my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)';
+	push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP';
+	push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
+	push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
+	push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
+	push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
+	$mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
+	push(@m,q[
+# Check for unpropagated config.sh changes. Should never happen.
+# We do NOT just update config.h because that is not sufficient.
+# An out of date config.h is not fatal but complains loudly!
+#$(PERL_INC)config.h : $(PERL_SRC)config.sh
+$(PERL_INC)config.h : $(PERL_VMS)config.vms
+	],$self->{NOECHO},q[Write Sys$Error "Warning: $(PERL_INC)config.h out of date with $(PERL_VMS)config.vms"
+
+#$(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
+$(PERL_ARCHLIB)Config.pm : $(PERL_VMS)config.vms $(PERL_VMS)genconfig.pl
+	],$self->{NOECHO},q[Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.vms or genconfig.pl"
+	olddef = F$Environment("Default")
+	Set Default $(PERL_SRC)
+	$(MMS)],$mmsquals,q[ $(MMS$TARGET)
+	Set Default 'olddef'
+]);
+    }
+
+    push(@m, join(" ", map($self->fixpath($_),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
+      if %{$self->{XS}};
+
+    join('',@m);
+}
+
+=item makefile (override)
+
+Use VMS commands and quoting.
+
+=cut
+
+sub makefile {
+    my($self) = @_;
+    my(@m,@cmd);
+    # We do not know what target was originally specified so we
+    # must force a manual rerun to be sure. But as it should only
+    # happen very rarely it is not a significant problem.
+    push @m, q[
+$(OBJECT) : $(FIRST_MAKEFILE)
+] if $self->{OBJECT};
+
+    push @m,q[
+# We take a very conservative approach here, but it\'s worth it.
+# We move $(MAKEFILE) to $(MAKEFILE)_old here to avoid gnu make looping.
+$(MAKEFILE) : Makefile.PL $(CONFIGDEP)
+	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) out-of-date with respect to $(MMS$SOURCE_LIST)"
+	],$self->{NOECHO},q[Write Sys$Output "Cleaning current config before rebuilding $(MAKEFILE) ..."
+	- $(MV) $(MAKEFILE) $(MAKEFILE)_old
+	- $(MMS) $(USEMAKEFILE)$(MAKEFILE)_old clean
+	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL ],join(' ',map(qq["$_"],@ARGV)),q[
+	],$self->{NOECHO},q[Write Sys$Output "$(MAKEFILE) has been rebuilt."
+	],$self->{NOECHO},q[Write Sys$Output "Please run $(MMS) to build the extension."
+];
+
+    join('',@m);
+}
+
+=item test (override)
+
+Use VMS commands for handling subdirectories.
+
+=cut
+
+sub test {
+    my($self, %attribs) = @_;
+    my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : '');
+    my(@m);
+    push @m,"
+TEST_VERBOSE = 0
+TEST_TYPE = test_\$(LINKTYPE)
+TEST_FILE = test.pl
+TESTDB_SW = -d
+
+test :: \$(TEST_TYPE)
+	\$(NOOP)
+
+testdb :: testdb_\$(LINKTYPE)
+	\$(NOOP)
+
+";
+    foreach(@{$self->{DIR}}){
+      my($vmsdir) = $self->fixpath($_,1);
+      push(@m, '	If F$Search("',$vmsdir,'$(MAKEFILE)").nes."" Then $(PERL) -e "chdir ',"'$vmsdir'",
+           '; print `$(MMS) $(PASTHRU2) test`'."\n");
+    }
+    push(@m, "\t$self->{NOECHO}Write Sys\$Output \"No tests defined for \$(NAME) extension.\"\n")
+        unless $tests or -f "test.pl" or @{$self->{DIR}};
+    push(@m, "\n");
+
+    push(@m, "test_dynamic :: pure_all\n");
+    push(@m, $self->test_via_harness('$(FULLPERL)', $tests)) if $tests;
+    push(@m, $self->test_via_script('$(FULLPERL)', 'test.pl')) if -f "test.pl";
+    push(@m, "    \$(NOOP)\n") if (!$tests && ! -f "test.pl");
+    push(@m, "\n");
+
+    push(@m, "testdb_dynamic :: pure_all\n");
+    push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)'));
+    push(@m, "\n");
+
+    # Occasionally we may face this degenerate target:
+    push @m, "test_ : test_dynamic\n\n";
+ 
+    if ($self->needs_linking()) {
+	push(@m, "test_static :: pure_all \$(MAP_TARGET)\n");
+	push(@m, $self->test_via_harness('$(MAP_TARGET)', $tests)) if $tests;
+	push(@m, $self->test_via_script('$(MAP_TARGET)', 'test.pl')) if -f 'test.pl';
+	push(@m, "\n");
+	push(@m, "testdb_static :: pure_all \$(MAP_TARGET)\n");
+	push(@m, $self->test_via_script('$(MAP_TARGET) $(TESTDB_SW)', '$(TEST_FILE)'));
+	push(@m, "\n");
+    }
+    else {
+	push @m, "test_static :: test_dynamic\n\t$self->{NOECHO}\$(NOOP)\n\n";
+	push @m, "testdb_static :: testdb_dynamic\n\t$self->{NOECHO}\$(NOOP)\n";
+    }
+
+    join('',@m);
+}
+
+=item test_via_harness (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub test_via_harness {
+    my($self,$perl,$tests) = @_;
+    "	$perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)" \\'."\n\t".
+    '-e "use Test::Harness qw(&runtests $verbose); $verbose=$(TEST_VERBOSE); runtests @ARGV;" \\'."\n\t$tests\n";
+}
+
+=item test_via_script (override)
+
+Use VMS-style quoting on command line.
+
+=cut
+
+sub test_via_script {
+    my($self,$perl,$script) = @_;
+    "	$perl".' "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '.$script.'
+';
+}
+
+=item makeaperl (override)
+
+Undertake to build a new set of Perl images using VMS commands.  Since
+VMS does dynamic loading, it's not necessary to statically link each
+extension into the Perl image, so this isn't the normal build path.
+Consequently, it hasn't really been tested, and may well be incomplete.
+
+=cut
+
+sub makeaperl {
+    my($self, %attribs) = @_;
+    my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmp, $libperl) = 
+      @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
+    my(@m);
+    push @m, "
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = $target
+";
+    return join '', @m if $self->{PARENT};
+
+    my($dir) = join ":", @{$self->{DIR}};
+
+    unless ($self->{MAKEAPERL}) {
+	push @m, q{
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+	},$self->{NOECHO},q{Write Sys$Output "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
+	},$self->{NOECHO},q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+		Makefile.PL DIR=}, $dir, q{ \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1
+
+$(MAP_TARGET) :: $(MAKE_APERL_FILE)
+	$(MMS)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
+};
+	push @m, map( " \\\n\t\t$_", @ARGV );
+	push @m, "\n";
+
+	return join '', @m;
+    }
+
+
+    my($linkcmd,@staticopts,@staticpkgs,$extralist,$target,$targdir,$libperldir);
+
+    # The front matter of the linkcommand...
+    $linkcmd = join ' ', $Config{'ld'},
+	    grep($_, @Config{qw(large split ldflags ccdlflags)});
+    $linkcmd =~ s/\s+/ /g;
+
+    # Which *.olb files could we make use of...
+    local(%olbs);
+    $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
+    require File::Find;
+    File::Find::find(sub {
+	return unless m/\Q$self->{LIB_EXT}\E$/;
+	return if m/^libperl/;
+
+	if( exists $self->{INCLUDE_EXT} ){
+		my $found = 0;
+		my $incl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything not explicitly marked for inclusion.
+		# DynaLoader is implied.
+		foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
+			if( $xx eq $incl ){
+				$found++;
+				last;
+			}
+		}
+		return unless $found;
+	}
+	elsif( exists $self->{EXCLUDE_EXT} ){
+		my $excl;
+		my $xx;
+
+		($xx = $File::Find::name) =~ s,.*?/auto/,,;
+		$xx =~ s,/?$_,,;
+		$xx =~ s,/,::,g;
+
+		# Throw away anything explicitly marked for exclusion
+		foreach $excl (@{$self->{EXCLUDE_EXT}}){
+			return if( $xx eq $excl );
+		}
+	}
+
+	$olbs{$ENV{DEFAULT}} = $_;
+    }, grep( -d $_, @{$searchdirs || []}));
+
+    # We trust that what has been handed in as argument will be buildable
+    $static = [] unless $static;
+    @olbs{@{$static}} = (1) x @{$static};
+ 
+    $extra = [] unless $extra && ref $extra eq 'ARRAY';
+    # Sort the object libraries in inverse order of
+    # filespec length to try to insure that dependent extensions
+    # will appear before their parents, so the linker will
+    # search the parent library to resolve references.
+    # (e.g. Intuit::DWIM will precede Intuit, so unresolved
+    # references from [.intuit.dwim]dwim.obj can be found
+    # in [.intuit]intuit.olb).
+    for (sort keys %olbs) {
+	next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
+	my($dir) = $self->fixpath($_,1);
+	my($extralibs) = $dir . "extralibs.ld";
+	my($extopt) = $dir . $olbs{$_};
+	$extopt =~ s/$self->{LIB_EXT}$/.opt/;
+	if (-f $extralibs ) {
+	    open LIST,$extralibs or warn $!,next;
+	    push @$extra, <LIST>;
+	    close LIST;
+	}
+	if (-f $extopt) {
+	    open OPT,$extopt or die $!;
+	    while (<OPT>) {
+		next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
+		# ExtUtils::Miniperl expects Unix paths
+		(my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
+		push @staticpkgs,$pkg;
+	    }
+	    push @staticopts, $extopt;
+	}
+    }
+
+    $target = "Perl.Exe" unless $target;
+    ($shrtarget,$targdir) = fileparse($target);
+    $shrtarget =~ s/^([^.]*)/$1Shr/;
+    $shrtarget = $targdir . $shrtarget;
+    $target = "Perlshr.$Config{'dlext'}" unless $target;
+    $tmp = "[]" unless $tmp;
+    $tmp = $self->fixpath($tmp,1);
+    if (@$extra) {
+	$extralist = join(' ',@$extra);
+	$extralist =~ s/[,\s\n]+/, /g;
+    }
+    else { $extralist = ''; }
+    if ($libperl) {
+	unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
+	    print STDOUT "Warning: $libperl not found\n";
+	    undef $libperl;
+	}
+    }
+    unless ($libperl) {
+	if (defined $self->{PERL_SRC}) {
+	    $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
+	} elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
+	} else {
+	    print STDOUT "Warning: $libperl not found
+    If you're going to build a static perl binary, make sure perl is installed
+    otherwise ignore this warning\n";
+	}
+    }
+    $libperldir = $self->fixpath((fileparse($libperl))[1],1);
+
+    push @m, '
+# Fill in the target you want to produce if it\'s not perl
+MAP_TARGET    = ',$self->fixpath($target),'
+MAP_SHRTARGET = ',$self->fixpath($shrtarget),"
+MAP_LINKCMD   = $linkcmd
+MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
+# We use the linker options files created with each extension, rather than
+#specifying the object files directly on the command line.
+MAP_STATIC    = ',@staticopts ? join(' ', @staticopts) : '','
+MAP_OPTS    = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
+MAP_EXTRA     = $extralist
+MAP_LIBPERL = ",$self->fixpath($libperl),'
+';
+
+
+    push @m,'
+$(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
+	$(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
+$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
+	$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
+	',$self->{NOECHO},'Write Sys$Output "To install the new ""$(MAP_TARGET)"" binary, say"
+	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
+	',$self->{NOECHO},'Write Sys$Output "To remove the intermediate files, say
+	',$self->{NOECHO},'Write Sys$Output "    $(MMS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
+';
+    push @m,'
+',"${tmp}perlmain.c",' : $(MAKEFILE)
+	',$self->{NOECHO},'$(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
+';
+
+    push @m, q[
+# More from the 255-char line length limit
+doc_inst_perl :
+	].$self->{NOECHO}.q[$(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
+	].$self->{NOECHO}.q[$(PERL) -e "print 'MAP_LIBPERL|$(MAP_LIBPERL)|'" >>.MM_tmp
+	$(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q[
+	].$self->{NOECHO}.q[Delete/NoLog/NoConfirm .MM_tmp;
+];
+
+    push @m, "
+inst_perl : pure_inst_perl doc_inst_perl
+	\$(NOOP)
+
+pure_inst_perl : \$(MAP_TARGET)
+	$self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
+	$self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
+
+clean :: map_clean
+	\$(NOOP)
+
+map_clean :
+	\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
+	\$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
+";
+
+    join '', @m;
+}
+  
+=item ext (specific)
+
+Stub routine standing in for C<ExtUtils::LibList::ext> until VMS
+support is added to that package.
+
+=cut
+
+sub ext {
+    my($self) = @_;
+    '','','';
+}
+
+# --- Output postprocessing section ---
+
+=item nicetext (override)
+
+Insure that colons marking targets are preceded by space, in order
+to distinguish the target delimiter from a colon appearing as
+part of a filespec.
+
+=cut
+
+sub nicetext {
+
+    my($self,$text) = @_;
+    $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
+    $text;
+}
+
+1;
+
+__END__
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
new file mode 100644
index 00000000000..4b0b48ac575
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/MakeMaker.pm
@@ -0,0 +1,1808 @@
+BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatible with perl5.001m
+
+package ExtUtils::MakeMaker;
+
+$Version = $VERSION = "5.34";
+$Version_OK = "5.17";	# Makefiles older than $Version_OK will die
+			# (Will be checked from MakeMaker version 4.13 onwards)
+($Revision = substr(q$Revision: 1.1.1.1 $, 10)) =~ s/\s+$//;
+
+
+
+require Exporter;
+use Config;
+use Carp ();
+#use FileHandle ();
+
+use vars qw(
+
+	    @ISA @EXPORT @EXPORT_OK $AUTOLOAD
+	    $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision $Setup_done
+	    $VERSION $Verbose $Version_OK %Config %Keep_after_flush
+	    %MM_Sections %Prepend_dot_dot %Recognized_Att_Keys
+	    @Get_from_Config @MM_Sections @Overridable @Parent
+
+	   );
+# use strict;
+
+eval {require DynaLoader;};	# Get mod2fname, if defined. Will fail
+                                # with miniperl.
+
+#
+# Set up the inheritance before we pull in the MM_* packages, because they
+# import variables and functions from here
+#
+@ISA = qw(Exporter);
+@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
+@EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists
+		$Version);
+		# $Version in mixed case will go away!
+
+#
+# Dummy package MM inherits actual methods from OS-specific
+# default packages.  We use this intermediate package so
+# MY::XYZ->func() can call MM->func() and get the proper
+# default routine without having to know under what OS
+# it's running.
+#
+@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist ExtUtils::MakeMaker];
+
+#
+# Setup dummy package:
+# MY exists for overriding methods to be defined within
+#
+{
+    package MY;
+    @MY::ISA = qw(MM);
+###    sub AUTOLOAD { use Devel::Symdump; print Devel::Symdump->rnew->as_string; Carp::confess "hey why? $AUTOLOAD" }
+    package MM;
+    sub DESTROY {}
+}
+
+# "predeclare the package: we only load it via AUTOLOAD
+# but we have already mentioned it in @ISA
+package ExtUtils::Liblist;
+
+package ExtUtils::MakeMaker;
+#
+# Now we can can pull in the friends
+#
+$Is_VMS = $^O eq 'VMS';
+$Is_OS2 = $^O =~ m|^os/?2$|i;
+$Is_Mac = $^O eq 'MacOS';
+
+require ExtUtils::MM_Unix;
+
+if ($Is_VMS) {
+    require ExtUtils::MM_VMS;
+    require VMS::Filespec; # is a noop as long as we require it within MM_VMS
+}
+if ($Is_OS2) {
+    require ExtUtils::MM_OS2;
+}
+if ($Is_Mac) {
+    require ExtUtils::MM_Mac;
+}
+
+# The SelfLoader would bring a lot of overhead for MakeMaker, because
+# we know for sure we will use most of the autoloaded functions once
+# we have to use one of them. So we write our own loader
+
+sub AUTOLOAD {
+    my $code;
+    if (defined fileno(DATA)) {
+	my $fh = select DATA;
+	my $o = $/;			# For future reads from the file.
+	$/ = "\n__END__\n";
+	$code = <DATA>;
+	$/ = $o;
+	select $fh;
+	close DATA;
+	eval $code;
+	if ($@) {
+	    $@ =~ s/ at .*\n//;
+	    Carp::croak $@;
+	}
+    } else {
+	warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; 
+    }
+    defined(&$AUTOLOAD) or die "Myloader inconsistency error";
+    goto &$AUTOLOAD;
+}
+
+# The only subroutine we do not SelfLoad is Version_Check because it's
+# called so often. Loading this minimum still requires 1.2 secs on my
+# Indy :-(
+
+sub Version_check {
+    my($checkversion) = @_;
+    die "Your Makefile was built with ExtUtils::MakeMaker v $checkversion.
+Current Version is $ExtUtils::MakeMaker::VERSION. There have been considerable
+changes in the meantime.
+Please rerun 'perl Makefile.PL' to regenerate the Makefile.\n"
+    if $checkversion < $Version_OK;
+    printf STDOUT "%s %s %s %s.\n", "Makefile built with ExtUtils::MakeMaker v",
+    $checkversion, "Current Version is", $VERSION
+	unless $checkversion == $VERSION;
+}
+
+sub warnhandler {
+    $_[0] =~ /^Use of uninitialized value/ && return;
+    $_[0] =~ /used only once/ && return;
+    $_[0] =~ /^Subroutine\s+[\w:]+\s+redefined/ && return;
+    warn @_;
+}
+
+sub ExtUtils::MakeMaker::eval_in_subdirs ;
+sub ExtUtils::MakeMaker::eval_in_x ;
+sub ExtUtils::MakeMaker::full_setup ;
+sub ExtUtils::MakeMaker::writeMakefile ;
+sub ExtUtils::MakeMaker::new ;
+sub ExtUtils::MakeMaker::check_manifest ;
+sub ExtUtils::MakeMaker::parse_args ;
+sub ExtUtils::MakeMaker::check_hints ;
+sub ExtUtils::MakeMaker::mv_all_methods ;
+sub ExtUtils::MakeMaker::skipcheck ;
+sub ExtUtils::MakeMaker::flush ;
+sub ExtUtils::MakeMaker::mkbootstrap ;
+sub ExtUtils::MakeMaker::mksymlists ;
+sub ExtUtils::MakeMaker::neatvalue ;
+sub ExtUtils::MakeMaker::selfdocument ;
+sub ExtUtils::MakeMaker::WriteMakefile ;
+sub ExtUtils::MakeMaker::prompt ;
+
+1;
+#__DATA__
+package ExtUtils::MakeMaker;
+
+sub WriteMakefile {
+    Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+    local $SIG{__WARN__} = \&warnhandler;
+
+    unless ($Setup_done++){
+	full_setup();
+	undef &ExtUtils::MakeMaker::full_setup; #safe memory
+    }
+    my %att = @_;
+    MM->new(\%att)->flush;
+}
+
+sub prompt ($;$) {
+    my($mess,$def)=@_;
+    $ISA_TTY = -t STDIN && -t STDOUT ;
+    Carp::confess("prompt function called without an argument") unless defined $mess;
+    my $dispdef = defined $def ? "[$def] " : " ";
+    $def = defined $def ? $def : "";
+    my $ans;
+    if ($ISA_TTY) {
+	local $|=1;
+	print "$mess $dispdef";
+	chomp($ans = <STDIN>);
+    }
+    return $ans || $def;
+}
+
+sub eval_in_subdirs {
+    my($self) = @_;
+    my($dir);
+    use Cwd 'cwd';
+    my $pwd = cwd();
+
+    foreach $dir (@{$self->{DIR}}){
+	my($abs) = $self->catdir($pwd,$dir);
+	$self->eval_in_x($abs);
+    }
+    chdir $pwd;
+}
+
+sub eval_in_x {
+    my($self,$dir) = @_;
+    package main;
+    chdir $dir or Carp::carp("Couldn't change to directory $dir: $!");
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+#    $fh->open("Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir");
+    local *FH;
+    open(FH,"Makefile.PL") or Carp::carp("Couldn't open Makefile.PL in $dir");
+#    my $eval = join "", <$fh>;
+    my $eval = join "", <FH>;
+#    $fh->close;
+    close FH;
+    eval $eval;
+    if ($@) {
+# 	  if ($@ =~ /prerequisites/) {
+# 	      die "MakeMaker WARNING: $@";
+# 	  } else {
+# 	      warn "WARNING from evaluation of $dir/Makefile.PL: $@";
+# 	  }
+	warn "WARNING from evaluation of $dir/Makefile.PL: $@";
+    }
+}
+
+sub full_setup {
+    $Verbose ||= 0;
+    $^W=1;
+
+    # package name for the classes into which the first object will be blessed
+    $PACKNAME = "PACK000";
+
+    @Attrib_help = qw/
+
+    C CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS EXE_FILES
+    EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H INC
+    INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
+    INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
+    INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
+    INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIBS
+    LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
+    NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
+    PERL_ARCHLIB PERL_LIB PERL_SRC PL_FILES PM PMLIBDIRS PREFIX
+    PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
+    XS_VERSION clean depend dist dynamic_lib linkext macro realclean
+    tool_autosplit
+
+    installpm
+
+	/;
+
+    # ^^^ installpm is deprecated, will go about Summer 96
+
+    # @Overridable is close to @MM_Sections but not identical.  The
+    # order is important. Many subroutines declare macros. These
+    # depend on each other. Let's try to collect the macros up front,
+    # then pasthru, then the rules.
+
+    # MM_Sections are the sections we have to call explicitly
+    # in Overridable we have subroutines that are used indirectly
+
+
+    @MM_Sections = 
+	qw(
+
+ post_initialize const_config constants tool_autosplit tool_xsubpp
+ tools_other dist macro depend cflags const_loadlibs const_cccmd
+ post_constants
+
+ pasthru
+
+ c_o xs_c xs_o top_targets linkext dlsyms dynamic dynamic_bs
+ dynamic_lib static static_lib manifypods processPL installbin subdirs
+ clean realclean dist_basics dist_core dist_dir dist_test dist_ci
+ install force perldepend makefile staticmake test
+
+	  ); # loses section ordering
+
+    @Overridable = @MM_Sections;
+    push @Overridable, qw[
+
+ dir_target libscan makeaperl needs_linking subdir_x test_via_harness
+ test_via_script
+
+			 ];
+
+    push @MM_Sections, qw[
+
+ pm_to_blib selfdocument
+
+			 ];
+
+    # Postamble needs to be the last that was always the case
+    push @MM_Sections, "postamble";
+    push @Overridable, "postamble";
+
+    # All sections are valid keys.
+    @Recognized_Att_Keys{@MM_Sections} = (1) x @MM_Sections;
+
+    # we will use all these variables in the Makefile
+    @Get_from_Config = 
+	qw(
+	   ar cc cccdlflags ccdlflags dlext dlsrc ld lddlflags ldflags libc
+	   lib_ext obj_ext ranlib sitelibexp sitearchexp so
+	  );
+
+    my $item;
+    foreach $item (@Attrib_help){
+	$Recognized_Att_Keys{$item} = 1;
+    }
+    foreach $item (@Get_from_Config) {
+	$Recognized_Att_Keys{uc $item} = $Config{$item};
+	print "Attribute '\U$item\E' => '$Config{$item}'\n"
+	    if ($Verbose >= 2);
+    }
+
+    #
+    # When we eval a Makefile.PL in a subdirectory, that one will ask
+    # us (the parent) for the values and will prepend "..", so that
+    # all files to be installed end up below OUR ./blib
+    #
+    %Prepend_dot_dot = 
+	qw(
+
+	   INST_BIN 1 INST_EXE 1 INST_LIB 1 INST_ARCHLIB 1 INST_SCRIPT
+	   1 MAP_TARGET 1 INST_MAN1DIR 1 INST_MAN3DIR 1 PERL_SRC 1
+	   PERL 1 FULLPERL 1
+
+	  );
+
+    my @keep = qw/
+	NEEDS_LINKING HAS_LINK_CODE
+	/;
+    @Keep_after_flush{@keep} = (1) x @keep;
+}
+
+sub writeMakefile {
+    die <<END;
+
+The extension you are trying to build apparently is rather old and
+most probably outdated. We detect that from the fact, that a
+subroutine "writeMakefile" is called, and this subroutine is not
+supported anymore since about October 1994.
+
+Please contact the author or look into CPAN (details about CPAN can be
+found in the FAQ and at http:/www.perl.com) for a more recent version
+of the extension. If you're really desperate, you can try to change
+the subroutine name from writeMakefile to WriteMakefile and rerun
+'perl Makefile.PL', but you're most probably left alone, when you do
+so.
+
+The MakeMaker team
+
+END
+}
+
+sub ExtUtils::MakeMaker::new {
+    my($class,$self) = @_;
+    my($key);
+
+    print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
+    if (-f "MANIFEST" && ! -f "Makefile"){
+	check_manifest();
+    }
+
+    $self = {} unless (defined $self);
+
+    check_hints($self);
+
+    my(%initial_att) = %$self; # record initial attributes
+
+    my($prereq);
+    foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
+	my $eval = "use $prereq $self->{PREREQ_PM}->{$prereq}";
+	eval $eval;
+	if ($@){
+	    warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found";
+	} else {
+	    delete $self->{PREREQ_PM}{$prereq};
+	}
+    }
+#    if (@unsatisfied){
+# 	  unless (defined $ExtUtils::MakeMaker::useCPAN) {
+# 	      print qq{MakeMaker WARNING: prerequisites not found (@unsatisfied)
+# Please install these modules first and rerun 'perl Makefile.PL'.\n};
+# 	      if ($ExtUtils::MakeMaker::hasCPAN) {
+# 		  $ExtUtils::MakeMaker::useCPAN = prompt(qq{Should I try to use the CPAN module to fetch them for you?},"yes");
+# 	      } else {
+# 		  print qq{Hint: You may want to install the CPAN module to autofetch the needed modules\n};
+# 		  $ExtUtils::MakeMaker::useCPAN=0;
+# 	      }
+# 	  }
+# 	  if ($ExtUtils::MakeMaker::useCPAN) {
+# 	      require CPAN;
+# 	      CPAN->import(@unsatisfied);
+# 	  } else {
+# 	      die qq{prerequisites not found (@unsatisfied)};
+# 	  }
+#	warn qq{WARNING: prerequisites not found (@unsatisfied)};
+#    }
+
+    if (defined $self->{CONFIGURE}) {
+	if (ref $self->{CONFIGURE} eq 'CODE') {
+	    $self = { %$self, %{&{$self->{CONFIGURE}}}};
+	} else {
+	    Carp::croak "Attribute 'CONFIGURE' to WriteMakefile() not a code reference\n";
+	}
+    }
+
+    # This is for old Makefiles written pre 5.00, will go away
+    if ( Carp::longmess("") =~ /runsubdirpl/s ){
+	#$self->{Correct_relativ_directories}++;
+	Carp::carp("WARNING: Please rerun 'perl Makefile.PL' to regenerate your Makefiles\n");
+    } else {
+	$self->{Correct_relativ_directories}=0;
+    }
+
+    my $class = ++$PACKNAME;
+    {
+#	no strict;
+	print "Blessing Object into class [$class]\n" if $Verbose>=2;
+	mv_all_methods("MY",$class);
+	bless $self, $class;
+	push @Parent, $self;
+	@{"$class\:\:ISA"} = 'MM';
+    }
+
+    if (defined $Parent[-2]){
+	$self->{PARENT} = $Parent[-2];
+	my $key;
+	for $key (keys %Prepend_dot_dot) {
+	    next unless defined $self->{PARENT}{$key};
+	    $self->{$key} = $self->{PARENT}{$key};
+	    $self->{$key} = $self->catdir("..",$self->{$key})
+		unless $self->file_name_is_absolute($self->{$key});
+	}
+	$self->{PARENT}->{CHILDREN}->{$class} = $self if $self->{PARENT};
+    } else {
+	parse_args($self,@ARGV);
+    }
+
+    $self->{NAME} ||= $self->guess_name;
+
+    ($self->{NAME_SYM} = $self->{NAME}) =~ s/\W+/_/g;
+
+    $self->init_main();
+
+    if (! $self->{PERL_SRC} ) {
+	my($pthinks) = $INC{'Config.pm'};
+	$pthinks = VMS::Filespec::vmsify($pthinks) if $Is_VMS;
+	if ($pthinks ne $self->catfile($Config{archlibexp},'Config.pm')){
+	    $pthinks =~ s!/Config\.pm$!!;
+	    $pthinks =~ s!.*/!!;
+	    print STDOUT <<END;
+Your perl and your Config.pm seem to have different ideas about the architecture
+they are running on.
+Perl thinks: [$pthinks]
+Config says: [$Config{archname}]
+This may or may not cause problems. Please check your installation of perl if you
+have problems building this extension.
+END
+	}
+    }
+
+    $self->init_dirscan();
+    $self->init_others();
+
+    push @{$self->{RESULT}}, <<END;
+# This Makefile is for the $self->{NAME} extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# $VERSION (Revision: $Revision) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+#	ANY CHANGES MADE HERE WILL BE LOST!
+#
+#   MakeMaker Parameters:
+END
+
+    foreach $key (sort keys %initial_att){
+	my($v) = neatvalue($initial_att{$key});
+	$v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
+	$v =~ tr/\n/ /s;
+	push @{$self->{RESULT}}, "#	$key => $v";
+    }
+
+    # turn the SKIP array into a SKIPHASH hash
+    my (%skip,$skip);
+    for $skip (@{$self->{SKIP} || []}) {
+	$self->{SKIPHASH}{$skip} = 1;
+    }
+    delete $self->{SKIP}; # free memory
+
+    if ($self->{PARENT}) {
+	for (qw/install dist dist_basics dist_core dist_dir dist_test dist_ci/) {
+	    $self->{SKIPHASH}{$_} = 1;
+	}
+    }
+
+    # We run all the subdirectories now. They don't have much to query
+    # from the parent, but the parent has to query them: if they need linking!
+    unless ($self->{NORECURS}) {
+	$self->eval_in_subdirs if @{$self->{DIR}};
+    }
+
+    my $section;
+    foreach $section ( @MM_Sections ){
+	print "Processing Makefile '$section' section\n" if ($Verbose >= 2);
+	my($skipit) = $self->skipcheck($section);
+	if ($skipit){
+	    push @{$self->{RESULT}}, "\n# --- MakeMaker $section section $skipit.";
+	} else {
+	    my(%a) = %{$self->{$section} || {}};
+	    push @{$self->{RESULT}}, "\n# --- MakeMaker $section section:";
+	    push @{$self->{RESULT}}, "# " . join ", ", %a if $Verbose && %a;
+	    push @{$self->{RESULT}}, $self->nicetext($self->$section( %a ));
+	}
+    }
+
+    push @{$self->{RESULT}}, "\n# End.";
+    pop @Parent;
+
+    $self;
+}
+
+sub check_manifest {
+    print STDOUT "Checking if your kit is complete...\n";
+    require ExtUtils::Manifest;
+    $ExtUtils::Manifest::Quiet=$ExtUtils::Manifest::Quiet=1; #avoid warning
+    my(@missed)=ExtUtils::Manifest::manicheck();
+    if (@missed){
+	print STDOUT "Warning: the following files are missing in your kit:\n";
+	print "\t", join "\n\t", @missed;
+	print STDOUT "\n";
+	print STDOUT "Please inform the author.\n";
+    } else {
+	print STDOUT "Looks good\n";
+    }
+}
+
+sub parse_args{
+    my($self, @args) = @_;
+    foreach (@args){
+	unless (m/(.*?)=(.*)/){
+	    help(),exit 1 if m/^help$/;
+	    ++$Verbose if m/^verb/;
+	    next;
+	}
+	my($name, $value) = ($1, $2);
+	if ($value =~ m/^~(\w+)?/){ # tilde with optional username
+	    $value =~ s [^~(\w*)]
+		[$1 ?
+		 ((getpwnam($1))[7] || "~$1") :
+		 (getpwuid($>))[7]
+		 ]ex;
+	}
+	# This may go away, in mid 1996
+	if ($self->{Correct_relativ_directories}){
+	    $value = $self->catdir("..",$value)
+		if $Prepend_dot_dot{$name} && ! $self->file_name_is_absolute($value);
+	}
+	$self->{uc($name)} = $value;
+    }
+    # This may go away, in mid 1996
+    delete $self->{Correct_relativ_directories};
+
+    # catch old-style 'potential_libs' and inform user how to 'upgrade'
+    if (defined $self->{potential_libs}){
+	my($msg)="'potential_libs' => '$self->{potential_libs}' should be";
+	if ($self->{potential_libs}){
+	    print STDOUT "$msg changed to:\n\t'LIBS' => ['$self->{potential_libs}']\n";
+	} else {
+	    print STDOUT "$msg deleted.\n";
+	}
+	$self->{LIBS} = [$self->{potential_libs}];
+	delete $self->{potential_libs};
+    }
+    # catch old-style 'ARMAYBE' and inform user how to 'upgrade'
+    if (defined $self->{ARMAYBE}){
+	my($armaybe) = $self->{ARMAYBE};
+	print STDOUT "ARMAYBE => '$armaybe' should be changed to:\n",
+			"\t'dynamic_lib' => {ARMAYBE => '$armaybe'}\n";
+	my(%dl) = %{$self->{dynamic_lib} || {}};
+	$self->{dynamic_lib} = { %dl, ARMAYBE => $armaybe};
+	delete $self->{ARMAYBE};
+    }
+    if (defined $self->{LDTARGET}){
+	print STDOUT "LDTARGET should be changed to LDFROM\n";
+	$self->{LDFROM} = $self->{LDTARGET};
+	delete $self->{LDTARGET};
+    }
+    # Turn a DIR argument on the command line into an array
+    if (defined $self->{DIR} && ref \$self->{DIR} eq 'SCALAR') {
+	# So they can choose from the command line, which extensions they want
+	# the grep enables them to have some colons too much in case they
+	# have to build a list with the shell
+	$self->{DIR} = [grep $_, split ":", $self->{DIR}];
+    }
+    # Turn a INCLUDE_EXT argument on the command line into an array
+    if (defined $self->{INCLUDE_EXT} && ref \$self->{INCLUDE_EXT} eq 'SCALAR') {
+	$self->{INCLUDE_EXT} = [grep $_, split '\s+', $self->{INCLUDE_EXT}];
+    }
+    # Turn a EXCLUDE_EXT argument on the command line into an array
+    if (defined $self->{EXCLUDE_EXT} && ref \$self->{EXCLUDE_EXT} eq 'SCALAR') {
+	$self->{EXCLUDE_EXT} = [grep $_, split '\s+', $self->{EXCLUDE_EXT}];
+    }
+    my $mmkey;
+    foreach $mmkey (sort keys %$self){
+	print STDOUT "	$mmkey => ", neatvalue($self->{$mmkey}), "\n" if $Verbose;
+	print STDOUT "'$mmkey' is not a known MakeMaker parameter name.\n"
+	    unless exists $Recognized_Att_Keys{$mmkey};
+    }
+    $| = 1 if $Verbose;
+}
+
+sub check_hints {
+    my($self) = @_;
+    # We allow extension-specific hints files.
+
+    return unless -d "hints";
+
+    # First we look for the best hintsfile we have
+    my(@goodhints);
+    my($hint)="${^O}_$Config{osvers}";
+    $hint =~ s/\./_/g;
+    $hint =~ s/_$//;
+    return unless $hint;
+
+    # Also try without trailing minor version numbers.
+    while (1) {
+	last if -f "hints/$hint.pl";      # found
+    } continue {
+	last unless $hint =~ s/_[^_]*$//; # nothing to cut off
+    }
+    return unless -f "hints/$hint.pl";    # really there
+
+    # execute the hintsfile:
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+#    $fh->open("hints/$hint.pl");
+    local *FH;
+    open(FH,"hints/$hint.pl");
+#    @goodhints = <$fh>;
+    @goodhints = <FH>;
+#    $fh->close;
+    close FH;
+    print STDOUT "Processing hints file hints/$hint.pl\n";
+    eval join('',@goodhints);
+    print STDOUT $@ if $@;
+}
+
+sub mv_all_methods {
+    my($from,$to) = @_;
+    my($method);
+    my($symtab) = \%{"${from}::"};
+#    no strict;
+
+    # Here you see the *current* list of methods that are overridable
+    # from Makefile.PL via MY:: subroutines. As of VERSION 5.07 I'm
+    # still trying to reduce the list to some reasonable minimum --
+    # because I want to make it easier for the user. A.K.
+
+    foreach $method (@Overridable) {
+
+	# We cannot say "next" here. Nick might call MY->makeaperl
+	# which isn't defined right now
+
+	# Above statement was written at 4.23 time when Tk-b8 was
+	# around. As Tk-b9 only builds with 5.002something and MM 5 is
+	# standard, we try to enable the next line again. It was
+	# commented out until MM 5.23
+
+	next unless defined &{"${from}::$method"};
+
+	*{"${to}::$method"} = \&{"${from}::$method"};
+
+	# delete would do, if we were sure, nobody ever called
+	# MY->makeaperl directly
+	
+	# delete $symtab->{$method};
+	
+	# If we delete a method, then it will be undefined and cannot
+	# be called.  But as long as we have Makefile.PLs that rely on
+	# %MY:: being intact, we have to fill the hole with an
+	# inheriting method:
+
+	eval "package MY; sub $method { shift->SUPER::$method(\@_); }";
+    }
+
+    # We have to clean out %INC also, because the current directory is
+    # changed frequently and Graham Barr prefers to get his version
+    # out of a History.pl file which is "required" so woudn't get
+    # loaded again in another extension requiring a History.pl
+
+    # With perl5.002_01 the deletion of entries in %INC caused Tk-b11
+    # to core dump in the middle of a require statement. The required
+    # file was Tk/MMutil.pm.  The consequence is, we have to be
+    # extremely careful when we try to give perl a reason to reload a
+    # library with same name.  The workaround prefers to drop nothing
+    # from %INC and teach the writers not to use such libraries.
+
+#    my $inc;
+#    foreach $inc (keys %INC) {
+#	#warn "***$inc*** deleted";
+#	delete $INC{$inc};
+#    }
+}
+
+sub skipcheck {
+    my($self) = shift;
+    my($section) = @_;
+    if ($section eq 'dynamic') {
+	print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ",
+	"in skipped section 'dynamic_bs'\n"
+            if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
+        print STDOUT "Warning (non-fatal): Target 'dynamic' depends on targets ",
+	"in skipped section 'dynamic_lib'\n"
+            if $self->{SKIPHASH}{dynamic_lib} && $Verbose;
+    }
+    if ($section eq 'dynamic_lib') {
+        print STDOUT "Warning (non-fatal): Target '\$(INST_DYNAMIC)' depends on ",
+	"targets in skipped section 'dynamic_bs'\n"
+            if $self->{SKIPHASH}{dynamic_bs} && $Verbose;
+    }
+    if ($section eq 'static') {
+        print STDOUT "Warning (non-fatal): Target 'static' depends on targets ",
+	"in skipped section 'static_lib'\n"
+            if $self->{SKIPHASH}{static_lib} && $Verbose;
+    }
+    return 'skipped' if $self->{SKIPHASH}{$section};
+    return '';
+}
+
+sub flush {
+    my $self = shift;
+    my($chunk);
+#    use FileHandle ();
+#    my $fh = new FileHandle;
+    local *FH;
+    print STDOUT "Writing $self->{MAKEFILE} for $self->{NAME}\n";
+
+    unlink($self->{MAKEFILE}, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : '');
+#    $fh->open(">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!";
+    open(FH,">MakeMaker.tmp") or die "Unable to open MakeMaker.tmp: $!";
+
+    for $chunk (@{$self->{RESULT}}) {
+#	print $fh "$chunk\n";
+	print FH "$chunk\n";
+    }
+
+#    $fh->close;
+    close FH;
+    my($finalname) = $self->{MAKEFILE};
+    rename("MakeMaker.tmp", $finalname);
+    chmod 0644, $finalname unless $Is_VMS;
+
+    if ($self->{PARENT}) {
+	foreach (keys %$self) { # safe memory
+	    delete $self->{$_} unless $Keep_after_flush{$_};
+	}
+    }
+
+    system("$Config::Config{eunicefix} $finalname") unless $Config::Config{eunicefix} eq ":";
+}
+
+# The following mkbootstrap() is only for installations that are calling
+# the pre-4.1 mkbootstrap() from their old Makefiles. This MakeMaker
+# writes Makefiles, that use ExtUtils::Mkbootstrap directly.
+sub mkbootstrap {
+    die <<END;
+!!! Your Makefile has been built such a long time ago, !!!
+!!! that is unlikely to work with current MakeMaker.   !!!
+!!! Please rebuild your Makefile                       !!!
+END
+}
+
+# Ditto for mksymlists() as of MakeMaker 5.17
+sub mksymlists {
+    die <<END;
+!!! Your Makefile has been built such a long time ago, !!!
+!!! that is unlikely to work with current MakeMaker.   !!!
+!!! Please rebuild your Makefile                       !!!
+END
+}
+
+sub neatvalue {
+    my($v) = @_;
+    return "undef" unless defined $v;
+    my($t) = ref $v;
+    return "q[$v]" unless $t;
+    if ($t eq 'ARRAY') {
+	my(@m, $elem, @neat);
+	push @m, "[";
+	foreach $elem (@$v) {
+	    push @neat, "q[$elem]";
+	}
+	push @m, join ", ", @neat;
+	push @m, "]";
+	return join "", @m;
+    }
+    return "$v" unless $t eq 'HASH';
+    my(@m, $key, $val);
+    while (($key,$val) = each %$v){
+	last unless defined $key; # cautious programming in case (undef,undef) is true
+	push(@m,"$key=>".neatvalue($val)) ;
+    }
+    return "{ ".join(', ',@m)." }";
+}
+
+sub selfdocument {
+    my($self) = @_;
+    my(@m);
+    if ($Verbose){
+	push @m, "\n# Full list of MakeMaker attribute values:";
+	foreach $key (sort keys %$self){
+	    next if $key eq 'RESULT' || $key =~ /^[A-Z][a-z]/;
+	    my($v) = neatvalue($self->{$key});
+	    $v =~ s/(CODE|HASH|ARRAY|SCALAR)\([\dxa-f]+\)/$1\(...\)/;
+	    $v =~ tr/\n/ /s;
+	    push @m, "#	$key => $v";
+	}
+    }
+    join "\n", @m;
+}
+
+package ExtUtils::MakeMaker;
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::MakeMaker - create an extension Makefile
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::MakeMaker;>
+
+C<WriteMakefile( ATTRIBUTE =E<gt> VALUE [, ...] );>
+
+which is really
+
+C<MM-E<gt>new(\%att)-E<gt>flush;>
+
+=head1 DESCRIPTION
+
+This utility is designed to write a Makefile for an extension module
+from a Makefile.PL. It is based on the Makefile.SH model provided by
+Andy Dougherty and the perl5-porters.
+
+It splits the task of generating the Makefile into several subroutines
+that can be individually overridden.  Each subroutine returns the text
+it wishes to have written to the Makefile.
+
+MakeMaker is object oriented. Each directory below the current
+directory that contains a Makefile.PL. Is treated as a separate
+object. This makes it possible to write an unlimited number of
+Makefiles with a single invocation of WriteMakefile().
+
+=head2 How To Write A Makefile.PL
+
+The short answer is: Don't. Run h2xs(1) before you start thinking
+about writing a module. For so called pm-only modules that consist of
+C<*.pm> files only, h2xs has the very useful C<-X> switch. This will
+generate dummy files of all kinds that are useful for the module
+developer.
+
+The medium answer is:
+
+    use ExtUtils::MakeMaker;
+    WriteMakefile( NAME => "Foo::Bar" );
+
+The long answer is below.
+
+=head2 Default Makefile Behaviour
+
+The generated Makefile enables the user of the extension to invoke
+
+  perl Makefile.PL # optionally "perl Makefile.PL verbose"
+  make
+  make test        # optionally set TEST_VERBOSE=1
+  make install     # See below
+
+The Makefile to be produced may be altered by adding arguments of the
+form C<KEY=VALUE>. E.g.
+
+  perl Makefile.PL PREFIX=/tmp/myperl5
+
+Other interesting targets in the generated Makefile are
+
+  make config     # to check if the Makefile is up-to-date
+  make clean      # delete local temp files (Makefile gets renamed)
+  make realclean  # delete derived files (including ./blib)
+  make ci         # check in all the files in the MANIFEST file
+  make dist       # see below the Distribution Support section
+
+=head2 make test
+
+MakeMaker checks for the existence of a file named "test.pl" in the
+current directory and if it exists it adds commands to the test target
+of the generated Makefile that will execute the script with the proper
+set of perl C<-I> options.
+
+MakeMaker also checks for any files matching glob("t/*.t"). It will
+add commands to the test target of the generated Makefile that execute
+all matching files via the L<Test::Harness> module with the C<-I>
+switches set correctly.
+
+=head2 make install
+
+make alone puts all relevant files into directories that are named by
+the macros INST_LIB, INST_ARCHLIB, INST_SCRIPT, INST_MAN1DIR, and
+INST_MAN3DIR. All these default to something below ./blib if you are
+I<not> building below the perl source directory. If you I<are>
+building below the perl source, INST_LIB and INST_ARCHLIB default to
+../../lib, and INST_SCRIPT is not defined.
+
+The I<install> target of the generated Makefile copies the files found
+below each of the INST_* directories to their INSTALL*
+counterparts. Which counterparts are chosen depends on the setting of
+INSTALLDIRS according to the following table:
+
+		       	   INSTALLDIRS set to
+       	       	        perl   	          site
+
+    INST_ARCHLIB    INSTALLARCHLIB    INSTALLSITEARCH
+    INST_LIB        INSTALLPRIVLIB    INSTALLSITELIB
+    INST_BIN                  INSTALLBIN
+    INST_SCRIPT              INSTALLSCRIPT
+    INST_MAN1DIR             INSTALLMAN1DIR
+    INST_MAN3DIR             INSTALLMAN3DIR
+
+The INSTALL... macros in turn default to their %Config
+($Config{installprivlib}, $Config{installarchlib}, etc.) counterparts.
+
+You can check the values of these variables on your system with
+
+    perl -MConfig -le 'print join $/, map 
+        sprintf("%20s: %s", $_, $Config{$_}),
+        grep /^install/, keys %Config'
+
+And to check the sequence in which the library directories are
+searched by perl, run
+
+    perl -le 'print join $/, @INC'
+
+
+=head2 PREFIX attribute
+
+The PREFIX attribute can be used to set the INSTALL* attributes in one
+go. The quickest way to install a module in a non-standard place
+
+    perl Makefile.PL PREFIX=~
+
+This will replace the string specified by $Config{prefix} in all
+$Config{install*} values.
+
+Note, that the tilde expansion is done by MakeMaker, not by perl by
+default, nor by make.
+
+If the user has superuser privileges, and is not working on AFS
+(Andrew File System) or relatives, then the defaults for
+INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate,
+and this incantation will be the best:
+
+    perl Makefile.PL; make; make test
+    make install
+
+make install per default writes some documentation of what has been
+done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This feature
+can be bypassed by calling make pure_install.
+
+=head2 AFS users
+
+will have to specify the installation directories as these most
+probably have changed since perl itself has been installed. They will
+have to do this by calling
+
+    perl Makefile.PL INSTALLSITELIB=/afs/here/today \
+	INSTALLSCRIPT=/afs/there/now INSTALLMAN3DIR=/afs/for/manpages
+    make
+
+Be careful to repeat this procedure every time you recompile an
+extension, unless you are sure the AFS installation directories are
+still valid.
+
+=head2 Static Linking of a new Perl Binary
+
+An extension that is built with the above steps is ready to use on
+systems supporting dynamic loading. On systems that do not support
+dynamic loading, any newly created extension has to be linked together
+with the available resources. MakeMaker supports the linking process
+by creating appropriate targets in the Makefile whenever an extension
+is built. You can invoke the corresponding section of the makefile with
+
+    make perl
+
+That produces a new perl binary in the current directory with all
+extensions linked in that can be found in INST_ARCHLIB , SITELIBEXP,
+and PERL_ARCHLIB. To do that, MakeMaker writes a new Makefile, on
+UNIX, this is called Makefile.aperl (may be system dependent). If you
+want to force the creation of a new perl, it is recommended, that you
+delete this Makefile.aperl, so the directories are searched-through
+for linkable libraries again.
+
+The binary can be installed into the directory where perl normally
+resides on your machine with
+
+    make inst_perl
+
+To produce a perl binary with a different name than C<perl>, either say
+
+    perl Makefile.PL MAP_TARGET=myperl
+    make myperl
+    make inst_perl
+
+or say
+
+    perl Makefile.PL
+    make myperl MAP_TARGET=myperl
+    make inst_perl MAP_TARGET=myperl
+
+In any case you will be prompted with the correct invocation of the
+C<inst_perl> target that installs the new binary into INSTALLBIN.
+
+make inst_perl per default writes some documentation of what has been
+done into the file C<$(INSTALLARCHLIB)/perllocal.pod>. This
+can be bypassed by calling make pure_inst_perl.
+
+Warning: the inst_perl: target will most probably overwrite your
+existing perl binary. Use with care!
+
+Sometimes you might want to build a statically linked perl although
+your system supports dynamic loading. In this case you may explicitly
+set the linktype with the invocation of the Makefile.PL or make:
+
+    perl Makefile.PL LINKTYPE=static    # recommended
+
+or
+
+    make LINKTYPE=static                # works on most systems
+
+=head2 Determination of Perl Library and Installation Locations
+
+MakeMaker needs to know, or to guess, where certain things are
+located.  Especially INST_LIB and INST_ARCHLIB (where to put the files
+during the make(1) run), PERL_LIB and PERL_ARCHLIB (where to read
+existing modules from), and PERL_INC (header files and C<libperl*.*>).
+
+Extensions may be built either using the contents of the perl source
+directory tree or from the installed perl library. The recommended way
+is to build extensions after you have run 'make install' on perl
+itself. You can do that in any directory on your hard disk that is not
+below the perl source tree. The support for extensions below the ext
+directory of the perl distribution is only good for the standard
+extensions that come with perl.
+
+If an extension is being built below the C<ext/> directory of the perl
+source then MakeMaker will set PERL_SRC automatically (e.g.,
+C<../..>).  If PERL_SRC is defined and the extension is recognized as
+a standard extension, then other variables default to the following:
+
+  PERL_INC     = PERL_SRC
+  PERL_LIB     = PERL_SRC/lib
+  PERL_ARCHLIB = PERL_SRC/lib
+  INST_LIB     = PERL_LIB
+  INST_ARCHLIB = PERL_ARCHLIB
+
+If an extension is being built away from the perl source then MakeMaker
+will leave PERL_SRC undefined and default to using the installed copy
+of the perl library. The other variables default to the following:
+
+  PERL_INC     = $archlibexp/CORE
+  PERL_LIB     = $privlibexp
+  PERL_ARCHLIB = $archlibexp
+  INST_LIB     = ./blib/lib
+  INST_ARCHLIB = ./blib/arch
+
+If perl has not yet been installed then PERL_SRC can be defined on the
+command line as shown in the previous section.
+
+
+=head2 Which architecture dependent directory?
+
+If you don't want to keep the defaults for the INSTALL* macros,
+MakeMaker helps you to minimize the typing needed: the usual
+relationship between INSTALLPRIVLIB and INSTALLARCHLIB is determined
+by Configure at perl compilation time. MakeMaker supports the user who
+sets INSTALLPRIVLIB. If INSTALLPRIVLIB is set, but INSTALLARCHLIB not,
+then MakeMaker defaults the latter to be the same subdirectory of
+INSTALLPRIVLIB as Configure decided for the counterparts in %Config ,
+otherwise it defaults to INSTALLPRIVLIB. The same relationship holds
+for INSTALLSITELIB and INSTALLSITEARCH.
+
+MakeMaker gives you much more freedom than needed to configure
+internal variables and get different results. It is worth to mention,
+that make(1) also lets you configure most of the variables that are
+used in the Makefile. But in the majority of situations this will not
+be necessary, and should only be done, if the author of a package
+recommends it (or you know what you're doing).
+
+=head2 Using Attributes and Parameters
+
+The following attributes can be specified as arguments to WriteMakefile()
+or as NAME=VALUE pairs on the command line:
+
+=cut
+
+# The following "=item C" is used by the attrib_help routine
+# likewise the "=back" below. So be careful when changing it!
+
+=over 2
+
+=item C
+
+Ref to array of *.c file names. Initialised from a directory scan
+and the values portion of the XS attribute hash. This is not
+currently used by MakeMaker but may be handy in Makefile.PLs.
+
+=item CONFIG
+
+Arrayref. E.g. [qw(archname manext)] defines ARCHNAME & MANEXT from
+config.sh. MakeMaker will add to CONFIG the following values anyway:
+ar
+cc
+cccdlflags
+ccdlflags
+dlext
+dlsrc
+ld
+lddlflags
+ldflags
+libc
+lib_ext
+obj_ext
+ranlib
+sitelibexp
+sitearchexp
+so
+
+=item CONFIGURE
+
+CODE reference. The subroutine should return a hash reference. The
+hash may contain further attributes, e.g. {LIBS => ...}, that have to
+be determined by some evaluation method.
+
+=item DEFINE
+
+Something like C<"-DHAVE_UNISTD_H">
+
+=item DIR
+
+Ref to array of subdirectories containing Makefile.PLs e.g. [ 'sdbm'
+] in ext/SDBM_File
+
+=item DISTNAME
+
+Your name for distributing the package (by tar file). This defaults to
+NAME above.
+
+=item DL_FUNCS
+
+Hashref of symbol names for routines to be made available as
+universal symbols.  Each key/value pair consists of the package name
+and an array of routine names in that package.  Used only under AIX
+(export lists) and VMS (linker options) at present.  The routine
+names supplied will be expanded in the same way as XSUB names are
+expanded by the XS() macro.  Defaults to
+
+  {"$(NAME)" => ["boot_$(NAME)" ] }
+
+e.g.
+
+  {"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
+   "NetconfigPtr" => [ 'DESTROY'] }
+
+=item DL_VARS
+
+Array of symbol names for variables to be made available as
+universal symbols.  Used only under AIX (export lists) and VMS
+(linker options) at present.  Defaults to [].  (e.g. [ qw(
+Foo_version Foo_numstreams Foo_tree ) ])
+
+=item EXCLUDE_EXT
+
+Array of extension names to exclude when doing a static build.  This
+is ignored if INCLUDE_EXT is present.  Consult INCLUDE_EXT for more
+details.  (e.g.  [ qw( Socket POSIX ) ] )
+
+This attribute may be most useful when specified as a string on the
+commandline:  perl Makefile.PL EXCLUDE_EXT='Socket Safe'
+
+=item EXE_FILES
+
+Ref to array of executable files. The files will be copied to the
+INST_SCRIPT directory. Make realclean will delete them from there
+again.
+
+=item NO_VC
+
+In general any generated Makefile checks for the current version of
+MakeMaker and the version the Makefile was built under. If NO_VC is
+set, the version check is neglected. Do not write this into your
+Makefile.PL, use it interactively instead.
+
+=item FIRST_MAKEFILE
+
+The name of the Makefile to be produced. Defaults to the contents of
+MAKEFILE, but can be overridden. This is used for the second Makefile
+that will be produced for the MAP_TARGET.
+
+=item FULLPERL
+
+Perl binary able to run this extension.
+
+=item H
+
+Ref to array of *.h file names. Similar to C.
+
+=item INC
+
+Include file dirs eg: C<"-I/usr/5include -I/path/to/inc">
+
+=item INCLUDE_EXT
+
+Array of extension names to be included when doing a static build.
+MakeMaker will normally build with all of the installed extensions when
+doing a static build, and that is usually the desired behavior.  If
+INCLUDE_EXT is present then MakeMaker will build only with those extensions
+which are explicitly mentioned. (e.g.  [ qw( Socket POSIX ) ])
+
+It is not necessary to mention DynaLoader or the current extension when
+filling in INCLUDE_EXT.  If the INCLUDE_EXT is mentioned but is empty then
+only DynaLoader and the current extension will be included in the build.
+
+This attribute may be most useful when specified as a string on the
+commandline:  perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
+
+=item INSTALLARCHLIB
+
+Used by 'make install', which copies files from INST_ARCHLIB to this
+directory if INSTALLDIRS is set to perl.
+
+=item INSTALLBIN
+
+Directory to install binary files (e.g. tkperl) into.
+
+=item INSTALLDIRS
+
+Determines which of the two sets of installation directories to
+choose: installprivlib and installarchlib versus installsitelib and
+installsitearch. The first pair is chosen with INSTALLDIRS=perl, the
+second with INSTALLDIRS=site. Default is site.
+
+=item INSTALLMAN1DIR
+
+This directory gets the man pages at 'make install' time. Defaults to
+$Config{installman1dir}.
+
+=item INSTALLMAN3DIR
+
+This directory gets the man pages at 'make install' time. Defaults to
+$Config{installman3dir}.
+
+=item INSTALLPRIVLIB
+
+Used by 'make install', which copies files from INST_LIB to this
+directory if INSTALLDIRS is set to perl.
+
+=item INSTALLSCRIPT
+
+Used by 'make install' which copies files from INST_SCRIPT to this
+directory.
+
+=item INSTALLSITELIB
+
+Used by 'make install', which copies files from INST_LIB to this
+directory if INSTALLDIRS is set to site (default).
+
+=item INSTALLSITEARCH
+
+Used by 'make install', which copies files from INST_ARCHLIB to this
+directory if INSTALLDIRS is set to site (default).
+
+=item INST_ARCHLIB
+
+Same as INST_LIB for architecture dependent files.
+
+=item INST_BIN
+
+Directory to put real binary files during 'make'. These will be copied
+to INSTALLBIN during 'make install'
+
+=item INST_EXE
+
+Old name for INST_SCRIPT. Deprecated. Please use INST_SCRIPT if you
+need to use it.
+
+=item INST_LIB
+
+Directory where we put library files of this extension while building
+it.
+
+=item INST_MAN1DIR
+
+Directory to hold the man pages at 'make' time
+
+=item INST_MAN3DIR
+
+Directory to hold the man pages at 'make' time
+
+=item INST_SCRIPT
+
+Directory, where executable files should be installed during
+'make'. Defaults to "./blib/bin", just to have a dummy location during
+testing. make install will copy the files in INST_SCRIPT to
+INSTALLSCRIPT.
+
+=item LDFROM
+
+defaults to "$(OBJECT)" and is used in the ld command to specify
+what files to link/load from (also see dynamic_lib below for how to
+specify ld flags)
+
+=item LIBPERL_A
+
+The filename of the perllibrary that will be used together with this
+extension. Defaults to libperl.a.
+
+=item LIBS
+
+An anonymous array of alternative library
+specifications to be searched for (in order) until
+at least one library is found. E.g.
+
+  'LIBS' => ["-lgdbm", "-ldbm -lfoo", "-L/path -ldbm.nfs"]
+
+Mind, that any element of the array
+contains a complete set of arguments for the ld
+command. So do not specify
+
+  'LIBS' => ["-ltcl", "-ltk", "-lX11"]
+
+See ODBM_File/Makefile.PL for an example, where an array is needed. If
+you specify a scalar as in
+
+  'LIBS' => "-ltcl -ltk -lX11"
+
+MakeMaker will turn it into an array with one element.
+
+=item LINKTYPE
+
+'static' or 'dynamic' (default unless usedl=undef in
+config.sh). Should only be used to force static linking (also see
+linkext below).
+
+=item MAKEAPERL
+
+Boolean which tells MakeMaker, that it should include the rules to
+make a perl. This is handled automatically as a switch by
+MakeMaker. The user normally does not need it.
+
+=item MAKEFILE
+
+The name of the Makefile to be produced.
+
+=item MAN1PODS
+
+Hashref of pod-containing files. MakeMaker will default this to all
+EXE_FILES files that include POD directives. The files listed
+here will be converted to man pages and installed as was requested
+at Configure time.
+
+=item MAN3PODS
+
+Hashref of .pm and .pod files. MakeMaker will default this to all
+ .pod and any .pm files that include POD directives. The files listed
+here will be converted to man pages and installed as was requested
+at Configure time.
+
+=item MAP_TARGET
+
+If it is intended, that a new perl binary be produced, this variable
+may hold a name for that binary. Defaults to perl
+
+=item MYEXTLIB
+
+If the extension links to a library that it builds set this to the
+name of the library (see SDBM_File)
+
+=item NAME
+
+Perl module name for this extension (DBD::Oracle). This will default
+to the directory name but should be explicitly defined in the
+Makefile.PL.
+
+=item NEEDS_LINKING
+
+MakeMaker will figure out, if an extension contains linkable code
+anywhere down the directory tree, and will set this variable
+accordingly, but you can speed it up a very little bit, if you define
+this boolean variable yourself.
+
+=item NOECHO
+
+Defaults to C<@>. By setting it to an empty string you can generate a
+Makefile that echos all commands. Mainly used in debugging MakeMaker
+itself.
+
+=item NORECURS
+
+Boolean.  Attribute to inhibit descending into subdirectories.
+
+=item OBJECT
+
+List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
+string containing all object files, e.g. "tkpBind.o
+tkpButton.o tkpCanvas.o"
+
+=item OPTIMIZE
+
+Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is
+passed to subdirectory makes.
+
+=item PERL
+
+Perl binary for tasks that can be done by miniperl
+
+=item PERLMAINCC
+
+The call to the program that is able to compile perlmain.c. Defaults
+to $(CC).
+
+=item PERL_ARCHLIB
+
+Same as above for architecture dependent files
+
+=item PERL_LIB
+
+Directory containing the Perl library to use.
+
+=item PERL_SRC
+
+Directory containing the Perl source code (use of this should be
+avoided, it may be undefined)
+
+=item PL_FILES
+
+Ref to hash of files to be processed as perl programs. MakeMaker
+will default to any found *.PL file (except Makefile.PL) being keys
+and the basename of the file being the value. E.g.
+
+  {'foobar.PL' => 'foobar'}
+
+The *.PL files are expected to produce output to the target files
+themselves.
+
+=item PM
+
+Hashref of .pm files and *.pl files to be installed.  e.g.
+
+  {'name_of_file.pm' => '$(INST_LIBDIR)/install_as.pm'}
+
+By default this will include *.pm and *.pl. If a lib directory
+exists and is not listed in DIR (above) then any *.pm and *.pl files
+it contains will also be included by default.  Defining PM in the
+Makefile.PL will override PMLIBDIRS.
+
+=item PMLIBDIRS
+
+Ref to array of subdirectories containing library files.  Defaults to
+[ 'lib', $(BASEEXT) ]. The directories will be scanned and any files
+they contain will be installed in the corresponding location in the
+library.  A libscan() method can be used to alter the behaviour.
+Defining PM in the Makefile.PL will override PMLIBDIRS.
+
+=item PREFIX
+
+Can be used to set the three INSTALL* attributes in one go (except for
+probably INSTALLMAN1DIR, if it is not below PREFIX according to
+%Config).  They will have PREFIX as a common directory node and will
+branch from that node into lib/, lib/ARCHNAME or whatever Configure
+decided at the build time of your perl (unless you override one of
+them, of course).
+
+=item PREREQ_PM
+
+Hashref: Names of modules that need to be available to run this
+extension (e.g. Fcntl for SDBM_File) are the keys of the hash and the
+desired version is the value. If the required version number is 0, we
+only check if any version is installed already.
+
+=item SKIP
+
+Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the
+Makefile. Caution! Do not use the SKIP attribute for the neglectible
+speedup. It may seriously damage the resulting Makefile. Only use it,
+if you really need it.
+
+=item TYPEMAPS
+
+Ref to array of typemap file names.  Use this when the typemaps are
+in some directory other than the current directory or when they are
+not named B<typemap>.  The last typemap in the list takes
+precedence.  A typemap in the current directory has highest
+precedence, even if it isn't listed in TYPEMAPS.  The default system
+typemap has lowest precedence.
+
+=item VERSION
+
+Your version number for distributing the package.  This defaults to
+0.1.
+
+=item VERSION_FROM
+
+Instead of specifying the VERSION in the Makefile.PL you can let
+MakeMaker parse a file to determine the version number. The parsing
+routine requires that the file named by VERSION_FROM contains one
+single line to compute the version number. The first line in the file
+that contains the regular expression
+
+    /(\$[\w:]*\bVERSION)\b.*=/
+
+will be evaluated with eval() and the value of the named variable
+B<after> the eval() will be assigned to the VERSION attribute of the
+MakeMaker object. The following lines will be parsed o.k.:
+
+    $VERSION = '1.00';
+    ( $VERSION ) = '$Revision: 1.1.1.1 $ ' =~ /\$Revision:\s+([^\s]+)/;
+    $FOO::VERSION = '1.10';
+
+but these will fail:
+
+    my $VERSION = '1.01';
+    local $VERSION = '1.02';
+    local $FOO::VERSION = '1.30';
+
+The file named in VERSION_FROM is added as a dependency to Makefile to
+guarantee, that the Makefile contains the correct VERSION macro after
+a change of the file.
+
+=item XS
+
+Hashref of .xs files. MakeMaker will default this.  e.g.
+
+  {'name_of_file.xs' => 'name_of_file.c'}
+
+The .c files will automatically be included in the list of files
+deleted by a make clean.
+
+=item XSOPT
+
+String of options to pass to xsubpp.  This might include C<-C++> or
+C<-extern>.  Do not include typemaps here; the TYPEMAP parameter exists for
+that purpose.
+
+=item XSPROTOARG
+
+May be set to an empty string, which is identical to C<-prototypes>, or
+C<-noprototypes>. See the xsubpp documentation for details. MakeMaker
+defaults to the empty string.
+
+=item XS_VERSION
+
+Your version number for the .xs file of this package.  This defaults
+to the value of the VERSION attribute.
+
+=back
+
+=head2 Additional lowercase attributes
+
+can be used to pass parameters to the methods which implement that
+part of the Makefile.
+
+=over 2
+
+=item clean
+
+  {FILES => "*.xyz foo"}
+
+=item depend
+
+  {ANY_TARGET => ANY_DEPENDECY, ...}
+
+=item dist
+
+  {TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => 'gz',
+  SHAR => 'shar -m', DIST_CP => 'ln', ZIP => '/bin/zip',
+  ZIPFLAGS => '-rl', DIST_DEFAULT => 'private tardist' }
+
+If you specify COMPRESS, then SUFFIX should also be altered, as it is
+needed to tell make the target file of the compression. Setting
+DIST_CP to ln can be useful, if you need to preserve the timestamps on
+your files. DIST_CP can take the values 'cp', which copies the file,
+'ln', which links the file, and 'best' which copies symbolic links and
+links the rest. Default is 'best'.
+
+=item dynamic_lib
+
+  {ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'}
+
+=item installpm
+
+Deprecated as of MakeMaker 5.23. See L<ExtUtils::MM_Unix/pm_to_blib>.
+
+=item linkext
+
+  {LINKTYPE => 'static', 'dynamic' or ''}
+
+NB: Extensions that have nothing but *.pm files had to say
+
+  {LINKTYPE => ''}
+
+with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line
+can be deleted safely. MakeMaker recognizes, when there's nothing to
+be linked.
+
+=item macro
+
+  {ANY_MACRO => ANY_VALUE, ...}
+
+=item realclean
+
+  {FILES => '$(INST_ARCHAUTODIR)/*.xyz'}
+
+=item tool_autosplit
+
+  {MAXLEN =E<gt> 8}
+
+=back
+
+=cut
+
+# bug in pod2html, so leave the =back
+
+# Don't delete this cut, MM depends on it!
+
+=head2 Overriding MakeMaker Methods
+
+If you cannot achieve the desired Makefile behaviour by specifying
+attributes you may define private subroutines in the Makefile.PL.
+Each subroutines returns the text it wishes to have written to
+the Makefile. To override a section of the Makefile you can
+either say:
+
+	sub MY::c_o { "new literal text" }
+
+or you can edit the default by saying something like:
+
+	sub MY::c_o {
+            my($inherited) = shift->SUPER::c_o(@_);
+	    $inherited =~ s/old text/new text/;
+	    $inherited;
+	}
+
+If you running experiments with embedding perl as a library into other
+applications, you might find MakeMaker not sufficient. You'd better
+have a look at ExtUtils::embed which is a collection of utilities for
+embedding.
+
+If you still need a different solution, try to develop another
+subroutine, that fits your needs and submit the diffs to
+F<perl5-porters@nicoh.com> or F<comp.lang.perl.misc> as appropriate.
+
+For a complete description of all MakeMaker methods see L<ExtUtils::MM_Unix>.
+
+Here is a simple example of how to add a new target to the generated
+Makefile:
+
+    sub MY::postamble {
+	'
+    $(MYEXTLIB): sdbm/Makefile
+	    cd sdbm && $(MAKE) all
+    ';
+    }
+
+
+=head2 Hintsfile support
+
+MakeMaker.pm uses the architecture specific information from
+Config.pm. In addition it evaluates architecture specific hints files
+in a C<hints/> directory. The hints files are expected to be named
+like their counterparts in C<PERL_SRC/hints>, but with an C<.pl> file
+name extension (eg. C<next_3_2.pl>). They are simply C<eval>ed by
+MakeMaker within the WriteMakefile() subroutine, and can be used to
+execute commands as well as to include special variables. The rules
+which hintsfile is chosen are the same as in Configure.
+
+The hintsfile is eval()ed immediately after the arguments given to
+WriteMakefile are stuffed into a hash reference $self but before this
+reference becomes blessed. So if you want to do the equivalent to
+override or create an attribute you would say something like
+
+    $self->{LIBS} = ['-ldbm -lucb -lc'];
+
+=head2 Distribution Support
+
+For authors of extensions MakeMaker provides several Makefile
+targets. Most of the support comes from the ExtUtils::Manifest module,
+where additional documentation can be found.
+
+=over 4
+
+=item    make distcheck
+
+reports which files are below the build directory but not in the
+MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for
+details)
+
+=item    make skipcheck
+
+reports which files are skipped due to the entries in the
+C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for
+details)
+
+=item    make distclean
+
+does a realclean first and then the distcheck. Note that this is not
+needed to build a new distribution as long as you are sure, that the
+MANIFEST file is ok.
+
+=item    make manifest
+
+rewrites the MANIFEST file, adding all remaining files found (See
+ExtUtils::Manifest::mkmanifest() for details)
+
+=item    make distdir
+
+Copies all the files that are in the MANIFEST file to a newly created
+directory with the name C<$(DISTNAME)-$(VERSION)>. If that directory
+exists, it will be removed first.
+
+=item	make disttest
+
+Makes a distdir first, and runs a C<perl Makefile.PL>, a make, and
+a make test in that directory.
+
+=item    make tardist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command, followed by $(TOUNIX), which defaults to a null command under
+UNIX, and will convert files in distribution directory to UNIX format
+otherwise. Next it runs C<tar> on that directory into a tarfile and
+deletes the directory. Finishes with a command $(POSTOP) which
+defaults to a null command.
+
+=item    make dist
+
+Defaults to $(DIST_DEFAULT) which in turn defaults to tardist.
+
+=item    make uutardist
+
+Runs a tardist first and uuencodes the tarfile.
+
+=item    make shdist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command. Next it runs C<shar> on that directory into a sharfile and
+deletes the intermediate directory again. Finishes with a command
+$(POSTOP) which defaults to a null command.  Note: For shdist to work
+properly a C<shar> program that can handle directories is mandatory.
+
+=item    make zipdist
+
+First does a distdir. Then a command $(PREOP) which defaults to a null
+command. Runs C<$(ZIP) $(ZIPFLAGS)> on that directory into a
+zipfile. Then deletes that directory. Finishes with a command
+$(POSTOP) which defaults to a null command.
+
+=item    make ci
+
+Does a $(CI) and a $(RCS_LABEL) on all files in the MANIFEST file.
+
+=back
+
+Customization of the dist targets can be done by specifying a hash
+reference to the dist attribute of the WriteMakefile call. The
+following parameters are recognized:
+
+    CI           ('ci -u')
+    COMPRESS     ('compress')
+    POSTOP       ('@ :')
+    PREOP        ('@ :')
+    TO_UNIX      (depends on the system)
+    RCS_LABEL    ('rcs -q -Nv$(VERSION_SYM):')
+    SHAR         ('shar')
+    SUFFIX       ('Z')
+    TAR          ('tar')
+    TARFLAGS     ('cvf')
+    ZIP          ('zip')
+    ZIPFLAGS     ('-r')
+
+An example:
+
+    WriteMakefile( 'dist' => { COMPRESS=>"gzip", SUFFIX=>"gz" })
+
+=head1 SEE ALSO
+
+ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
+ExtUtils::Install, ExtUtils::embed
+
+=head1 AUTHORS
+
+Andy Dougherty F<E<lt>doughera@lafcol.lafayette.eduE<gt>>, Andreas
+KE<ouml>nig F<E<lt>A.Koenig@franz.ww.TU-Berlin.DEE<gt>>, Tim Bunce
+F<E<lt>Tim.Bunce@ig.co.ukE<gt>>.  VMS support by Charles Bailey
+F<E<lt>bailey@genetics.upenn.eduE<gt>>. OS/2 support by Ilya
+Zakharevich F<E<lt>ilya@math.ohio-state.eduE<gt>>. Contact the
+makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
+you have any questions.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
new file mode 100644
index 00000000000..67210966bef
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Manifest.pm
@@ -0,0 +1,392 @@
+package ExtUtils::Manifest;
+
+
+require Exporter;
+@ISA=('Exporter');
+@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
+	      'skipcheck', 'maniread', 'manicopy');
+
+use Config;
+use File::Find;
+use File::Copy 'copy';
+use Carp;
+
+$Debug = 0;
+$Verbose = 1;
+$Is_VMS = $^O eq 'VMS';
+
+$VERSION = $VERSION = substr(q$Revision: 1.1.1.1 $,10,4);
+
+$Quiet = 0;
+
+$MANIFEST = 'MANIFEST';
+
+# Really cool fix from Ilya :)
+unless (defined $Config{d_link}) {
+    *ln = \&cp;
+}
+
+sub mkmanifest {
+    my $manimiss = 0;
+    my $read = maniread() or $manimiss++;
+    $read = {} if $manimiss;
+    local *M;
+    rename $MANIFEST, "$MANIFEST.bak" unless $manimiss;
+    open M, ">$MANIFEST" or die "Could not open $MANIFEST: $!";
+    my $matches = _maniskip();
+    my $found = manifind();
+    my($key,$val,$file,%all);
+    %all = (%$found, %$read);
+    $all{$MANIFEST} = ($Is_VMS ? "$MANIFEST\t\t" : '') . 'This list of files'
+        if $manimiss; # add new MANIFEST to known file list
+    foreach $file (sort keys %all) {
+	next if &$matches($file);
+	if ($Verbose){
+	    warn "Added to $MANIFEST: $file\n" unless exists $read->{$file};
+	}
+	my $text = $all{$file};
+	($file,$text) = split(/\s+/,$text,2) if $Is_VMS && $text;
+	my $tabs = (5 - (length($file)+1)/8);
+	$tabs = 1 if $tabs < 1;
+	$tabs = 0 unless $text;
+	print M $file, "\t" x $tabs, $text, "\n";
+    }
+    close M;
+}
+
+sub manifind {
+    local $found = {};
+    find(sub {return if -d $_;
+	      (my $name = $File::Find::name) =~ s|./||;
+	      warn "Debug: diskfile $name\n" if $Debug;
+	      $name  =~ s#(.*)\.$#\L$1# if $Is_VMS;
+	      $found->{$name} = "";}, ".");
+    $found;
+}
+
+sub fullcheck {
+    _manicheck(3);
+}
+
+sub manicheck {
+    return @{(_manicheck(1))[0]};
+}
+
+sub filecheck {
+    return @{(_manicheck(2))[1]};
+}
+
+sub skipcheck {
+    _manicheck(6);
+}
+
+sub _manicheck {
+    my($arg) = @_;
+    my $read = maniread();
+    my $file;
+    my(@missfile,@missentry);
+    if ($arg & 1){
+	my $found = manifind();
+	foreach $file (sort keys %$read){
+	    warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
+	    unless ( exists $found->{$file} ) {
+		warn "No such file: $file\n" unless $Quiet;
+		push @missfile, $file;
+	    }
+	}
+    }
+    if ($arg & 2){
+	$read ||= {};
+	my $matches = _maniskip();
+	my $found = manifind();
+	my $skipwarn = $arg & 4;
+	foreach $file (sort keys %$found){
+	    if (&$matches($file)){
+		warn "Skipping $file\n" if $skipwarn;
+		next;
+	    }
+	    warn "Debug: manicheck checking from disk $file\n" if $Debug;
+	    unless ( exists $read->{$file} ) {
+		warn "Not in $MANIFEST: $file\n" unless $Quiet;
+		push @missentry, $file;
+	    }
+	}
+    }
+    (\@missfile,\@missentry);
+}
+
+sub maniread {
+    my ($mfile) = @_;
+    $mfile = $MANIFEST unless defined $mfile;
+    my $read = {};
+    local *M;
+    unless (open M, $mfile){
+	warn "$mfile: $!";
+	return $read;
+    }
+    while (<M>){
+	chomp;
+	if ($Is_VMS) { /^(\S+)/ and $read->{"\L$1"}=$_; }
+	else         { /^(\S+)\s*(.*)/ and $read->{$1}=$2; }
+    }
+    close M;
+    $read;
+}
+
+# returns an anonymous sub that decides if an argument matches
+sub _maniskip {
+    my ($mfile) = @_;
+    my $matches = sub {0};
+    my @skip ;
+    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
+    local *M;
+    return $matches unless -f $mfile;
+    open M, $mfile or return $matches;
+    while (<M>){
+	chomp;
+	next if /^\s*$/;
+	push @skip, $_;
+    }
+    close M;
+    my $opts = $Is_VMS ? 'oi ' : 'o ';
+    my $sub = "\$matches = "
+	. "sub { my(\$arg)=\@_; return 1 if "
+	. join (" || ",  (map {s!/!\\/!g; "\$arg =~ m/$_/$opts"} @skip), 0)
+	. " }";
+    eval $sub;
+    print "Debug: $sub\n" if $Debug;
+    $matches;
+}
+
+sub manicopy {
+    my($read,$target,$how)=@_;
+    croak "manicopy() called without target argument" unless defined $target;
+    $how = 'cp' unless defined $how && $how;
+    require File::Path;
+    require File::Basename;
+    my(%dirs,$file);
+    $target = VMS::Filespec::unixify($target) if $Is_VMS;
+    umask 0 unless $Is_VMS;
+    File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755);
+    foreach $file (keys %$read){
+	$file = VMS::Filespec::unixify($file) if $Is_VMS;
+	if ($file =~ m!/!) { # Ilya, that hurts, I fear, or maybe not?
+	    my $dir = File::Basename::dirname($file);
+	    $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
+	    File::Path::mkpath(["$target/$dir"],1,$Is_VMS ? undef : 0755);
+	}
+	if ($Is_VMS) { vms_cp_if_diff($file,"$target/$file"); }
+	else         { cp_if_diff($file, "$target/$file", $how); }
+    }
+}
+
+sub cp_if_diff {
+    my($from,$to, $how)=@_;
+    -f $from || carp "$0: $from not found";
+    my($diff) = 0;
+    local(*F,*T);
+    open(F,$from) or croak "Can't read $from: $!\n";
+    if (open(T,$to)) {
+	while (<F>) { $diff++,last if $_ ne <T>; }
+	$diff++ unless eof(T);
+	close T;
+    }
+    else { $diff++; }
+    close F;
+    if ($diff) {
+	if (-e $to) {
+	    unlink($to) or confess "unlink $to: $!";
+	}
+	&$how($from, $to);
+    }
+}
+
+# Do the comparisons here rather than spawning off another process
+sub vms_cp_if_diff {
+    my($from,$to) = @_;
+    my($diff) = 0;
+    local(*F,*T);
+    open(F,$from) or croak "Can't read $from: $!\n";
+    if (open(T,$to)) {
+	while (<F>) { $diff++,last if $_ ne <T>; }
+	$diff++ unless eof(T);
+	close T;
+    }
+    else { $diff++; }
+    close F;
+    if ($diff) {
+	system('copy',VMS::Filespec::vmsify($from),VMS::Filespec::vmsify($to)) & 1
+	    or confess "Copy failed: $!";
+    }
+}
+
+sub cp {
+    my ($srcFile, $dstFile) = @_;
+    my ($perm,$access,$mod) = (stat $srcFile)[2,8,9];
+    copy($srcFile,$dstFile);
+    utime $access, $mod, $dstFile;
+    # chmod a+rX-w,go-w
+    chmod(  0444 | ( $perm & 0111 ? 0111 : 0 ),  $dstFile );
+}
+
+sub ln {
+    my ($srcFile, $dstFile) = @_;
+    link($srcFile, $dstFile);
+    local($_) = $dstFile; # chmod a+r,go-w+X (except "X" only applies to u=x)
+    my $mode= 0444 | (stat)[2] & 0700;
+    chmod(  $mode | ( $mode & 0100 ? 0111 : 0 ),  $_  );
+}
+
+sub best {
+    my ($srcFile, $dstFile) = @_;
+    if (-l $srcFile) {
+	cp($srcFile, $dstFile);
+    } else {
+	ln($srcFile, $dstFile);
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Manifest - utilities to write and check a MANIFEST file
+
+=head1 SYNOPSIS
+
+C<require ExtUtils::Manifest;>
+
+C<ExtUtils::Manifest::mkmanifest;>
+
+C<ExtUtils::Manifest::manicheck;>
+
+C<ExtUtils::Manifest::filecheck;>
+
+C<ExtUtils::Manifest::fullcheck;>
+
+C<ExtUtils::Manifest::skipcheck;>
+
+C<ExtUtild::Manifest::manifind();>
+
+C<ExtUtils::Manifest::maniread($file);>
+
+C<ExtUtils::Manifest::manicopy($read,$target,$how);>
+
+=head1 DESCRIPTION
+
+Mkmanifest() writes all files in and below the current directory to a
+file named in the global variable $ExtUtils::Manifest::MANIFEST (which
+defaults to C<MANIFEST>) in the current directory. It works similar to
+
+    find . -print
+
+but in doing so checks each line in an existing C<MANIFEST> file and
+includes any comments that are found in the existing C<MANIFEST> file
+in the new one. Anything between white space and an end of line within
+a C<MANIFEST> file is considered to be a comment. Filenames and
+comments are seperated by one or more TAB characters in the
+output. All files that match any regular expression in a file
+C<MANIFEST.SKIP> (if such a file exists) are ignored.
+
+Manicheck() checks if all the files within a C<MANIFEST> in the
+current directory really do exist. It only reports discrepancies and
+exits silently if MANIFEST and the tree below the current directory
+are in sync.
+
+Filecheck() finds files below the current directory that are not
+mentioned in the C<MANIFEST> file. An optional file C<MANIFEST.SKIP>
+will be consulted. Any file matching a regular expression in such a
+file will not be reported as missing in the C<MANIFEST> file.
+
+Fullcheck() does both a manicheck() and a filecheck().
+
+Skipcheck() lists all the files that are skipped due to your
+C<MANIFEST.SKIP> file.
+
+Manifind() retruns a hash reference. The keys of the hash are the
+files found below the current directory.
+
+Maniread($file) reads a named C<MANIFEST> file (defaults to
+C<MANIFEST> in the current directory) and returns a HASH reference
+with files being the keys and comments being the values of the HASH.
+
+I<Manicopy($read,$target,$how)> copies the files that are the keys in
+the HASH I<%$read> to the named target directory. The HASH reference
+I<$read> is typically returned by the maniread() function. This
+function is useful for producing a directory tree identical to the
+intended distribution tree. The third parameter $how can be used to
+specify a different methods of "copying". Valid values are C<cp>,
+which actually copies the files, C<ln> which creates hard links, and
+C<best> which mostly links the files but copies any symbolic link to
+make a tree without any symbolic link. Best is the default.
+
+=head1 MANIFEST.SKIP
+
+The file MANIFEST.SKIP may contain regular expressions of files that
+should be ignored by mkmanifest() and filecheck(). The regular
+expressions should appear one on each line. A typical example:
+
+    \bRCS\b
+    ^MANIFEST\.
+    ^Makefile$
+    ~$
+    \.html$
+    \.old$
+    ^blib/
+    ^MakeMaker-\d
+
+=head1 EXPORT_OK
+
+C<&mkmanifest>, C<&manicheck>, C<&filecheck>, C<&fullcheck>,
+C<&maniread>, and C<&manicopy> are exportable.
+
+=head1 GLOBAL VARIABLES
+
+C<$ExtUtils::Manifest::MANIFEST> defaults to C<MANIFEST>. Changing it
+results in both a different C<MANIFEST> and a different
+C<MANIFEST.SKIP> file. This is useful if you want to maintain
+different distributions for different audiences (say a user version
+and a developer version including RCS).
+
+<$ExtUtils::Manifest::Quiet> defaults to 0. If set to a true value,
+all functions act silently.
+
+=head1 DIAGNOSTICS
+
+All diagnostic output is sent to C<STDERR>.
+
+=over
+
+=item C<Not in MANIFEST:> I<file>
+
+is reported if a file is found, that is missing in the C<MANIFEST>
+file which is excluded by a regular expression in the file
+C<MANIFEST.SKIP>.
+
+=item C<No such file:> I<file>
+
+is reported if a file mentioned in a C<MANIFEST> file does not
+exist.
+
+=item C<MANIFEST:> I<$!>
+
+is reported if C<MANIFEST> could not be opened.
+
+=item C<Added to MANIFEST:> I<file>
+
+is reported by mkmanifest() if $Verbose is set and a file is added
+to MANIFEST. $Verbose is set to 1 by default.
+
+=back
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker> which has handy targets for most of the functionality.
+
+=head1 AUTHOR
+
+Andreas Koenig F<E<lt>koenig@franz.ww.TU-Berlin.DEE<gt>>
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
new file mode 100644
index 00000000000..06c001553bf
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mkbootstrap.pm
@@ -0,0 +1,97 @@
+package ExtUtils::Mkbootstrap;
+use Config;
+use Exporter;
+@ISA=('Exporter');
+@EXPORT='&Mkbootstrap';
+$Version=2.0; # just to start somewhere
+
+sub Mkbootstrap {
+
+=head1 NAME
+
+ExtUtils::Mkbootstrap - make a bootstrap file for use by DynaLoader
+
+=head1 SYNOPSIS
+
+C<mkbootstrap>
+
+=head1 DESCRIPTION
+
+Mkbootstrap typically gets called from an extension Makefile.
+
+There is no C<*.bs> file supplied with the extension. Instead a
+C<*_BS> file which has code for the special cases, like posix for
+berkeley db on the NeXT.
+
+This file will get parsed, and produce a maybe empty
+C<@DynaLoader::dl_resolve_using> array for the current architecture.
+That will be extended by $BSLOADLIBS, which was computed by
+ExtUtils::Liblist::ext(). If this array still is empty, we do nothing,
+else we write a .bs file with an C<@DynaLoader::dl_resolve_using>
+array.
+
+The C<*_BS> file can put some code into the generated C<*.bs> file by
+placing it in C<$bscode>. This is a handy 'escape' mechanism that may
+prove useful in complex situations.
+
+If @DynaLoader::dl_resolve_using contains C<-L*> or C<-l*> entries then
+Mkbootstrap will automatically add a dl_findfile() call to the
+generated C<*.bs> file.
+
+=cut
+
+    my($baseext, @bsloadlibs)=@_;
+
+    @bsloadlibs = grep($_, @bsloadlibs); # strip empty libs
+
+    print STDOUT "	bsloadlibs=@bsloadlibs\n" if $Verbose;
+
+    # We need DynaLoader here because we and/or the *_BS file may
+    # call dl_findfile(). We don't say `use' here because when
+    # first building perl extensions the DynaLoader will not have
+    # been built when MakeMaker gets first used.
+    require DynaLoader;
+
+    rename "$baseext.bs", "$baseext.bso"
+      if -s "$baseext.bs";
+
+    if (-f "${baseext}_BS"){
+	$_ = "${baseext}_BS";
+	package DynaLoader; # execute code as if in DynaLoader
+	$bscode = "";
+	unshift @INC, ".";
+	require $_;
+	shift @INC;
+    }
+
+    if ($Config{'dlsrc'} =~ /^dl_dld/){
+	package DynaLoader;
+	push(@dl_resolve_using, dl_findfile('-lc'));
+    }
+
+    my(@all) = (@bsloadlibs, @DynaLoader::dl_resolve_using);
+    my($method) = '';
+    if (@all){
+	open BS, ">$baseext.bs"
+		or die "Unable to open $baseext.bs: $!";
+	print STDOUT "Writing $baseext.bs\n";
+	print STDOUT "	containing: @all" if $Verbose;
+	print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
+	print BS "# Do not edit this file, changes will be lost.\n";
+	print BS "# This file was automatically generated by the\n";
+	print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$Version).\n";
+	print BS "\@DynaLoader::dl_resolve_using = ";
+	# If @all contains names in the form -lxxx or -Lxxx then it's asking for
+	# runtime library location so we automatically add a call to dl_findfile()
+	if (" @all" =~ m/ -[lLR]/){
+	    print BS "  dl_findfile(qw(\n  @all\n  ));\n";
+	}else{
+	    print BS "  qw(@all);\n";
+	}
+	# write extra code if *_BS says so
+	print BS $DynaLoader::bscode if $DynaLoader::bscode;
+	print BS "\n1;\n";
+	close BS;
+    }
+}
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
new file mode 100644
index 00000000000..5c0173a5085
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/Mksymlists.pm
@@ -0,0 +1,226 @@
+package ExtUtils::Mksymlists;
+use strict qw[ subs refs ];
+# no strict 'vars';  # until filehandles are exempted
+
+use Carp;
+use Exporter;
+use vars qw( @ISA @EXPORT $VERSION );
+@ISA = 'Exporter';
+@EXPORT = '&Mksymlists';
+$VERSION = '1.03';
+
+sub Mksymlists {
+    my(%spec) = @_;
+    my($osname) = $^O;
+
+    croak("Insufficient information specified to Mksymlists")
+        unless ( $spec{NAME} or
+                 ($spec{FILE} and ($spec{DL_FUNCS} or $spec{FUNCLIST})) );
+
+    $spec{DL_VARS} = [] unless $spec{DL_VARS};
+    ($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
+    $spec{DL_FUNCS} = { $spec{NAME} => [] }
+        unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
+                 $spec{FUNCLIST});
+    $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
+    if (defined $spec{DL_FUNCS}) {
+        my($package);
+        foreach $package (keys %{$spec{DL_FUNCS}}) {
+            my($packprefix,$sym,$bootseen);
+            ($packprefix = $package) =~ s/\W/_/g;
+            foreach $sym (@{$spec{DL_FUNCS}->{$package}}) {
+                if ($sym =~ /^boot_/) {
+                    push(@{$spec{FUNCLIST}},$sym);
+                    $bootseen++;
+                }
+                else { push(@{$spec{FUNCLIST}},"XS_${packprefix}_$sym"); }
+            }
+            push(@{$spec{FUNCLIST}},"boot_$packprefix") unless $bootseen;
+        }
+    }
+
+#    We'll need this if we ever add any OS which uses mod2fname
+#    require DynaLoader;
+    if (defined &DynaLoader::mod2fname and not $spec{DLBASE}) {
+        $spec{DLBASE} = DynaLoader::mod2fname([ split(/::/,$spec{NAME}) ]);
+    }
+
+    if    ($osname eq 'aix') { _write_aix(\%spec); }
+    elsif ($osname eq 'VMS') { _write_vms(\%spec) }
+    elsif ($osname =~ m|^os/?2$|i) { _write_os2(\%spec) }
+    else { croak("Don't know how to create linker option file for $osname\n"); }
+}
+
+
+sub _write_aix {
+    my($data) = @_;
+
+    rename "$data->{FILE}.exp", "$data->{FILE}.exp_old";
+
+    open(EXP,">$data->{FILE}.exp")
+        or croak("Can't create $data->{FILE}.exp: $!\n");
+    print EXP join("\n",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print EXP join("\n",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    close EXP;
+}
+
+
+sub _write_os2 {
+    my($data) = @_;
+
+    if (not $data->{DLBASE}) {
+        ($data->{DLBASE} = $data->{NAME}) =~ s/.*:://;
+        $data->{DLBASE} = substr($data->{DLBASE},0,7) . '_';
+    }
+    rename "$data->{FILE}.def", "$data->{FILE}_def.old";
+
+    open(DEF,">$data->{FILE}.def")
+        or croak("Can't create $data->{FILE}.def: $!\n");
+    print DEF "LIBRARY '$data->{DLBASE}' INITINSTANCE TERMINSTANCE\n";
+    print DEF "CODE LOADONCALL\n";
+    print DEF "DATA LOADONCALL NONSHARED MULTIPLE\n";
+    print DEF "EXPORTS\n  ";
+    print DEF join("\n  ",@{$data->{DL_VARS}}, "\n") if @{$data->{DL_VARS}};
+    print DEF join("\n  ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
+    if (%{$data->{IMPORTS}}) {
+        print DEF "IMPORTS\n";
+my ($name, $exp);
+while (($name, $exp)= each %{$data->{IMPORTS}}) {
+  print DEF "  $name=$exp\n";
+}
+    }
+    close DEF;
+}
+
+
+sub _write_vms {
+    my($data) = @_;
+
+    require Config; # a reminder for once we do $^O
+
+    my($isvax) = $Config::Config{'arch'} =~ /VAX/i;
+    my($sym);
+
+    rename "$data->{FILE}.opt", "$data->{FILE}.opt_old";
+
+    open(OPT,">$data->{FILE}.opt")
+        or croak("Can't create $data->{FILE}.opt: $!\n");
+
+    # Options file declaring universal symbols
+    # Used when linking shareable image for dynamic extension,
+    # or when linking PerlShr into which we've added this package
+    # as a static extension
+    # We don't do anything to preserve order, so we won't relax
+    # the GSMATCH criteria for a dynamic extension
+
+    foreach $sym (@{$data->{FUNCLIST}}) {
+        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
+        else        { print OPT "SYMBOL_VECTOR=($sym=PROCEDURE)\n"; }
+    }
+    foreach $sym (@{$data->{DL_VARS}}) {
+        print OPT "PSECT_ATTR=${sym},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
+        if ($isvax) { print OPT "UNIVERSAL=$sym\n" }
+        else        { print OPT "SYMBOL_VECTOR=($sym=DATA)\n"; }
+    }
+    close OPT;
+
+    # Options file specifying RTLs to which this extension must be linked.
+    # Eventually, the list of libraries will be supplied by a working
+    # extliblist routine.
+    open OPT,'>rtls.opt';
+    print OPT "PerlShr/Share\n";
+    foreach $rtl (split(/\s+/,$Config::Config{'libs'})) { print OPT "$rtl\n"; }
+    close OPT;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ExtUtils::Mksymlists - write linker options files for dynamic extension
+
+=head1 SYNOPSIS
+
+    use ExtUtils::Mksymlists;
+    Mksymlists({ NAME     => $name ,
+                 DL_VARS  => [ $var1, $var2, $var3 ],
+                 DL_FUNCS => { $pkg1 => [ $func1, $func2 ],
+                               $pkg2 => [ $func3 ] });
+
+=head1 DESCRIPTION
+
+C<ExtUtils::Mksymlists> produces files used by the linker under some OSs
+during the creation of shared libraries for synamic extensions.  It is
+normally called from a MakeMaker-generated Makefile when the extension
+is built.  The linker option file is generated by calling the function
+C<Mksymlists>, which is exported by default from C<ExtUtils::Mksymlists>.
+It takes one argument, a list of key-value pairs, in which the following
+keys are recognized:
+
+=item NAME
+
+This gives the name of the extension (I<e.g.> Tk::Canvas) for which
+the linker option file will be produced.
+
+=item DL_FUNCS
+
+This is identical to the DL_FUNCS attribute available via MakeMaker,
+from which it is usually taken.  Its value is a reference to an
+associative array, in which each key is the name of a package, and
+each value is an a reference to an array of function names which
+should be exported by the extension.  For instance, one might say
+C<DL_FUNCS =E<gt> { Homer::Iliad   =E<gt> [ qw(trojans greeks) ],
+Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>.  The
+function names should be identical to those in the XSUB code;
+C<Mksymlists> will alter the names written to the linker option
+file to match the changes made by F<xsubpp>.  In addition, if
+none of the functions in a list begin with the string B<boot_>,
+C<Mksymlists> will add a bootstrap function for that package,
+just as xsubpp does.  (If a B<boot_E<lt>pkgE<gt>> function is
+present in the list, it is passed through unchanged.)  If
+DL_FUNCS is not specified, it defaults to the bootstrap
+function for the extension specified in NAME.
+
+=item DL_VARS
+
+This is identical to the DL_VARS attribute available via MakeMaker,
+and, like DL_FUNCS, it is usually specified via MakeMaker.  Its
+value is a reference to an array of variable names which should
+be exported by the extension.
+
+=item FILE
+
+This key can be used to specify the name of the linker option file
+(minus the OS-specific extension), if for some reason you do not
+want to use the default value, which is the last word of the NAME
+attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
+
+=item FUNCLIST
+
+This provides an alternate means to specify function names to be
+exported from the extension.  Its value is a reference to an
+array of function names to be exported by the extension.  These
+names are passed through unaltered to the linker options file.
+
+=item DLBASE
+
+This item specifies the name by which the linker knows the
+extension, which may be different from the name of the
+extension itself (for instance, some linkers add an '_' to the
+name of the extension).  If it is not specified, it is derived
+from the NAME attribute.  It is presently used only by OS2.
+
+When calling C<Mksymlists>, one should always specify the NAME
+attribute.  In most cases, this is all that's necessary.  In
+the case of unusual extensions, however, the other attributes
+can be used to provide additional information to the linker.
+
+=head1 AUTHOR
+
+Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
+
+=head1 REVISION
+
+Last revised 14-Feb-1996, for Perl 5.002.
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
new file mode 100644
index 00000000000..d5596047fb7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/testlib.pm
@@ -0,0 +1,23 @@
+package ExtUtils::testlib;
+use lib qw(blib/arch blib/lib);
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::testlib - add blib/* directories to @INC
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::testlib;>
+
+=head1 DESCRIPTION
+
+After an extension has been built and before it is installed it may be
+desirable to test it bypassing C<make test>. By adding
+
+    use ExtUtils::testlib;
+
+to a test program the intermediate directories used by C<make> are
+added to @INC.
+
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/typemap b/gnu/usr.bin/perl/lib/ExtUtils/typemap
new file mode 100644
index 00000000000..a9733d0f491
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/typemap
@@ -0,0 +1,284 @@
+# $Header$ 
+# basic C types
+int			T_IV
+unsigned		T_IV
+unsigned int		T_IV
+long			T_IV
+unsigned long		T_IV
+short			T_IV
+unsigned short		T_IV
+char			T_CHAR
+unsigned char		T_U_CHAR
+char *			T_PV
+unsigned char *		T_PV
+caddr_t			T_PV
+wchar_t *		T_PV
+wchar_t			T_IV
+bool_t			T_IV
+size_t			T_IV
+ssize_t			T_IV
+time_t			T_NV
+unsigned long *		T_OPAQUEPTR
+char **			T_PACKED
+void *			T_PTR
+Time_t *		T_PV
+SV *			T_SV
+SVREF			T_SVREF
+AV *			T_AVREF
+HV *			T_HVREF
+CV *			T_CVREF
+
+IV			T_IV
+I32			T_IV
+I16			T_IV
+I8			T_IV
+U32			T_U_LONG
+U16			T_U_SHORT
+U8			T_IV
+Result			T_U_CHAR
+Boolean			T_IV
+double			T_DOUBLE
+SysRet			T_SYSRET
+SysRetLong		T_SYSRET
+FILE *			T_IN
+FileHandle		T_PTROBJ
+InputStream		T_IN
+InOutStream		T_INOUT
+OutputStream		T_OUT
+
+#############################################################################
+INPUT
+T_SV
+	$var = $arg
+T_SVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (SV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_AVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (AV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_HVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (HV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_CVREF
+	if (sv_isa($arg, \"${ntype}\"))
+	    $var = (CV*)SvRV($arg);
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_SYSRET
+	$var NOT IMPLEMENTED
+T_IV
+	$var = ($type)SvIV($arg)
+T_INT
+	$var = (int)SvIV($arg)
+T_ENUM
+	$var = ($type)SvIV($arg)
+T_U_INT
+	$var = (unsigned int)SvIV($arg)
+T_SHORT
+	$var = (short)SvIV($arg)
+T_U_SHORT
+	$var = (unsigned short)SvIV($arg)
+T_LONG
+	$var = (long)SvIV($arg)
+T_U_LONG
+	$var = (unsigned long)SvIV($arg)
+T_CHAR
+	$var = (char)*SvPV($arg,na)
+T_U_CHAR
+	$var = (unsigned char)SvIV($arg)
+T_FLOAT
+	$var = (float)SvNV($arg)
+T_NV
+	$var = ($type)SvNV($arg)
+T_DOUBLE
+	$var = (double)SvNV($arg)
+T_PV
+	$var = ($type)SvPV($arg,na)
+T_PTR
+	$var = ($type)SvIV($arg)
+T_PTRREF
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+T_REF_IV_REF
+	if (sv_isa($arg, \"${type}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type *) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_REF_IV_PTR
+	if (sv_isa($arg, \"${type}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_PTROBJ
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = ($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_PTRDESC
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    ${type}_desc = (\U${type}_DESC\E*) tmp; 
+	    $var = ${type}_desc->ptr;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_REFREF
+	if (SvROK($arg)) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type) tmp;
+	}
+	else
+	    croak(\"$var is not a reference\")
+T_REFOBJ
+	if (sv_isa($arg, \"${ntype}\")) {
+	    IV tmp = SvIV((SV*)SvRV($arg));
+	    $var = *($type) tmp;
+	}
+	else
+	    croak(\"$var is not of type ${ntype}\")
+T_OPAQUE
+	$var NOT IMPLEMENTED
+T_OPAQUEPTR
+	$var = ($type)SvPV($arg,na)
+T_PACKED
+	$var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+	$var = XS_unpack_$ntype($arg)
+T_CALLBACK
+	$var = make_perl_cb_$type($arg)
+T_ARRAY
+	$var = $ntype(items -= $argoff);
+	U32 ix_$var = $argoff;
+	while (items--) {
+	    DO_ARRAY_ELEM;
+	}
+T_IN
+	$var = IoIFP(sv_2io($arg))
+T_INOUT
+	$var = IoIFP(sv_2io($arg))
+T_OUT
+	$var = IoOFP(sv_2io($arg))
+#############################################################################
+OUTPUT
+T_SV
+	$arg = $var;
+T_SVREF
+	$arg = newRV((SV*)$var);
+T_AVREF
+	$arg = newRV((SV*)$var);
+T_HVREF
+	$arg = newRV((SV*)$var);
+T_CVREF
+	$arg = newRV((SV*)$var);
+T_IV
+	sv_setiv($arg, (IV)$var);
+T_INT
+	sv_setiv($arg, (IV)$var);
+T_SYSRET
+	if ($var != -1) {
+	    if ($var == 0)
+		sv_setpvn($arg, "0 but true", 10);
+	    else
+		sv_setiv($arg, (IV)$var);
+	}
+T_ENUM
+	sv_setiv($arg, (IV)$var);
+T_U_INT
+	sv_setiv($arg, (IV)$var);
+T_SHORT
+	sv_setiv($arg, (IV)$var);
+T_U_SHORT
+	sv_setiv($arg, (IV)$var);
+T_LONG
+	sv_setiv($arg, (IV)$var);
+T_U_LONG
+	sv_setiv($arg, (IV)$var);
+T_CHAR
+	sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+	sv_setiv($arg, (IV)$var);
+T_FLOAT
+	sv_setnv($arg, (double)$var);
+T_NV
+	sv_setnv($arg, (double)$var);
+T_DOUBLE
+	sv_setnv($arg, (double)$var);
+T_PV
+	sv_setpv((SV*)$arg, $var);
+T_PTR
+	sv_setiv($arg, (IV)$var);
+T_PTRREF
+	sv_setref_pv($arg, Nullch, (void*)$var);
+T_REF_IV_REF
+	sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
+T_REF_IV_PTR
+	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTROBJ
+	sv_setref_pv($arg, \"${ntype}\", (void*)$var);
+T_PTRDESC
+	sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
+T_REFREF
+	sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
+		    ($var ? (void*)new $ntype($var) : 0));
+T_REFOBJ
+	NOT IMPLEMENTED
+T_OPAQUE
+	sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+	sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+T_PACKED
+	XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+	XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT	
+	sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+	sv_setpvn($arg, $var.context.value().chp(),
+		$var.context.value().size());
+T_ARRAY
+	ST_EXTEND($var.size);
+	for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+		ST(ix_$var) = sv_newmortal();
+	DO_ARRAY_ELEM
+	}
+	sp += $var.size - 1;
+T_IN
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
+T_INOUT
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
+T_OUT
+	{
+	    GV *gv = newGVgen("$Package");
+	    if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
+		sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
+	    else
+		$arg = &sv_undef;
+	}
diff --git a/gnu/usr.bin/perl/lib/ExtUtils/xsubpp b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
new file mode 100644
index 00000000000..8554bb5054e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ExtUtils/xsubpp
@@ -0,0 +1,1218 @@
+#!./miniperl
+
+=head1 NAME
+
+xsubpp - compiler to convert Perl XS code into C code
+
+=head1 SYNOPSIS
+
+B<xsubpp> [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-typemap typemap>]... file.xs
+
+=head1 DESCRIPTION
+
+I<xsubpp> will compile XS code into C code by embedding the constructs
+necessary to let C functions manipulate Perl values and creates the glue
+necessary to let Perl access those functions.  The compiler uses typemaps to
+determine how to map C function parameters and variables to Perl values.
+
+The compiler will search for typemap files called I<typemap>.  It will use
+the following search path to find default typemaps, with the rightmost
+typemap taking precedence.
+
+	../../../typemap:../../typemap:../typemap:typemap
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-C++>
+
+Adds ``extern "C"'' to the C code.
+
+
+=item B<-except>
+
+Adds exception handling stubs to the C code.
+
+=item B<-typemap typemap>
+
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps.  This option may be used multiple times, with the last
+typemap having the highest precedence.
+
+=item B<-v>
+
+Prints the I<xsubpp> version number to standard output, then exits.
+
+=item B<-prototypes>
+
+By default I<xsubpp> will not automatically generate prototype code for
+all xsubs. This flag will enable prototypes.
+
+=item B<-noversioncheck>
+
+Disables the run time test that determines if the object file (derived
+from the C<.xs> file) and the C<.pm> files have the same version
+number.
+
+=back
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Larry Wall
+
+=head1 MODIFICATION HISTORY
+
+See the file F<changes.pod>.
+
+=head1 SEE ALSO
+
+perl(1), perlxs(1), perlxstut(1), perlapi(1)
+
+=cut
+
+# Global Constants
+$XSUBPP_version = "1.935";
+require 5.002;
+use vars '$cplusplus';
+
+sub Q ;
+
+$FH = 'File0000' ;
+
+$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-s pattern] [-typemap typemap]... file.xs\n";
+
+$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
+
+$except = "";
+$WantPrototypes = -1 ;
+$WantVersionChk = 1 ;
+$ProtoUsed = 0 ;
+SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) {
+    $flag = shift @ARGV;
+    $flag =~ s/^-// ;
+    $spat = shift,	next SWITCH	if $flag eq 's';
+    $cplusplus = 1,	next SWITCH	if $flag eq 'C++';
+    $WantPrototypes = 0, next SWITCH	if $flag eq 'noprototypes';
+    $WantPrototypes = 1, next SWITCH	if $flag eq 'prototypes';
+    $WantVersionChk = 0, next SWITCH	if $flag eq 'noversioncheck';
+    $WantVersionChk = 1, next SWITCH	if $flag eq 'versioncheck';
+    $except = " TRY",	next SWITCH	if $flag eq 'except';
+    push(@tm,shift),	next SWITCH	if $flag eq 'typemap';
+    (print "xsubpp version $XSUBPP_version\n"), exit  	
+	if $flag eq 'v';
+    die $usage;
+}
+if ($WantPrototypes == -1)
+  { $WantPrototypes = 0}
+else
+  { $ProtoUsed = 1 }
+
+
+@ARGV == 1 or die $usage;
+($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)#
+	or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)#
+	or ($dir, $filename) = ('.', $ARGV[0]);
+chdir($dir);
+# Check for VMS; Config.pm may not be installed yet, but this routine
+# is built into VMS perl
+if (defined(&VMS::Filespec::vmsify)) { $Is_VMS = 1; $pwd = $ENV{DEFAULT}; }
+else                                 { $Is_VMS = 0; chomp($pwd = `pwd`);   }
+
+++ $IncludedFiles{$ARGV[0]} ;
+
+my(@XSStack) = ({type => 'none'});	# Stack of conditionals and INCLUDEs
+my($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
+
+sub TrimWhitespace
+{
+    $_[0] =~ s/^\s+|\s+$//go ;
+}
+
+sub TidyType
+{
+    local ($_) = @_ ;
+
+    # rationalise any '*' by joining them into bunches and removing whitespace
+    s#\s*(\*+)\s*#$1#g;
+    s#(\*+)# $1 #g ;
+
+    # change multiple whitespace into a single space
+    s/\s+/ /g ;
+    
+    # trim leading & trailing whitespace
+    TrimWhitespace($_) ;
+
+    $_ ;
+}
+
+$typemap = shift @ARGV;
+foreach $typemap (@tm) {
+    die "Can't find $typemap in $pwd\n" unless -r $typemap;
+}
+unshift @tm, qw(../../../../lib/ExtUtils/typemap ../../../lib/ExtUtils/typemap
+                ../../lib/ExtUtils/typemap ../../../typemap ../../typemap
+                ../typemap typemap);
+foreach $typemap (@tm) {
+    next unless -e $typemap ;
+    # skip directories, binary files etc.
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next 
+	unless -T $typemap ;
+    open(TYPEMAP, $typemap) 
+	or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+    $mode = 'Typemap';
+    $junk = "" ;
+    $current = \$junk;
+    while (<TYPEMAP>) {
+	next if /^\s*#/;
+	if (/^INPUT\s*$/)   { $mode = 'Input';   $current = \$junk;  next; }
+	if (/^OUTPUT\s*$/)  { $mode = 'Output';  $current = \$junk;  next; }
+	if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk;  next; }
+	if ($mode eq 'Typemap') {
+	    chomp;
+	    my $line = $_ ;
+            TrimWhitespace($_) ;
+	    # skip blank lines and comment lines
+	    next if /^$/ or /^#/ ;
+	    my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
+		warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
+            $type = TidyType($type) ;
+	    $type_kind{$type} = $kind ;
+            # prototype defaults to '$'
+            $proto = '$' unless $proto ;
+            warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n") 
+                unless ValidProtoString($proto) ;
+            $proto_letter{$type} = C_string($proto) ;
+	}
+	elsif (/^\s/) {
+	    $$current .= $_;
+	}
+	elsif ($mode eq 'Input') {
+	    s/\s+$//;
+	    $input_expr{$_} = '';
+	    $current = \$input_expr{$_};
+	}
+	else {
+	    s/\s+$//;
+	    $output_expr{$_} = '';
+	    $current = \$output_expr{$_};
+	}
+    }
+    close(TYPEMAP);
+}
+
+foreach $key (keys %input_expr) {
+    $input_expr{$key} =~ s/\n+$//;
+}
+
+$END = "!End!\n\n";		# "impossible" keyword (multiple newline)
+
+# Match an XS keyword
+$BLOCK_re= '\s*(' . join('|', qw(
+	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
+	CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
+	)) . "|$END)\\s*:";
+
+# Input:  ($_, @line) == unparsed input.
+# Output: ($_, @line) == (rest of line, following lines).
+# Return: the matched keyword if found, otherwise 0
+sub check_keyword {
+	$_ = shift(@line) while !/\S/ && @line;
+	s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
+}
+
+
+sub print_section {
+    $_ = shift(@line) while !/\S/ && @line;
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	print "$_\n";
+    }
+}
+
+sub process_keyword($)
+{
+    my($pattern) = @_ ;
+    my $kwd ;
+
+    &{"${kwd}_handler"}() 
+        while $kwd = check_keyword($pattern) ;
+}
+
+sub CASE_handler {
+    blurt ("Error: `CASE:' after unconditional `CASE:'")
+	if $condnum && $cond eq '';
+    $cond = $_;
+    TrimWhitespace($cond);
+    print "   ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
+    $_ = '' ;
+}
+
+sub INPUT_handler {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	last if /^\s*NOT_IMPLEMENTED_YET/;
+	next unless /\S/;	# skip blank lines 
+
+	TrimWhitespace($_) ;
+	my $line = $_ ;
+
+	# remove trailing semicolon if no initialisation
+	s/\s*;$//g unless /=/ ;
+
+	# check for optional initialisation code
+	my $var_init = '' ;
+	$var_init = $1 if s/\s*(=.*)$//s ;
+	$var_init =~ s/"/\\"/g;
+
+	s/\s+/ /g;
+	my ($var_type, $var_addr, $var_name) = /^(.*?[^& ]) *(\&?) *\b(\w+)$/s
+	    or blurt("Error: invalid argument declaration '$line'"), next;
+
+	# Check for duplicate definitions
+	blurt ("Error: duplicate definition of argument '$var_name' ignored"), next
+	    if $arg_list{$var_name} ++  ;
+
+	$thisdone |= $var_name eq "THIS";
+	$retvaldone |= $var_name eq "RETVAL";
+	$var_types{$var_name} = $var_type;
+	print "\t" . &map_type($var_type);
+	$var_num = $args_match{$var_name};
+
+        $proto_arg[$var_num] = ProtoString($var_type) 
+	    if $var_num ;
+	if ($var_addr) {
+	    $var_addr{$var_name} = 1;
+	    $func_args =~ s/\b($var_name)\b/&$1/;
+	}
+	if ($var_init =~ /^=\s*NO_INIT\s*;?\s*$/) {
+	    print "\t$var_name;\n";
+	} elsif ($var_init =~ /\S/) {
+	    &output_init($var_type, $var_num, "$var_name $var_init");
+	} elsif ($var_num) {
+	    # generate initialization code
+	    &generate_init($var_type, $var_num, $var_name);
+	} else {
+	    print ";\n";
+	}
+    }
+}
+
+sub OUTPUT_handler {
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
+	blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
+	    if $outargs{$outarg} ++ ;
+	if (!$gotRETVAL and $outarg eq 'RETVAL') {
+	    # deal with RETVAL last
+	    $RETVAL_code = $outcode ;
+	    $gotRETVAL = 1 ;
+	    next ;
+	}
+	blurt ("Error: OUTPUT $outarg not an argument"), next
+	    unless defined($args_match{$outarg});
+	blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
+	    unless defined $var_types{$outarg} ;
+	if ($outcode) {
+	    print "\t$outcode\n";
+	} else {
+	    $var_num = $args_match{$outarg};
+	    &generate_output($var_types{$outarg}, $var_num, $outarg); 
+	}
+    }
+}
+
+sub CLEANUP_handler() { print_section() } 
+sub PREINIT_handler() { print_section() } 
+sub INIT_handler()    { print_section() } 
+
+sub GetAliases
+{
+    my ($line) = @_ ;
+    my ($orig) = $line ;
+    my ($alias) ;
+    my ($value) ;
+
+    # Parse alias definitions
+    # format is
+    #    alias = value alias = value ...
+
+    while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
+        $alias = $1 ;
+        $orig_alias = $alias ;
+        $value = $2 ;
+
+        # check for optional package definition in the alias
+	$alias = $Packprefix . $alias if $alias !~ /::/ ;
+        
+        # check for duplicate alias name & duplicate value
+	Warn("Warning: Ignoring duplicate alias '$orig_alias'")
+	    if defined $XsubAliases{$alias} ;
+
+	Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
+	    if $XsubAliasValues{$value} ;
+
+	$XsubAliases = 1;
+	$XsubAliases{$alias} = $value ;
+	$XsubAliasValues{$value} = $orig_alias ;
+    }
+
+    blurt("Error: Cannot parse ALIAS definitions from '$orig'")
+        if $line ;
+}
+
+sub ALIAS_handler ()
+{
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	TrimWhitespace($_) ;
+        GetAliases($_) if $_ ;
+    }
+}
+
+sub REQUIRE_handler ()
+{
+    # the rest of the current line should contain a version number
+    my ($Ver) = $_ ;
+
+    TrimWhitespace($Ver) ;
+
+    death ("Error: REQUIRE expects a version number")
+	unless $Ver ;
+
+    # check that the version number is of the form n.n
+    death ("Error: REQUIRE: expected a number, got '$Ver'")
+	unless $Ver =~ /^\d+(\.\d*)?/ ;
+
+    death ("Error: xsubpp $Ver (or better) required--this is only $XSUBPP_version.")
+        unless $XSUBPP_version >= $Ver ; 
+}
+
+sub VERSIONCHECK_handler ()
+{
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE
+ 
+    TrimWhitespace($_) ;
+ 
+    # check for ENABLE/DISABLE
+    death ("Error: VERSIONCHECK: ENABLE/DISABLE")
+        unless /^(ENABLE|DISABLE)/i ;
+ 
+    $WantVersionChk = 1 if $1 eq 'ENABLE' ;
+    $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+ 
+}
+
+sub PROTOTYPE_handler ()
+{
+    my $specified ;
+
+    death("Error: Only 1 PROTOTYPE definition allowed per xsub") 
+        if $proto_in_this_xsub ++ ;
+
+    for (;  !/^$BLOCK_re/o;  $_ = shift(@line)) {
+	next unless /\S/;
+	$specified = 1 ;
+	TrimWhitespace($_) ;
+        if ($_ eq 'DISABLE') {
+	   $ProtoThisXSUB = 0 
+        }
+        elsif ($_ eq 'ENABLE') {
+	   $ProtoThisXSUB = 1 
+        }
+        else {
+            # remove any whitespace
+            s/\s+//g ;
+            death("Error: Invalid prototype '$_'")
+                unless ValidProtoString($_) ;
+            $ProtoThisXSUB = C_string($_) ;
+        }
+    }
+
+    # If no prototype specified, then assume empty prototype ""
+    $ProtoThisXSUB = 2 unless $specified ;
+
+    $ProtoUsed = 1 ;
+
+}
+
+sub PROTOTYPES_handler ()
+{
+    # the rest of the current line should contain either ENABLE or
+    # DISABLE 
+
+    TrimWhitespace($_) ;
+
+    # check for ENABLE/DISABLE
+    death ("Error: PROTOTYPES: ENABLE/DISABLE")
+        unless /^(ENABLE|DISABLE)/i ;
+
+    $WantPrototypes = 1 if $1 eq 'ENABLE' ;
+    $WantPrototypes = 0 if $1 eq 'DISABLE' ;
+    $ProtoUsed = 1 ;
+
+}
+
+sub INCLUDE_handler ()
+{
+    # the rest of the current line should contain a valid filename
+ 
+    TrimWhitespace($_) ;
+ 
+    death("INCLUDE: filename missing")
+        unless $_ ;
+
+    death("INCLUDE: output pipe is illegal")
+        if /^\s*\|/ ;
+
+    # simple minded recursion detector
+    death("INCLUDE loop detected")
+        if $IncludedFiles{$_} ;
+
+    ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+
+    # Save the current file context.
+    push(@XSStack, {
+	type		=> 'file',
+        LastLine        => $lastline,
+        LastLineNo      => $lastline_no,
+        Line            => \@line,
+        LineNo          => \@line_no,
+        Filename        => $filename,
+        Handle          => $FH,
+        }) ;
+ 
+    ++ $FH ;
+
+    # open the new file
+    open ($FH, "$_") or death("Cannot open '$_': $!") ;
+ 
+    print Q<<"EOF" ;
+#
+#/* INCLUDE:  Including '$_' from '$filename' */
+#
+EOF
+
+    $filename = $_ ;
+
+    # Prime the pump by reading the first 
+    # non-blank line
+
+    # skip leading blank lines
+    while (<$FH>) {
+        last unless /^\s*$/ ;
+    }
+
+    $lastline = $_ ;
+    $lastline_no = $. ;
+ 
+}
+ 
+sub PopFile()
+{
+    return 0 unless $XSStack[-1]{type} eq 'file' ;
+
+    my $data     = pop @XSStack ;
+    my $ThisFile = $filename ;
+    my $isPipe   = ($filename =~ /\|\s*$/) ;
+ 
+    -- $IncludedFiles{$filename}
+        unless $isPipe ;
+
+    close $FH ;
+
+    $FH         = $data->{Handle} ;
+    $filename   = $data->{Filename} ;
+    $lastline   = $data->{LastLine} ;
+    $lastline_no = $data->{LastLineNo} ;
+    @line       = @{ $data->{Line} } ;
+    @line_no    = @{ $data->{LineNo} } ;
+
+    if ($isPipe and $? ) {
+        -- $lastline_no ;
+        print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n"  ;
+        exit 1 ;
+    }
+
+    print Q<<"EOF" ;
+#
+#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+#
+EOF
+
+    return 1 ;
+}
+
+sub ValidProtoString ($)
+{
+    my($string) = @_ ;
+
+    if ( $string =~ /^$proto_re+$/ ) {
+        return $string ;
+    }
+
+    return 0 ;
+}
+
+sub C_string ($)
+{
+    my($string) = @_ ;
+
+    $string =~ s[\\][\\\\]g ;
+    $string ;
+}
+
+sub ProtoString ($)
+{
+    my ($type) = @_ ;
+
+    $proto_letter{$type} or '$' ;
+}
+
+sub check_cpp {
+    my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line);
+    if (@cpp) {
+	my ($cpp, $cpplevel);
+	for $cpp (@cpp) {
+	    if ($cpp =~ /^\#\s*if/) {
+		$cpplevel++;
+	    } elsif (!$cpplevel) {
+		Warn("Warning: #else/elif/endif without #if in this function");
+		print STDERR "    (precede it with a blank line if the matching #if is outside the function)\n"
+		    if $XSStack[-1]{type} eq 'if';
+		return;
+	    } elsif ($cpp =~ /^\#\s*endif/) {
+		$cpplevel--;
+	    }
+	}
+	Warn("Warning: #if without #endif in this function") if $cpplevel;
+    }
+}
+
+
+sub Q {
+    my($text) = @_;
+    $text =~ s/^#//gm;
+    $text =~ s/\[\[/{/g;
+    $text =~ s/\]\]/}/g;
+    $text;
+}
+
+open($FH, $filename) or die "cannot open $filename: $!\n";
+
+# Identify the version of xsubpp used
+print <<EOM ;
+/*
+ * This file was generated automatically by xsubpp version $XSUBPP_version from the 
+ * contents of $filename. Don't edit this file, edit $filename instead.
+ *
+ *	ANY CHANGES MADE HERE WILL BE LOST! 
+ *
+ */
+
+EOM
+ 
+
+while (<$FH>) {
+    last if ($Module, $Package, $Prefix) =
+	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
+    print $_;
+}
+&Exit unless defined $_;
+
+$lastline    = $_;
+$lastline_no = $.;
+
+
+# Read next xsub into @line from ($lastline, <$FH>).
+sub fetch_para {
+    # parse paragraph
+    death ("Error: Unterminated `#if/#ifdef/#ifndef'")
+	if !defined $lastline && $XSStack[-1]{type} eq 'if';
+    @line = ();
+    @line_no = () ;
+    return PopFile() if !defined $lastline;
+
+    if ($lastline =~
+	/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
+	$Module = $1;
+	$Package = defined($2) ? $2 : '';	# keep -w happy
+	$Prefix  = defined($3) ? $3 : '';	# keep -w happy
+	($Module_cname = $Module) =~ s/\W/_/g;
+	($Packid = $Package) =~ tr/:/_/;
+	$Packprefix = $Package;
+	$Packprefix .= "::" if $Packprefix ne "";
+	$lastline = "";
+    }
+
+    for(;;) {
+	if ($lastline !~ /^\s*#/ ||
+	    # CPP directives:
+	    #	ANSI:	if ifdef ifndef elif else endif define undef
+	    #		line error pragma
+	    #	gcc:	warning include_next
+	    #   obj-c:	import
+	    #   others:	ident (gcc notes that some cpps have this one)
+	    $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
+	    last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
+	    push(@line, $lastline);
+	    push(@line_no, $lastline_no) ;
+	}
+
+	# Read next line and continuation lines
+	last unless defined($lastline = <$FH>);
+	$lastline_no = $.;
+	my $tmp_line;
+	$lastline .= $tmp_line
+	    while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
+	    
+	chomp $lastline;
+	$lastline =~ s/^\s+$//;
+    }
+    pop(@line), pop(@line_no) while @line && $line[-1] eq "";
+    1;
+}
+
+PARAGRAPH:
+while (fetch_para()) {
+    # Print initial preprocessor statements and blank lines
+    while (@line && $line[0] !~ /^[^\#]/) {
+	my $line = shift(@line);
+	print $line, "\n";
+	next unless $line =~ /^\#\s*((if)(?:n?def)?|elsif|else|endif)\b/;
+	my $statement = $+;
+	if ($statement eq 'if') {
+	    $XSS_work_idx = @XSStack;
+	    push(@XSStack, {type => 'if'});
+	} else {
+	    death ("Error: `$statement' with no matching `if'")
+		if $XSStack[-1]{type} ne 'if';
+	    if ($XSStack[-1]{varname}) {
+		push(@InitFileCode, "#endif\n");
+		push(@BootCode,     "#endif");
+	    }
+
+	    my(@fns) = keys %{$XSStack[-1]{functions}};
+	    if ($statement ne 'endif') {
+		# Hide the functions defined in other #if branches, and reset.
+		@{$XSStack[-1]{other_functions}}{@fns} = (1) x @fns;
+		@{$XSStack[-1]}{qw(varname functions)} = ('', {});
+	    } else {
+		my($tmp) = pop(@XSStack);
+		0 while (--$XSS_work_idx
+			 && $XSStack[$XSS_work_idx]{type} ne 'if');
+		# Keep all new defined functions
+		push(@fns, keys %{$tmp->{other_functions}});
+		@{$XSStack[$XSS_work_idx]{functions}}{@fns} = (1) x @fns;
+	    }
+	}
+    }
+
+    next PARAGRAPH unless @line;
+
+    if ($XSS_work_idx && !$XSStack[$XSS_work_idx]{varname}) {
+	# We are inside an #if, but have not yet #defined its xsubpp variable.
+	print "#define $cpp_next_tmp 1\n\n";
+	push(@InitFileCode, "#if $cpp_next_tmp\n");
+	push(@BootCode,     "#if $cpp_next_tmp");
+	$XSStack[$XSS_work_idx]{varname} = $cpp_next_tmp++;
+    }
+
+    death ("Code is not inside a function")
+	if $line[0] =~ /^\s/;
+
+    # initialize info arrays
+    undef(%args_match);
+    undef(%var_types);
+    undef(%var_addr);
+    undef(%defaults);
+    undef($class);
+    undef($static);
+    undef($elipsis);
+    undef($wantRETVAL) ;
+    undef(%arg_list) ;
+    undef(@proto_arg) ;
+    undef($proto_in_this_xsub) ;
+    $ProtoThisXSUB = $WantPrototypes ;
+
+    $_ = shift(@line);
+    while ($kwd = check_keyword("REQUIRE|PROTOTYPES|VERSIONCHECK|INCLUDE")) {
+        &{"${kwd}_handler"}() ;
+        next PARAGRAPH unless @line ;
+        $_ = shift(@line);
+    }
+
+    if (check_keyword("BOOT")) {
+	&check_cpp;
+        push (@BootCode, $_, @line, "") ;
+        next PARAGRAPH ;
+    }
+
+
+    # extract return type, function name and arguments
+    my($ret_type) = TidyType($_);
+
+    # a function definition needs at least 2 lines
+    blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
+	unless @line ;
+
+    $static = 1 if $ret_type =~ s/^static\s+//;
+
+    $func_header = shift(@line);
+    blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
+	unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*$/s;
+
+    ($class, $func_name, $orig_args) =  ($1, $2, $3) ;
+    ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
+    $Full_func_name = "${Packid}_$func_name";
+
+    # Check for duplicate function definition
+    for $tmp (@XSStack) {
+	next unless defined $tmp->{functions}{$Full_func_name};
+	Warn("Warning: duplicate function definition '$func_name' detected");
+	last;
+    }
+    $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+    %XsubAliases = %XsubAliasValues = ();
+
+    @args = split(/\s*,\s*/, $orig_args);
+    if (defined($class)) {
+	my $arg0 = ((defined($static) or $func_name =~ /^new/) ? "CLASS" : "THIS");
+	unshift(@args, $arg0);
+	($orig_args = "$arg0, $orig_args") =~ s/^$arg0, $/$arg0/;
+    }
+    $orig_args =~ s/"/\\"/g;
+    $min_args = $num_args = @args;
+    foreach $i (0..$num_args-1) {
+	    if ($args[$i] =~ s/\.\.\.//) {
+		    $elipsis = 1;
+		    $min_args--;
+		    if ($args[$i] eq '' && $i == $num_args - 1) {
+			pop(@args);
+			last;
+		    }
+	    }
+	    if ($args[$i] =~ /^([^=]*[^\s=])\s*=\s*(.*)/s) {
+		    $min_args--;
+		    $args[$i] = $1;
+		    $defaults{$args[$i]} = $2;
+		    $defaults{$args[$i]} =~ s/"/\\"/g;
+	    }
+	    $proto_arg[$i+1] = '$' ;
+    }
+    if (defined($class)) {
+	    $func_args = join(", ", @args[1..$#args]);
+    } else {
+	    $func_args = join(", ", @args);
+    }
+    @args_match{@args} = 1..@args;
+
+    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
+    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
+
+    # print function header
+    print Q<<"EOF";
+#XS(XS_${Packid}_$func_name)
+#[[
+#    dXSARGS;
+EOF
+    print Q<<"EOF" if $ALIAS ;
+#    dXSI32;
+EOF
+    if ($elipsis) {
+	$cond = ($min_args ? qq(items < $min_args) : 0);
+    }
+    elsif ($min_args == $num_args) {
+	$cond = qq(items != $min_args);
+    }
+    else {
+	$cond = qq(items < $min_args || items > $num_args);
+    }
+
+    print Q<<"EOF" if $except;
+#    char errbuf[1024];
+#    *errbuf = '\0';
+EOF
+
+    if ($ALIAS) 
+      { print Q<<"EOF" if $cond }
+#    if ($cond)
+#       croak("Usage: %s($orig_args)", GvNAME(CvGV(cv)));
+EOF
+    else 
+      { print Q<<"EOF" if $cond }
+#    if ($cond)
+#	croak("Usage: $pname($orig_args)");
+EOF
+
+    print Q<<"EOF" if $PPCODE;
+#    SP -= items;
+EOF
+
+    # Now do a block of some sort.
+
+    $condnum = 0;
+    $cond = '';			# last CASE: condidional
+    push(@line, "$END:");
+    push(@line_no, $line_no[-1]);
+    $_ = '';
+    &check_cpp;
+    while (@line) {
+	&CASE_handler if check_keyword("CASE");
+	print Q<<"EOF";
+#   $except [[
+EOF
+
+	# do initialization of input variables
+	$thisdone = 0;
+	$retvaldone = 0;
+	$deferred = "";
+	%arg_list = () ;
+        $gotRETVAL = 0;
+
+	INPUT_handler() ;
+	process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE") ;
+
+	if (!$thisdone && defined($class)) {
+	    if (defined($static) or $func_name =~ /^new/) {
+		print "\tchar *";
+		$var_types{"CLASS"} = "char *";
+		&generate_init("char *", 1, "CLASS");
+	    }
+	    else {
+		print "\t$class *";
+		$var_types{"THIS"} = "$class *";
+		&generate_init("$class *", 1, "THIS");
+	    }
+	}
+
+	# do code
+	if (/^\s*NOT_IMPLEMENTED_YET/) {
+		print "\n\tcroak(\"$pname: not implemented yet\");\n";
+		$_ = '' ;
+	} else {
+		if ($ret_type ne "void") {
+			print "\t" . &map_type($ret_type) . "\tRETVAL;\n"
+				if !$retvaldone;
+			$args_match{"RETVAL"} = 0;
+			$var_types{"RETVAL"} = $ret_type;
+		}
+		print $deferred;
+                process_keyword("INIT|ALIAS|PROTOTYPE") ;
+
+		if (check_keyword("PPCODE")) {
+			print_section();
+			death ("PPCODE must be last thing") if @line;
+			print "\tPUTBACK;\n\treturn;\n";
+		} elsif (check_keyword("CODE")) {
+			print_section() ;
+		} elsif (defined($class) and $func_name eq "DESTROY") {
+			print "\n\t";
+			print "delete THIS;\n";
+		} else {
+			print "\n\t";
+			if ($ret_type ne "void") {
+				print "RETVAL = ";
+				$wantRETVAL = 1;
+			}
+			if (defined($static)) {
+			    if ($func_name =~ /^new/) {
+				$func_name = "$class";
+			    } else {
+				print "${class}::";
+			    }
+			} elsif (defined($class)) {
+			    if ($func_name =~ /^new/) {
+				$func_name .= " $class";
+			    } else {
+				print "THIS->";
+			    }
+			}
+			$func_name =~ s/^($spat)//
+			    if defined($spat);
+			print "$func_name($func_args);\n";
+		}
+	}
+
+	# do output variables
+	$gotRETVAL = 0;
+	undef $RETVAL_code ;
+	undef %outargs ;
+        process_keyword("OUTPUT|ALIAS|PROTOTYPE"); 
+
+	# all OUTPUT done, so now push the return value on the stack
+	if ($gotRETVAL && $RETVAL_code) {
+	    print "\t$RETVAL_code\n";
+	} elsif ($gotRETVAL || $wantRETVAL) {
+	    &generate_output($ret_type, 0, 'RETVAL');
+	}
+
+	# do cleanup
+	process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;
+
+	# print function trailer
+	print Q<<EOF;
+#    ]]
+EOF
+	print Q<<EOF if $except;
+#    BEGHANDLERS
+#    CATCHALL
+#	sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
+#    ENDHANDLERS
+EOF
+	if (check_keyword("CASE")) {
+	    blurt ("Error: No `CASE:' at top of function")
+		unless $condnum;
+	    $_ = "CASE: $_";	# Restore CASE: label
+	    next;
+	}
+	last if $_ eq "$END:";
+	death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
+    }
+
+    print Q<<EOF if $except;
+#    if (errbuf[0])
+#	croak(errbuf);
+EOF
+
+    print Q<<EOF unless $PPCODE;
+#    XSRETURN(1);
+EOF
+
+    print Q<<EOF;
+#]]
+#
+EOF
+
+    my $newXS = "newXS" ;
+    my $proto = "" ;
+
+    # Build the prototype string for the xsub
+    if ($ProtoThisXSUB) {
+	$newXS = "newXSproto";
+
+	if ($ProtoThisXSUB == 2) {
+	    # User has specified empty prototype
+	    $proto = ', ""' ;
+	}
+        elsif ($ProtoThisXSUB != 1) {
+            # User has specified a prototype
+            $proto = ', "' . $ProtoThisXSUB . '"';
+        }
+        else {
+	    my $s = ';';
+            if ($min_args < $num_args)  {
+                $s = ''; 
+		$proto_arg[$min_args] .= ";" ;
+	    }
+            push @proto_arg, "$s\@" 
+                if $elipsis ;
+    
+            $proto = ', "' . join ("", @proto_arg) . '"';
+        }
+    }
+
+    if (%XsubAliases) {
+	$XsubAliases{$pname} = 0 
+	    unless defined $XsubAliases{$pname} ;
+	while ( ($name, $value) = each %XsubAliases) {
+	    push(@InitFileCode, Q<<"EOF");
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        XSANY.any_i32 = $value ;
+EOF
+	push(@InitFileCode, Q<<"EOF") if $proto;
+#        sv_setpv((SV*)cv$proto) ;
+EOF
+        }
+    }
+    else {
+	push(@InitFileCode,
+	     "        ${newXS}(\"$pname\", XS_$Full_func_name, file$proto);\n");
+    }
+}
+
+# print initialization routine
+print Q<<"EOF";
+##ifdef __cplusplus
+#extern "C"
+##endif
+#XS(boot_$Module_cname)
+#[[
+#    dXSARGS;
+#    char* file = __FILE__;
+#
+EOF
+
+print Q<<"EOF" if $WantVersionChk ;
+#    XS_VERSION_BOOTCHECK ;
+#
+EOF
+
+print Q<<"EOF" if defined $XsubAliases ;
+#    {
+#        CV * cv ;
+#
+EOF
+
+print @InitFileCode;
+
+print Q<<"EOF" if defined $XsubAliases ;
+#    }
+EOF
+
+if (@BootCode)
+{
+    print "\n    /* Initialisation Section */\n" ;
+    print grep (s/$/\n/, @BootCode) ;
+    print "\n    /* End of Initialisation Section */\n\n" ;
+}
+
+print Q<<"EOF";;
+#    ST(0) = &sv_yes;
+#    XSRETURN(1);
+#]]
+EOF
+
+warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") 
+    unless $ProtoUsed ;
+&Exit;
+
+
+sub output_init {
+    local($type, $num, $init) = @_;
+    local($arg) = "ST(" . ($num - 1) . ")";
+
+    eval qq/print " $init\\\n"/;
+}
+
+sub Warn
+{
+    # work out the line number
+    my $line_no = $line_no[@line_no - @line -1] ;
+ 
+    print STDERR "@_ in $filename, line $line_no\n" ;
+}
+
+sub blurt 
+{ 
+    Warn @_ ;
+    $errors ++ 
+}
+
+sub death
+{
+    Warn @_ ;
+    exit 1 ;
+}
+
+sub generate_init {
+    local($type, $num, $var) = @_;
+    local($arg) = "ST(" . ($num - 1) . ")";
+    local($argoff) = $num - 1;
+    local($ntype);
+    local($tk);
+
+    $type = TidyType($type) ;
+    blurt("Error: '$type' not in typemap"), return 
+	unless defined($type_kind{$type});
+
+    ($ntype = $type) =~ s/\s*\*/Ptr/g;
+    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+    $tk = $type_kind{$type};
+    $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
+    $type =~ tr/:/_/;
+    blurt("Error: No INPUT definition for type '$type' found"), return
+        unless defined $input_expr{$tk} ;
+    $expr = $input_expr{$tk};
+    if ($expr =~ /DO_ARRAY_ELEM/) {
+        blurt("Error: '$subtype' not in typemap"), return 
+	    unless defined($type_kind{$subtype});
+        blurt("Error: No INPUT definition for type '$subtype' found"), return
+            unless defined $input_expr{$type_kind{$subtype}} ;
+	$subexpr = $input_expr{$type_kind{$subtype}};
+	$subexpr =~ s/ntype/subtype/g;
+	$subexpr =~ s/\$arg/ST(ix_$var)/g;
+	$subexpr =~ s/\n\t/\n\t\t/g;
+	$subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
+	$subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
+	$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
+    }
+    if (defined($defaults{$var})) {
+	    $expr =~ s/(\t+)/$1    /g;
+	    $expr =~ s/        /\t/g;
+	    eval qq/print "\\t$var;\\n"/;
+	    $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t    $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
+    } elsif ($expr !~ /^\t\$var =/) {
+	    eval qq/print "\\t$var;\\n"/;
+	    $deferred .= eval qq/"\\n$expr;\\n"/;
+    } else {
+	    eval qq/print "$expr;\\n"/;
+    }
+}
+
+sub generate_output {
+    local($type, $num, $var) = @_;
+    local($arg) = "ST(" . ($num - ($num != 0)) . ")";
+    local($argoff) = $num - 1;
+    local($ntype);
+
+    $type = TidyType($type) ;
+    if ($type =~ /^array\(([^,]*),(.*)\)/) {
+	    print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
+    } else {
+	    blurt("Error: '$type' not in typemap"), return
+		unless defined($type_kind{$type});
+            blurt("Error: No OUTPUT definition for type '$type' found"), return
+                unless defined $output_expr{$type_kind{$type}} ;
+	    ($ntype = $type) =~ s/\s*\*/Ptr/g;
+	    $ntype =~ s/\(\)//g;
+	    ($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
+	    $expr = $output_expr{$type_kind{$type}};
+	    if ($expr =~ /DO_ARRAY_ELEM/) {
+	        blurt("Error: '$subtype' not in typemap"), return
+		    unless defined($type_kind{$subtype});
+                blurt("Error: No OUTPUT definition for type '$subtype' found"), return
+                    unless defined $output_expr{$type_kind{$subtype}} ;
+		$subexpr = $output_expr{$type_kind{$subtype}};
+		$subexpr =~ s/ntype/subtype/g;
+		$subexpr =~ s/\$arg/ST(ix_$var)/g;
+		$subexpr =~ s/\$var/${var}[ix_$var]/g;
+		$subexpr =~ s/\n\t/\n\t\t/g;
+		$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
+		eval "print qq\a$expr\a";
+	    }
+	    elsif ($var eq 'RETVAL') {
+		if ($expr =~ /^\t\$arg = /) {
+		    eval "print qq\a$expr\a";
+		    print "\tsv_2mortal(ST(0));\n";
+		}
+		else {
+		    print "\tST(0) = sv_newmortal();\n";
+		    eval "print qq\a$expr\a";
+		}
+	    }
+	    elsif ($arg =~ /^ST\(\d+\)$/) {
+		eval "print qq\a$expr\a";
+	    }
+    }
+}
+
+sub map_type {
+    my($type) = @_;
+
+    $type =~ tr/:/_/;
+    $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
+    $type;
+}
+
+
+sub Exit {
+# If this is VMS, the exit status has meaning to the shell, so we
+# use a predictable value (SS$_Normal or SS$_Abort) rather than an
+# arbitrary number.
+    exit ($Is_VMS ? ($errors ? 44 : 1) : $errors) ;
+}
diff --git a/gnu/usr.bin/perl/lib/File/Basename.pm b/gnu/usr.bin/perl/lib/File/Basename.pm
new file mode 100644
index 00000000000..daff148a638
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Basename.pm
@@ -0,0 +1,252 @@
+package File::Basename;
+
+=head1 NAME
+
+Basename - parse file specifications
+
+fileparse - split a pathname into pieces
+
+basename - extract just the filename from a path
+
+dirname - extract just the directory from a path
+
+=head1 SYNOPSIS
+
+    use File::Basename;
+
+    ($name,$path,$suffix) = fileparse($fullname,@suffixlist)
+    fileparse_set_fstype($os_string);
+    $basename = basename($fullname,@suffixlist);
+    $dirname = dirname($fullname);
+
+    ($name,$path,$suffix) = fileparse("lib/File/Basename.pm","\.pm");
+    fileparse_set_fstype("VMS");
+    $basename = basename("lib/File/Basename.pm",".pm");
+    $dirname = dirname("lib/File/Basename.pm");
+
+=head1 DESCRIPTION
+
+These routines allow you to parse file specifications into useful
+pieces using the syntax of different operating systems.
+
+=over 4
+
+=item fileparse_set_fstype
+
+You select the syntax via the routine fileparse_set_fstype().
+If the argument passed to it contains one of the substrings
+"VMS", "MSDOS", or "MacOS", the file specification syntax of that
+operating system is used in future calls to fileparse(),
+basename(), and dirname().  If it contains none of these
+substrings, UNIX syntax is used.  This pattern matching is
+case-insensitive.  If you've selected VMS syntax, and the file
+specification you pass to one of these routines contains a "/",
+they assume you are using UNIX emulation and apply the UNIX syntax
+rules instead, for that function call only.
+
+If you haven't called fileparse_set_fstype(), the syntax is chosen
+by examining the builtin variable C<$^O> according to these rules.
+
+=item fileparse
+
+The fileparse() routine divides a file specification into three
+parts: a leading B<path>, a file B<name>, and a B<suffix>.  The
+B<path> contains everything up to and including the last directory
+separator in the input file specification.  The remainder of the input
+file specification is then divided into B<name> and B<suffix> based on
+the optional patterns you specify in C<@suffixlist>.  Each element of
+this list is interpreted as a regular expression, and is matched
+against the end of B<name>.  If this succeeds, the matching portion of
+B<name> is removed and prepended to B<suffix>.  By proper use of
+C<@suffixlist>, you can remove file types or versions for examination.
+
+You are guaranteed that if you concatenate B<path>, B<name>, and
+B<suffix> together in that order, the result will be identical to the
+input file specification.
+
+=back
+
+=head1 EXAMPLES
+
+Using UNIX file syntax:
+
+    ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', 
+				    '\.book\d+');
+
+would yield
+
+    $base eq 'draft'
+    $path eq '/virgil/aeneid',
+    $tail eq '.book7'
+
+Similarly, using VMS syntax:
+
+    ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh',
+				   '\..*');
+
+would yield
+
+    $name eq 'Rhetoric'
+    $dir  eq 'Doc_Root:[Help]'
+    $type eq '.Rnh'
+
+=item C<basename>
+
+The basename() routine returns the first element of the list produced
+by calling fileparse() with the same arguments.  It is provided for
+compatibility with the UNIX shell command basename(1).
+
+=item C<dirname>
+
+The dirname() routine returns the directory portion of the input file
+specification.  When using VMS or MacOS syntax, this is identical to the
+second element of the list produced by calling fileparse() with the same
+input file specification.  When using UNIX or MSDOS syntax, the return
+value conforms to the behavior of the UNIX shell command dirname(1).  This
+is usually the same as the behavior of fileparse(), but differs in some
+cases.  For example, for the input file specification F<lib/>, fileparse()
+considers the directory name to be F<lib/>, while dirname() considers the
+directory name to be F<.>).
+
+=cut
+
+require 5.002;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
+
+#   fileparse_set_fstype() - specify OS-based rules used in future
+#                            calls to routines in this package
+#
+#   Currently recognized values: VMS, MSDOS, MacOS
+#       Any other name uses Unix-style rules
+
+sub fileparse_set_fstype {
+  my($old) = $Fileparse_fstype;
+  $Fileparse_fstype = $_[0] if $_[0];
+  $old;
+}
+
+#   fileparse() - parse file specification
+#
+#   calling sequence:
+#     ($filename,$prefix,$tail) = &basename_pat($filespec,@excludelist);
+#     where  $filespec    is the file specification to be parsed, and
+#            @excludelist is a list of patterns which should be removed
+#                         from the end of $filename.
+#            $filename    is the part of $filespec after $prefix (i.e. the
+#                         name of the file).  The elements of @excludelist
+#                         are compared to $filename, and if an  
+#            $prefix     is the path portion $filespec, up to and including
+#                        the end of the last directory name
+#            $tail        any characters removed from $filename because they
+#                         matched an element of @excludelist.
+#
+#   fileparse() first removes the directory specification from $filespec,
+#   according to the syntax of the OS (code is provided below to handle
+#   VMS, Unix, MSDOS and MacOS; you can pick the one you want using
+#   fileparse_set_fstype(), or you can accept the default, which is
+#   based on the information in the builtin variable $^O).  It then compares
+#   each element of @excludelist to $filename, and if that element is a
+#   suffix of $filename, it is removed from $filename and prepended to
+#   $tail.  By specifying the elements of @excludelist in the right order,
+#   you can 'nibble back' $filename to extract the portion of interest
+#   to you.
+#
+#   For example, on a system running Unix,
+#   ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
+#                                       '\.book\d+');
+#   would yield $base == 'draft',
+#               $path == '/virgil/aeneid/'  (note trailing slash)
+#               $tail == '.book7'.
+#   Similarly, on a system running VMS,
+#   ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh','\..*');
+#   would yield $name == 'Rhetoric';
+#               $dir == 'Doc_Root:[Help]', and
+#               $type == '.Rnh'.
+#
+#   Version 2.2  13-Oct-1994  Charles Bailey  bailey@genetics.upenn.edu 
+
+
+sub fileparse {
+  my($fullname,@suffices) = @_;
+  my($fstype) = $Fileparse_fstype;
+  my($dirpath,$tail,$suffix);
+
+  if ($fstype =~ /^VMS/i) {
+    if ($fullname =~ m#/#) { $fstype = '' }  # We're doing Unix emulation
+    else {
+      ($dirpath,$basename) = ($fullname =~ /(.*[:>\]])?(.*)/);
+      $dirpath = $ENV{'DEFAULT'} unless $dirpath;
+    }
+  }
+  if ($fstype =~ /^MSDOS/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*\\)?(.*)/);
+    $dirpath = '.\\' unless $dirpath;
+  }
+  elsif ($fstype =~ /^MAC/i) {
+    ($dirpath,$basename) = ($fullname =~ /(.*:)?(.*)/);
+  }
+  elsif ($fstype !~ /^VMS/i) {  # default to Unix
+    ($dirpath,$basename) = ($fullname =~ m#(.*/)?(.*)#);
+    $dirpath = './' unless $dirpath;
+  }
+
+  if (@suffices) {
+    $tail = '';
+    foreach $suffix (@suffices) {
+      if ($basename =~ /($suffix)$/) {
+        $tail = $1 . $tail;
+        $basename = $`;
+      }
+    }
+  }
+
+  wantarray ? ($basename,$dirpath,$tail) : $basename;
+
+}
+
+
+#   basename() - returns first element of list returned by fileparse()
+
+sub basename {
+  my($name) = shift;
+  (fileparse($name, map("\Q$_\E",@_)))[0];
+}
+  
+
+#    dirname() - returns device and directory portion of file specification
+#        Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS
+#        filespecs except for names ending with a separator, e.g., "/xx/yy/".
+#        This differs from the second element of the list returned
+#        by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and
+#        the last directory name if the filespec ends in a '/' or '\'), is lost.
+
+sub dirname {
+    my($basename,$dirname) = fileparse($_[0]);
+    my($fstype) = $Fileparse_fstype;
+
+    if ($fstype =~ /VMS/i) { 
+        if ($_[0] =~ m#/#) { $fstype = '' }
+        else { return $dirname }
+    }
+    if ($fstype =~ /MacOS/i) { return $dirname }
+    elsif ($fstype =~ /MSDOS/i) { 
+        if ( $dirname =~ /:\\$/) { return $dirname }
+        chop $dirname;
+        $dirname =~ s:[^\\]+$:: unless $basename;
+        $dirname = '.' unless $dirname;
+    }
+    else { 
+        if ( $dirname eq '/') { return $dirname }
+        chop $dirname;
+        $dirname =~ s:[^/]+$:: unless $basename;
+        $dirname = '.' unless $dirname;
+    }
+
+    $dirname;
+}
+
+$Fileparse_fstype = $^O;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/File/CheckTree.pm b/gnu/usr.bin/perl/lib/File/CheckTree.pm
new file mode 100644
index 00000000000..a39308b6c96
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/CheckTree.pm
@@ -0,0 +1,151 @@
+package File::CheckTree;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+validate - run many filetest checks on a tree
+
+=head1 SYNOPSIS
+
+    use File::CheckTree;
+
+    $warnings += validate( q{
+	/vmunix                 -e || die
+	/boot                   -e || die
+	/bin                    cd
+	    csh                 -ex
+	    csh                 !-ug
+	    sh                  -ex
+	    sh                  !-ug
+	/usr                    -d || warn "What happened to $file?\n"
+    });
+
+=head1 DESCRIPTION
+
+The validate() routine takes a single multiline string consisting of
+lines containing a filename plus a file test to try on it.  (The
+file test may also be a "cd", causing subsequent relative filenames
+to be interpreted relative to that directory.)  After the file test
+you may put C<|| die> to make it a fatal error if the file test fails.
+The default is C<|| warn>.  The file test may optionally have a "!' prepended
+to test for the opposite condition.  If you do a cd and then list some
+relative filenames, you may want to indent them slightly for readability.
+If you supply your own die() or warn() message, you can use $file to
+interpolate the filename.
+
+Filetests may be bunched:  "-rwx" tests for all of C<-r>, C<-w>, and C<-x>.
+Only the first failed test of the bunch will produce a warning.
+
+The routine returns the number of warnings issued.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(validate);
+
+# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
+
+# The validate routine takes a single multiline string consisting of
+# lines containing a filename plus a file test to try on it.  (The
+# file test may also be a 'cd', causing subsequent relative filenames
+# to be interpreted relative to that directory.)  After the file test
+# you may put '|| die' to make it a fatal error if the file test fails.
+# The default is '|| warn'.  The file test may optionally have a ! prepended
+# to test for the opposite condition.  If you do a cd and then list some
+# relative filenames, you may want to indent them slightly for readability.
+# If you supply your own "die" or "warn" message, you can use $file to
+# interpolate the filename.
+
+# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
+# Only the first failed test of the bunch will produce a warning.
+
+# The routine returns the number of warnings issued.
+
+# Usage:
+#	use File::CheckTree;
+#	$warnings += validate('
+#	/vmunix			-e || die
+#	/boot			-e || die
+#	/bin			cd
+#	    csh			-ex
+#	    csh			!-ug
+#	    sh			-ex
+#	    sh			!-ug
+#	/usr			-d || warn "What happened to $file?\n"
+#	');
+
+sub validate {
+    local($file,$test,$warnings,$oldwarnings);
+    foreach $check (split(/\n/,$_[0])) {
+	next if $check =~ /^#/;
+	next if $check =~ /^$/;
+	($file,$test) = split(' ',$check,2);
+	if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
+	    $testlist = $2;
+	    @testlist = split(//,$testlist);
+	}
+	else {
+	    @testlist = ('Z');
+	}
+	$oldwarnings = $warnings;
+	foreach $one (@testlist) {
+	    $this = $test;
+	    $this =~ s/(-\w\b)/$1 \$file/g;
+	    $this =~ s/-Z/-$one/;
+	    $this .= ' || warn' unless $this =~ /\|\|/;
+	    $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/;
+	    $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
+	    eval $this;
+	    last if $warnings > $oldwarnings;
+	}
+    }
+    $warnings;
+}
+
+sub valmess {
+    local($disposition,$this) = @_;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|;
+    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
+	$neg = $1;
+	$tmp = $2;
+	$tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
+	$tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
+	$tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
+	$tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
+	$tmp eq 'R' && ($mess = "$file is not readable by you.");
+	$tmp eq 'W' && ($mess = "$file is not writable by you.");
+	$tmp eq 'X' && ($mess = "$file is not executable by you.");
+	$tmp eq 'O' && ($mess = "$file is not owned by you.");
+	$tmp eq 'e' && ($mess = "$file does not exist.");
+	$tmp eq 'z' && ($mess = "$file does not have zero size.");
+	$tmp eq 's' && ($mess = "$file does not have non-zero size.");
+	$tmp eq 'f' && ($mess = "$file is not a plain file.");
+	$tmp eq 'd' && ($mess = "$file is not a directory.");
+	$tmp eq 'l' && ($mess = "$file is not a symbolic link.");
+	$tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
+	$tmp eq 'S' && ($mess = "$file is not a socket.");
+	$tmp eq 'b' && ($mess = "$file is not a block special file.");
+	$tmp eq 'c' && ($mess = "$file is not a character special file.");
+	$tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
+	$tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
+	$tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
+	$tmp eq 'T' && ($mess = "$file is not a text file.");
+	$tmp eq 'B' && ($mess = "$file is not a binary file.");
+	if ($neg eq '!') {
+	    $mess =~ s/ is not / should not be / ||
+	    $mess =~ s/ does not / should not / ||
+	    $mess =~ s/ not / /;
+	}
+	print STDERR $mess,"\n";
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	print STDERR "Can't do $this.\n";
+    }
+    if ($disposition eq 'die') { exit 1; }
+    ++$warnings;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/File/Copy.pm b/gnu/usr.bin/perl/lib/File/Copy.pm
new file mode 100644
index 00000000000..68460130109
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Copy.pm
@@ -0,0 +1,224 @@
+# File/Copy.pm. Written in 1994 by Aaron Sherman <ajs@ajs.com>. This
+# source code has been placed in the public domain by the author.
+# Please be kind and preserve the documentation.
+#
+
+package File::Copy;
+
+require Exporter;
+use Carp;
+
+@ISA=qw(Exporter);
+@EXPORT=qw(copy);
+@EXPORT_OK=qw(copy cp);
+
+$File::Copy::VERSION = '1.5';
+$File::Copy::Too_Big = 1024 * 1024 * 2;
+
+sub VERSION {
+    # Version of File::Copy
+    return $File::Copy::VERSION;
+}
+
+sub copy {
+    croak("Usage: copy( file1, file2 [, buffersize]) ")
+      unless(@_ == 2 || @_ == 3);
+
+    if (($^O eq 'VMS' or $^O eq 'os2') && ref(\$to) ne 'GLOB' &&
+        !(defined ref $to and (ref($to) eq 'GLOB' ||
+          ref($to) eq 'FileHandle' || ref($to) eq 'VMS::Stdio')))
+        { return File::Copy::syscopy($_[0],$_[1]) }
+
+    my $from = shift;
+    my $to = shift;
+    my $recsep = $\;
+    my $closefrom=0;
+    my $closeto=0;
+    my ($size, $status, $r, $buf);
+    local(*FROM, *TO);
+
+    $\ = '';
+
+    if (ref(\$from) eq 'GLOB') {
+	*FROM = $from;
+    } elsif (defined ref $from and
+	     (ref($from) eq 'GLOB' || ref($from) eq 'FileHandle' ||
+	      ref($from) eq 'VMS::Stdio')) {
+	*FROM = *$from;
+    } else {
+	open(FROM,"<$from")||goto(fail_open1);
+	binmode FROM;
+	$closefrom = 1;
+    }
+
+    if (ref(\$to) eq 'GLOB') {
+	*TO = $to;
+    } elsif (defined ref $to and
+	     (ref($to) eq 'GLOB' || ref($to) eq 'FileHandle' ||
+	      ref($to) eq 'VMS::Stdio')) {
+	*TO = *$to;
+    } else {
+	open(TO,">$to")||goto(fail_open2);
+	binmode TO;
+	$closeto=1;
+    }
+
+    if (@_) {
+	$size = shift(@_) + 0;
+	croak("Bad buffer size for copy: $size\n") unless ($size > 0);
+    } else {
+	$size = -s FROM;
+	$size = 1024 if ($size < 512);
+	$size = $File::Copy::Too_Big if ($size > $File::Copy::Too_Big);
+    }
+
+    $buf = '';
+    while(defined($r = read(FROM,$buf,$size)) && $r > 0) {
+	if (syswrite (TO,$buf,$r) != $r) {
+	    goto fail_inner;    
+	}
+    }
+    goto fail_inner unless(defined($r));
+    close(TO) || goto fail_open2 if $closeto;
+    close(FROM) || goto fail_open1 if $closefrom;
+    $\ = $recsep;
+    return 1;
+    
+    # All of these contortions try to preserve error messages...
+  fail_inner:
+    if ($closeto) {
+	$status = $!;
+	$! = 0;
+	close TO;
+	$! = $status unless $!;
+    }
+  fail_open2:
+    if ($closefrom) {
+	$status = $!;
+	$! = 0;
+	close FROM;
+	$! = $status unless $!;
+    }
+  fail_open1:
+    $\ = $recsep;
+    return 0;
+}
+
+
+*cp = \&copy;
+# &syscopy is an XSUB under OS/2
+*syscopy = ($^O eq 'VMS' ? \&rmscopy : \&copy) unless $^O eq 'os2';
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Copy - Copy files or filehandles
+
+=head1 SYNOPSIS
+
+  	use File::Copy;
+
+	copy("file1","file2");
+  	copy("Copy.pm",\*STDOUT);'
+
+  	use POSIX;
+	use File::Copy cp;
+
+	$n=FileHandle->new("/dev/null","r");
+	cp($n,"x");'
+
+=head1 DESCRIPTION
+
+The File::Copy module provides a basic function C<copy> which takes two
+parameters: a file to copy from and a file to copy to. Either
+argument may be a string, a FileHandle reference or a FileHandle
+glob. Obviously, if the first argument is a filehandle of some
+sort, it will be read from, and if it is a file I<name> it will
+be opened for reading. Likewise, the second argument will be
+written to (and created if need be).  Note that passing in
+files as handles instead of names may lead to loss of information
+on some operating systems; it is recommended that you use file
+names whenever possible.
+
+An optional third parameter can be used to specify the buffer
+size used for copying. This is the number of bytes from the
+first file, that wil be held in memory at any given time, before
+being written to the second file. The default buffer size depends
+upon the file, but will generally be the whole file (up to 2Mb), or
+1k for filehandles that do not reference files (eg. sockets).
+
+You may use the syntax C<use File::Copy "cp"> to get at the
+"cp" alias for this function. The syntax is I<exactly> the same.
+
+File::Copy also provides the C<syscopy> routine, which copies the
+file specified in the first parameter to the file specified in the
+second parameter, preserving OS-specific attributes and file
+structure.  For Unix systems, this is equivalent to the simple
+C<copy> routine.  For VMS systems, this calls the C<rmscopy>
+routine (see below).  For OS/2 systems, this calls the C<syscopy>
+XSUB directly.
+
+=head2 Special behavior under VMS
+
+If the second argument to C<copy> is not a file handle for an
+already opened file, then C<copy> will perform an RMS copy of
+the input file to a new output file, in order to preserve file
+attributes, indexed file structure, I<etc.>  The buffer size
+parameter is ignored.  If the second argument to C<copy> is a
+Perl handle to an opened file, then data is copied using Perl
+operators, and no effort is made to preserve file attributes
+or record structure.
+
+The RMS copy routine may also be called directly under VMS
+as C<File::Copy::rmscopy> (or C<File::Copy::syscopy>, which
+is just an alias for this routine).
+
+=item rmscopy($from,$to[,$date_flag])
+
+The first and second arguments may be strings, typeglobs, or
+typeglob references; they are used in all cases to obtain the
+I<filespec> of the input and output files, respectively.  The
+name and type of the input file are used as defaults for the
+output file, if necessary.
+
+A new version of the output file is always created, which
+inherits the structure and RMS attributes of the input file,
+except for owner and protections (and possibly timestamps;
+see below).  All data from the input file is copied to the
+output file; if either of the first two parameters to C<rmscopy>
+is a file handle, its position is unchanged.  (Note that this
+means a file handle pointing to the output file will be
+associated with an old version of that file after C<rmscopy>
+returns, not the newly created version.)
+
+The third parameter is an integer flag, which tells C<rmscopy>
+how to handle timestamps.  If it is < 0, none of the input file's
+timestamps are propagated to the output file.  If it is > 0, then
+it is interpreted as a bitmask: if bit 0 (the LSB) is set, then
+timestamps other than the revision date are propagated; if bit 1
+is set, the revision date is propagated.  If the third parameter
+to C<rmscopy> is 0, then it behaves much like the DCL COPY command:
+if the name or type of the output file was explicitly specified,
+then no timestamps are propagated, but if they were taken implicitly
+from the input filespec, then all timestamps other than the
+revision date are propagated.  If this parameter is not supplied,
+it defaults to 0.
+
+Like C<copy>, C<rmscopy> returns 1 on success.  If an error occurs,
+it sets C<$!>, deletes the output file, and returns 0.
+
+=head1 RETURN
+
+Returns 1 on success, 0 on failure. $! will be set if an error was
+encountered.
+
+=head1 AUTHOR
+
+File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995.
+The VMS-specific code was added by Charles Bailey
+I<E<lt>bailey@genetics.upenn.eduE<gt>> in March 1996.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/File/Find.pm b/gnu/usr.bin/perl/lib/File/Find.pm
new file mode 100644
index 00000000000..02bacd8fc25
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Find.pm
@@ -0,0 +1,255 @@
+package File::Find;
+require 5.000;
+require Exporter;
+use Config;
+require Cwd;
+require File::Basename;
+
+
+=head1 NAME
+
+find - traverse a file tree
+
+finddepth - traverse a directory structure depth-first
+
+=head1 SYNOPSIS
+
+    use File::Find;
+    find(\&wanted, '/foo','/bar');
+    sub wanted { ... }
+    
+    use File::Find;
+    finddepth(\&wanted, '/foo','/bar');
+    sub wanted { ... }
+
+=head1 DESCRIPTION
+
+The wanted() function does whatever verifications you want.
+$File::Find::dir contains the current directory name, and $_ the
+current filename within that directory.  $File::Find::name contains
+C<"$File::Find::dir/$_">.  You are chdir()'d to $File::Find::dir when
+the function is called.  The function may set $File::Find::prune to
+prune the tree.
+
+This library is primarily for the C<find2perl> tool, which when fed, 
+
+    find2perl / -name .nfs\* -mtime +7 \
+	-exec rm -f {} \; -o -fstype nfs -prune
+
+produces something like:
+
+    sub wanted {
+        /^\.nfs.*$/ &&
+        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+        int(-M _) > 7 &&
+        unlink($_)
+        ||
+        ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+        $dev < 0 &&
+        ($File::Find::prune = 1);
+    }
+
+Set the variable $File::Find::dont_use_nlink if you're using AFS,
+since AFS cheats.
+
+C<finddepth> is just like C<find>, except that it does a depth-first
+search.
+
+Here's another interesting wanted function.  It will find all symlinks
+that don't resolve:
+
+    sub wanted {
+	-l && !-e && print "bogus link: $File::Find::name\n";
+    } 
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(find finddepth);
+
+
+sub find {
+    my $wanted = shift;
+    my $cwd = Cwd::fastcwd();
+    my ($topdir,$topdev,$topino,$topmode,$topnlink);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&$wanted;
+		my $fixtopdir = $topdir;
+	        $fixtopdir =~ s,/$,, ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS; ;
+		&finddir($wanted,$fixtopdir,$topnlink);
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    $name = $topdir;
+	    chdir $dir && &$wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddir {
+    my($wanted, $nlink);
+    local($dir, $name);
+    ($wanted, $dir, $nlink) = @_;
+
+    my($dev, $ino, $mode, $subcount);
+
+    # Get the list of files in the current directory.
+    opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
+    my(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &$wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    &$wanted;
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
+		    # unless ($nlink || $dont_use_nlink);
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			$name =~ s/\.dir$// if $Is_VMS;
+			&finddir($wanted,$name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	}
+    }
+}
+
+
+sub finddepth {
+    my $wanted = shift;
+
+    $cwd = Cwd::fastcwd();;
+
+    my($topdir, $topdev, $topino, $topmode, $topnlink);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		my $fixtopdir = $topdir;
+		$fixtopdir =~ s,/$,, ;
+		$fixtopdir =~ s/\.dir$// if $Is_VMS;
+		&finddepthdir($wanted,$fixtopdir,$topnlink);
+		($dir,$_) = ($fixtopdir,'.');
+		$name = $fixtopdir;
+		&$wanted;
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = File::Basename::fileparse($topdir)) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    chdir $dir && &$wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddepthdir {
+    my($wanted, $nlink);
+    local($dir, $name);
+    ($wanted,$dir,$nlink) = @_;
+    my($dev, $ino, $mode, $subcount);
+
+    # Get the list of files in the current directory.
+    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+    my(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {   # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &$wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = 0;
+	    $name = "$dir/$_";
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_));
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (chdir $_) {
+			$name =~ s/\.dir$// if $Is_VMS;
+			&finddepthdir($wanted,$name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	    &$wanted;
+	}
+    }
+}
+
+# Set dont_use_nlink in your hint file if your system's stat doesn't
+# report the number of links in a directory as an indication
+# of the number of files.
+# See, e.g. hints/machten.sh for MachTen 2.2.
+$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
+
+# These are hard-coded for now, but may move to hint files.
+if ($^O eq 'VMS') {
+  $Is_VMS = 1;
+  $dont_use_nlink = 1;
+}
+
+$dont_use_nlink = 1 if $^O eq 'os2';
+$dont_use_nlink = 1 if $^O =~ m:^mswin32$:i ;
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/File/Path.pm b/gnu/usr.bin/perl/lib/File/Path.pm
new file mode 100644
index 00000000000..97cb66855dc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/File/Path.pm
@@ -0,0 +1,165 @@
+package File::Path;
+
+=head1 NAME
+
+File::Path - create or remove a series of directories
+
+=head1 SYNOPSIS
+
+C<use File::Path>
+
+C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);>
+
+C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);>
+
+=head1 DESCRIPTION
+
+The C<mkpath> function provides a convenient way to create directories, even if
+your C<mkdir> kernel call won't create more than one level of directory at a
+time.  C<mkpath> takes three arguments:
+
+=over 4
+
+=item *
+
+the name of the path to create, or a reference
+to a list of paths to create,
+
+=item *
+
+a boolean value, which if TRUE will cause C<mkpath>
+to print the name of each directory as it is created
+(defaults to FALSE), and
+
+=item *
+
+the numeric mode to use when creating the directories
+(defaults to 0777)
+
+=back
+
+It returns a list of all directories (including intermediates, determined using
+the Unix '/' separator) created.
+
+Similarly, the C<rmtree> function provides a convenient way to delete a
+subtree from the directory structure, much like the Unix command C<rm -r>.
+C<rmtree> takes three arguments:
+
+=over 4
+
+=item *
+
+the root of the subtree to delete, or a reference to
+a list of roots.  All of the files and directories
+below each root, as well as the roots themselves,
+will be deleted.
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+print a message each time it examines a file, giving the
+name of the file, and indicating whether it's using C<rmdir>
+or C<unlink> to remove it, or that it's skipping it.
+(defaults to FALSE)
+
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to
+skip any files to which you do not have delete access
+(if running under VMS) or write access (if running
+under another OS).  This will change in the future when
+a criterion for 'delete permission' under OSs other
+than VMS is settled. (defaults to FALSE)
+
+=back
+
+It returns the number of files successfully deleted. Symlinks are
+treated as ordinary files.
+
+=head1 AUTHORS
+
+Tim Bunce <Tim.Bunce@ig.co.uk>
+Charles Bailey <bailey@genetics.upenn.edu>
+
+=head1 REVISION
+
+This module was last revised 14-Feb-1996, for perl 5.002. $VERSION is
+1.01.
+
+=cut
+
+$VERSION = "1.01"; # That's my hobby-horse, A.K.
+
+require 5.000;
+use Carp;
+require Exporter;
+@ISA = qw( Exporter );
+@EXPORT = qw( mkpath rmtree );
+
+$Is_VMS = $^O eq 'VMS';
+
+sub mkpath {
+    my($paths, $verbose, $mode) = @_;
+    # $paths   -- either a path string or ref to list of paths
+    # $verbose -- optional print "mkdir $path" for each directory created
+    # $mode    -- optional permissions, defaults to 0777
+    local($")="/";
+    $mode = 0777 unless defined($mode);
+    $paths = [$paths] unless ref $paths;
+    my(@created);
+    foreach $path (@$paths){
+        next if -d $path;
+        my(@p);
+        foreach(split(/\//, $path)){
+            push(@p, $_);
+            next if -d "@p/";
+            print "mkdir @p\n" if $verbose;
+	    mkdir("@p",$mode) || croak "mkdir @p: $!";
+            push(@created, "@p");
+        }
+    }
+    @created;
+}
+
+sub rmtree {
+    my($roots, $verbose, $safe) = @_;
+    my(@files);
+    my($count) = 0;
+    $roots = [$roots] unless ref $roots;
+
+    foreach $root (@{$roots}) {
+       $root =~ s#/$##;
+       if (not -l $root and -d _) { 
+           opendir(D,$root);
+           ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
+           @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
+           closedir(D);
+           $count += rmtree(\@files,$verbose,$safe);
+           if ($safe &&
+               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+               print "skipped $root\n" if $verbose;
+               next;
+           }
+           print "rmdir $root\n" if $verbose;
+           (rmdir $root && ++$count) or carp "Can't remove directory $root: $!";
+        }
+        else { 
+           if ($safe &&
+               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+               print "skipped $root\n" if $verbose;
+               next;
+           }
+           print "unlink $root\n" if $verbose;
+           while (-e $root || -l $root) { # delete all versions under VMS
+               (unlink($root) && ++$count)
+                   or carp "Can't unlink file $root: $!";
+           }
+        }
+    }
+
+    $count;
+}
+
+1;
+
+__END__
diff --git a/gnu/usr.bin/perl/lib/FileCache.pm b/gnu/usr.bin/perl/lib/FileCache.pm
new file mode 100644
index 00000000000..3d01371b3b3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/FileCache.pm
@@ -0,0 +1,78 @@
+package FileCache;
+
+=head1 NAME
+
+FileCache - keep more files open than the system permits
+
+=head1 SYNOPSIS
+
+    cacheout $path;
+    print $path @data;
+
+=head1 DESCRIPTION
+
+The C<cacheout> function will make sure that there's a filehandle open
+for writing available as the pathname you give it.  It automatically
+closes and re-opens files if you exceed your system file descriptor
+maximum.
+
+=head1 BUGS
+
+F<sys/param.h> lies with its C<NOFILE> define on some systems,
+so you may have to set $cacheout::maxopen yourself.
+
+=cut
+
+require 5.000;
+use Carp;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(
+    cacheout
+);
+
+# Open in their package.
+
+sub cacheout_open {
+    my $pack = caller(1);
+    open(*{$pack . '::' . $_[0]}, $_[1]);
+}
+
+sub cacheout_close {
+    my $pack = caller(1);
+    close(*{$pack . '::' . $_[0]});
+}
+
+# But only this sub name is visible to them.
+
+$cacheout_seq = 0;
+$cacheout_numopen = 0;
+
+sub cacheout {
+    ($file) = @_;
+    unless (defined $cacheout_maxopen) {
+	if (open(PARAM,'/usr/include/sys/param.h')) {
+	    local $.;
+	    while (<PARAM>) {
+		$cacheout_maxopen = $1 - 4
+		    if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+	    }
+	    close PARAM;
+	}
+	$cacheout_maxopen = 16 unless $cacheout_maxopen;
+    }
+    if (!$isopen{$file}) {
+	if (++$cacheout_numopen > $cacheout_maxopen) {
+	    my @lru = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $cacheout_maxopen / 3);
+	    $cacheout_numopen -= @lru;
+	    for (@lru) { &cacheout_close($_); delete $isopen{$_}; }
+	}
+	cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    or croak("Can't create $file: $!");
+    }
+    $isopen{$file} = ++$cacheout_seq;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Getopt/Long.pm b/gnu/usr.bin/perl/lib/Getopt/Long.pm
new file mode 100644
index 00000000000..df306d68c99
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Getopt/Long.pm
@@ -0,0 +1,891 @@
+# GetOpt::Long.pm -- POSIX compatible options parsing
+
+# RCS Status      : $Id: Long.pm,v 1.1.1.1 1996/08/19 10:12:44 downsj Exp $
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Fri Feb  2 21:24:32 1996
+# Update Count    : 347
+# Status          : Released
+
+package Getopt::Long;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+use strict;
+
+=head1 NAME
+
+GetOptions - extended processing of command line options
+
+=head1 SYNOPSIS
+
+  use Getopt::Long;
+  $result = GetOptions (...option-descriptions...);
+
+=head1 DESCRIPTION
+
+The Getopt::Long module implements an extended getopt function called
+GetOptions(). This function adheres to the POSIX syntax for command
+line options, with GNU extensions. In general, this means that options
+have long names instead of single letters, and are introduced with a
+double dash "--". There is no bundling of command line options, as was
+the case with the more traditional single-letter approach. For
+example, the UNIX "ps" command can be given the command line "option" 
+
+  -vax
+
+which means the combination of B<-v>, B<-a> and B<-x>. With the new
+syntax B<--vax> would be a single option, probably indicating a
+computer architecture. 
+
+Command line options can be used to set values. These values can be
+specified in one of two ways:
+
+  --size 24
+  --size=24
+
+GetOptions is called with a list of option-descriptions, each of which
+consists of two elements: the option specifier and the option linkage.
+The option specifier defines the name of the option and, optionally,
+the value it can take. The option linkage is usually a reference to a
+variable that will be set when the option is used. For example, the
+following call to GetOptions:
+
+  &GetOptions("size=i" => \$offset);
+
+will accept a command line option "size" that must have an integer
+value. With a command line of "--size 24" this will cause the variable
+$offset to get the value 24.
+
+Alternatively, the first argument to GetOptions may be a reference to
+a HASH describing the linkage for the options. The following call is
+equivalent to the example above:
+
+  %optctl = ("size" => \$offset);
+  &GetOptions(\%optctl, "size=i");
+
+Linkage may be specified using either of the above methods, or both.
+Linkage specified in the argument list takes precedence over the
+linkage specified in the HASH.
+
+The command line options are taken from array @ARGV. Upon completion
+of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
+the command line.
+ 
+Each option specifier designates the name of the option, optionally
+followed by an argument specifier. Values for argument specifiers are:
+
+=over 8
+
+=item <none>
+
+Option does not take an argument. 
+The option variable will be set to 1.
+
+=item !
+
+Option does not take an argument and may be negated, i.e. prefixed by
+"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
+(with value 0).
+The option variable will be set to 1, or 0 if negated.
+
+=item =s
+
+Option takes a mandatory string argument.
+This string will be assigned to the option variable.
+Note that even if the string argument starts with B<-> or B<-->, it
+will not be considered an option on itself.
+
+=item :s
+
+Option takes an optional string argument.
+This string will be assigned to the option variable.
+If omitted, it will be assigned "" (an empty string).
+If the string argument starts with B<-> or B<-->, it
+will be considered an option on itself.
+
+=item =i
+
+Option takes a mandatory integer argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value. 
+
+=item :i
+
+Option takes an optional integer argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item =f
+
+Option takes a mandatory real number argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item :f
+
+Option takes an optional real number argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+
+=back
+
+A lone dash B<-> is considered an option, the corresponding option
+name is the empty string.
+
+A double dash on itself B<--> signals end of the options list.
+
+=head2 Linkage specification
+
+The linkage specifier is optional. If no linkage is explicitly
+specified but a ref HASH is passed, GetOptions will place the value in
+the HASH. For example:
+
+  %optctl = ();
+  &GetOptions (\%optctl, "size=i");
+
+will perform the equivalent of the assignment
+
+  $optctl{"size"} = 24;
+
+For array options, a reference to an array is used, e.g.:
+
+  %optctl = ();
+  &GetOptions (\%optctl, "sizes=i@");
+
+with command line "-sizes 24 -sizes 48" will perform the equivalent of
+the assignment
+
+  $optctl{"sizes"} = [24, 48];
+
+If no linkage is explicitly specified and no ref HASH is passed,
+GetOptions will put the value in a global variable named after the
+option, prefixed by "opt_". To yield a usable Perl variable,
+characters that are not part of the syntax for variables are
+translated to underscores. For example, "--fpp-struct-return" will set
+the variable $opt_fpp_struct_return. Note that this variable resides
+in the namespace of the calling program, not necessarily B<main>.
+For example:
+
+  &GetOptions ("size=i", "sizes=i@");
+
+with command line "-size 10 -sizes 24 -sizes 48" will perform the
+equivalent of the assignments
+
+  $opt_size = 10;
+  @opt_sizes = (24, 48);
+
+A lone dash B<-> is considered an option, the corresponding Perl
+identifier is $opt_ .
+
+The linkage specifier can be a reference to a scalar, a reference to
+an array or a reference to a subroutine.
+
+If a REF SCALAR is supplied, the new value is stored in the referenced
+variable. If the option occurs more than once, the previous value is
+overwritten. 
+
+If a REF ARRAY is supplied, the new value is appended (pushed) to the
+referenced array. 
+
+If a REF CODE is supplied, the referenced subroutine is called with
+two arguments: the option name and the option value.
+The option name is always the true name, not an abbreviation or alias.
+
+=head2 Aliases and abbreviations
+
+The option name may actually be a list of option names, separated by
+"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
+op this option. If no linkage is specified, options "foo", "bar" and
+"blech" all will set $opt_foo.
+
+Option names may be abbreviated to uniqueness, depending on
+configuration variable $Getopt::Long::autoabbrev.
+
+=head2 Non-option call-back routine
+
+A special option specifier, <>, can be used to designate a subroutine
+to handle non-option arguments. GetOptions will immediately call this
+subroutine for every non-option it encounters in the options list.
+This subroutine gets the name of the non-option passed.
+This feature requires $Getopt::Long::order to have the value $PERMUTE.
+See also the examples.
+
+=head2 Option starters
+
+On the command line, options can start with B<-> (traditional), B<-->
+(POSIX) and B<+> (GNU, now being phased out). The latter is not
+allowed if the environment variable B<POSIXLY_CORRECT> has been
+defined.
+
+Options that start with "--" may have an argument appended, separated
+with an "=", e.g. "--foo=bar".
+
+=head2 Return value
+
+A return status of 0 (false) indicates that the function detected
+one or more errors.
+
+=head1 COMPATIBILITY
+
+Getopt::Long::GetOptions() is the successor of
+B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
+In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
+the module.
+
+If an "@" sign is appended to the argument specifier, the option is
+treated as an array.  Value(s) are not set, but pushed into array
+@opt_name. This only applies if no linkage is supplied.
+
+If configuration variable $Getopt::Long::getopt_compat is set to a
+non-zero value, options that start with "+" may also include their
+arguments, e.g. "+foo=bar". This is for compatiblity with older
+implementations of the GNU "getopt" routine.
+
+If the first argument to GetOptions is a string consisting of only
+non-alphanumeric characters, it is taken to specify the option starter
+characters. Everything starting with one of these characters from the
+starter will be considered an option. B<Using a starter argument is
+strongly deprecated.>
+
+For convenience, option specifiers may have a leading B<-> or B<-->,
+so it is possible to write:
+
+   GetOptions qw(-foo=s --bar=i --ar=s);
+
+=head1 EXAMPLES
+
+If the option specifier is "one:i" (i.e. takes an optional integer
+argument), then the following situations are handled:
+
+   -one -two		-> $opt_one = '', -two is next option
+   -one -2		-> $opt_one = -2
+
+Also, assume specifiers "foo=s" and "bar:s" :
+
+   -bar -xxx		-> $opt_bar = '', '-xxx' is next option
+   -foo -bar		-> $opt_foo = '-bar'
+   -foo --		-> $opt_foo = '--'
+
+In GNU or POSIX format, option names and values can be combined:
+
+   +foo=blech		-> $opt_foo = 'blech'
+   --bar=		-> $opt_bar = ''
+   --bar=--		-> $opt_bar = '--'
+
+Example of using variabel references:
+
+   $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
+
+With command line options "-foo blech -bar 24 -ar xx -ar yy" 
+this will result in:
+
+   $bar = 'blech'
+   $opt_bar = 24
+   @ar = ('xx','yy')
+
+Example of using the <> option specifier:
+
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   &GetOptions("foo=i", \$myfoo, "<>", \&mysub);
+
+Results:
+
+   &mysub("bar") will be called (with $myfoo being 1)
+   &mysub("blech") will be called (with $myfoo being 2)
+
+Compare this with:
+
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   &GetOptions("foo=i", \$myfoo);
+
+This will leave the non-options in @ARGV:
+
+   $myfoo -> 2
+   @ARGV -> qw(bar blech)
+
+=head1 CONFIGURATION VARIABLES
+
+The following variables can be set to change the default behaviour of
+GetOptions():
+
+=over 12
+
+=item $Getopt::Long::autoabbrev      
+
+Allow option names to be abbreviated to uniqueness.
+Default is 1 unless environment variable
+POSIXLY_CORRECT has been set.
+
+=item $Getopt::Long::getopt_compat   
+
+Allow '+' to start options.
+Default is 1 unless environment variable
+POSIXLY_CORRECT has been set.
+
+=item $Getopt::Long::order           
+
+Whether non-options are allowed to be mixed with
+options.
+Default is $REQUIRE_ORDER if environment variable
+POSIXLY_CORRECT has been set, $PERMUTE otherwise.
+
+$PERMUTE means that 
+
+    -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+    -foo -bar arg1 arg2 arg3
+
+If a non-option call-back routine is specified, @ARGV will always be
+empty upon succesful return of GetOptions since all options have been
+processed, except when B<--> is used:
+
+    -foo arg1 -bar arg2 -- arg3
+
+will call the call-back routine for arg1 and arg2, and terminate
+leaving arg2 in @ARGV.
+
+If $Getopt::Long::order is $REQUIRE_ORDER, options processing
+terminates when the first non-option is encountered.
+
+    -foo arg1 -bar arg2 arg3
+
+is equivalent to
+
+    -foo -- arg1 -bar arg2 arg3
+
+$RETURN_IN_ORDER is not supported by GetOptions().
+
+=item $Getopt::Long::ignorecase      
+
+Ignore case when matching options. Default is 1.
+
+=item $Getopt::Long::VERSION
+
+The version number of this Getopt::Long implementation in the format
+C<major>.C<minor>. This can be used to have Exporter check the
+version, e.g.
+
+    use Getopt::Long 2.00;
+
+You can inspect $Getopt::Long::major_version and
+$Getopt::Long::minor_version for the individual components.
+
+=item $Getopt::Long::error
+
+Internal error flag. May be incremented from a call-back routine to
+cause options parsing to fail.
+
+=item $Getopt::Long::debug           
+
+Enable copious debugging output. Default is 0.
+
+=back
+
+=cut
+
+################ Introduction ################
+#
+# This package implements an extended getopt function. This function
+# adheres to the new syntax (long option names, no bundling). It tries
+# to implement the better functionality of traditional, GNU and POSIX
+# getopt functions.
+# 
+# This program is Copyright 1990,1996 by Johan Vromans.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+# 
+# 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 the
+# GNU General Public License for more details.
+# 
+# If you do not have a copy of the GNU General Public License write to
+# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
+# MA 02139, USA.
+
+################ History ################
+# 
+# 13-Jan-1996		Johan Vromans
+#    Generalized the linkage interface.
+#    Eliminated the linkage argument.
+#    Add code references as a possible value for the option linkage.
+#    Add option specifier <> to have a call-back for non-options.
+#
+# 26-Dec-1995		Johan Vromans
+#    Import from netgetopt.pl.
+#    Turned into a decent module.
+#    Added linkage argument.
+
+################ Configuration Section ################
+
+# Values for $order. See GNU getopt.c for details.
+($Getopt::Long::REQUIRE_ORDER,
+ $Getopt::Long::PERMUTE, 
+ $Getopt::Long::RETURN_IN_ORDER) = (0..2);
+
+my $gen_prefix;			# generic prefix (option starters)
+
+# Handle POSIX compliancy.
+if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+    $gen_prefix = "(--|-)";
+    $Getopt::Long::autoabbrev = 0;	# no automatic abbrev of options
+    $Getopt::Long::getopt_compat = 0;	# disallow '+' to start options
+    $Getopt::Long::order = $Getopt::Long::REQUIRE_ORDER;
+}
+else {
+    $gen_prefix = "(--|-|\\+)";
+    $Getopt::Long::autoabbrev = 1;	# automatic abbrev of options
+    $Getopt::Long::getopt_compat = 1;	# allow '+' to start options
+    $Getopt::Long::order = $Getopt::Long::PERMUTE;
+}
+
+# Other configurable settings.
+$Getopt::Long::debug = 0;		# for debugging
+$Getopt::Long::error = 0;		# error tally
+$Getopt::Long::ignorecase = 1;		# ignore case when matching options
+($Getopt::Long::version,
+ $Getopt::Long::major_version, 
+ $Getopt::Long::minor_version) = '$Revision: 1.1.1.1 $ ' =~ /: ((\d+)\.(\d+))/;
+$Getopt::Long::version .= '*' if length('$Locker:  $ ') > 12;
+
+################ Subroutines ################
+
+sub GetOptions {
+
+    my @optionlist = @_;	# local copy of the option descriptions
+    my $argend = '--';		# option list terminator
+    my %opctl;			# table of arg.specs
+    my $pkg = (caller)[0];	# current context
+				# Needed if linkage is omitted.
+    my %aliases;		# alias table
+    my @ret = ();		# accum for non-options
+    my %linkage;		# linkage
+    my $userlinkage;		# user supplied HASH
+    my $debug = $Getopt::Long::debug;	# convenience
+    my $genprefix = $gen_prefix; # so we can call the same module more 
+				# than once in differing environments
+    $Getopt::Long::error = 0;
+
+    print STDERR ("GetOptions $Getopt::Long::version",
+		  " [GetOpt::Long $Getopt::Long::VERSION] -- ",
+		  "called from package \"$pkg\".\n",
+		  "  autoabbrev=$Getopt::Long::autoabbrev".
+		  ",getopt_compat=$Getopt::Long::getopt_compat",
+		  ",genprefix=\"$genprefix\"",
+		  ",order=$Getopt::Long::order",
+		  ",ignorecase=$Getopt::Long::ignorecase",
+		  ".\n")
+	if $debug;
+
+    # Check for ref HASH as first argument. 
+    $userlinkage = undef;
+    if ( ref($optionlist[0]) && ref($optionlist[0]) eq 'HASH' ) {
+	$userlinkage = shift (@optionlist);
+    }
+
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    if ( $optionlist[0] =~ /^\W+$/ ) {
+	$genprefix = shift (@optionlist);
+	# Turn into regexp.
+	$genprefix =~ s/(\W)/\\$1/g;
+	$genprefix = "[" . $genprefix . "]";
+    }
+
+    # Verify correctness of optionlist.
+    %opctl = ();
+    while ( @optionlist > 0 ) {
+	my $opt = shift (@optionlist);
+
+	# Strip leading prefix so people can specify "-foo=i" if they like.
+	$opt = $' if $opt =~ /^($genprefix)+/;
+
+	if ( $opt eq '<>' ) {
+	    if ( (defined $userlinkage)
+		&& !(@optionlist > 0 && ref($optionlist[0]))
+		&& (exists $userlinkage->{$opt})
+		&& ref($userlinkage->{$opt}) ) {
+		unshift (@optionlist, $userlinkage->{$opt});
+	    }
+	    unless ( @optionlist > 0 
+		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
+		warn ("Option spec <> requires a reference to a subroutine\n");
+		$Getopt::Long::error++;
+		next;
+	    }
+	    $linkage{'<>'} = shift (@optionlist);
+	    next;
+	}
+
+	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
+	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse]@?)?$/ ) {
+	    warn ("Error in option spec: \"", $opt, "\"\n");
+	    $Getopt::Long::error++;
+	    next;
+	}
+	my ($o, $c, $a) = ($1, $2);
+
+	if ( ! defined $o ) {
+	    # empty -> '-' option
+	    $opctl{$o = ''} = defined $c ? $c : '';
+	}
+	else {
+	    # Handle alias names
+	    my @o =  split (/\|/, $o);
+	    $o = $o[0];
+	    foreach ( @o ) {
+		if ( defined $c && $c eq '!' ) {
+		    $opctl{"no$_"} = $c;
+		    $c = '';
+		}
+		$opctl{$_} = defined $c ? $c : '';
+		if ( defined $a ) {
+		    # Note alias.
+		    $aliases{$_} = $a;
+		}
+		else {
+		    # Set primary name.
+		    $a = $_;
+		}
+	    }
+	}
+
+	# If no linkage is supplied in the @optionlist, copy it from
+	# the userlinkage if available.
+	if ( defined $userlinkage ) {
+	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
+		if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
+		    print STDERR ("=> found userlinkage for \"$o\": ",
+				  "$userlinkage->{$o}\n")
+			if $debug;
+		    unshift (@optionlist, $userlinkage->{$o});
+		}
+		else {
+		    # Do nothing. Being undefined will be handled later.
+		    next;
+		}
+	    }
+	}
+
+	# Copy the linkage. If omitted, link to global variable.
+	if ( @optionlist > 0 && ref($optionlist[0]) ) {
+	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
+		if $debug;
+	    if ( ref($optionlist[0]) eq 'SCALAR'
+		|| ref($optionlist[0]) eq 'ARRAY'
+		|| ref($optionlist[0]) eq 'CODE' ) {
+		$linkage{$o} = shift (@optionlist);
+	    }
+	    else {
+		warn ("Invalid option linkage for \"", $opt, "\"\n");
+		$Getopt::Long::error++;
+	    }
+	}
+	else {
+	    # Link to global $opt_XXX variable.
+	    # Make sure a valid perl identifier results.
+	    my $ov = $o;
+	    $ov =~ s/\W/_/g;
+	    if ( $c && $c =~ /@/ ) {
+		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
+	    }
+	    else {
+		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
+	    }
+	}
+    }
+
+    # Bail out if errors found.
+    return 0 if $Getopt::Long::error;
+
+    # Sort the possible option names.
+    my @opctl = sort(keys (%opctl)) if $Getopt::Long::autoabbrev;
+
+    # Show if debugging.
+    if ( $debug ) {
+	my ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+    }
+
+    my $opt;			# current option
+    my $arg;			# current option value
+    my $array;			# current option is array typed
+
+    # Process argument list
+    while ( @ARGV > 0 ) {
+
+	# >>> See also the continue block <<<
+
+	#### Get next argument ####
+
+	$opt = shift (@ARGV);
+	$arg = undef;
+	my $optarg = undef;
+	$array = 0;
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+
+	#### Determine what we have ####
+
+	# Double dash is option list terminator.
+	if ( $opt eq $argend ) {
+	    # Finish. Push back accumulated arguments and return.
+	    unshift (@ARGV, @ret) 
+		if $Getopt::Long::order == $Getopt::Long::PERMUTE;
+	    return ($Getopt::Long::error == 0);
+	}
+
+	if ( $opt =~ /^$genprefix/ ) {
+	    # Looks like an option.
+	    $opt = $';		# option name (w/o prefix)
+	    # If it is a long opt, it may include the value.
+	    if (($& eq "--" || ($Getopt::Long::getopt_compat && $& eq "+"))
+		&& $opt =~ /^([^=]+)=/ ) {
+		$opt = $1;
+		$optarg = $';
+		print STDERR ("=> option \"", $opt, 
+			      "\", optarg = \"$optarg\"\n") if $debug;
+	    }
+
+	}
+
+	# Not an option. Save it if we $PERMUTE and don't have a <>.
+	elsif ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
+	    # Try non-options call-back.
+	    my $cb;
+	    if ( (defined ($cb = $linkage{'<>'})) ) {
+		&$cb($opt);
+	    }
+	    else {
+		push (@ret, $opt);
+	    }
+	    next;
+	}
+
+	# ...otherwise, terminate.
+	else {
+	    # Push this one back and exit.
+	    unshift (@ARGV, $opt);
+	    return ($Getopt::Long::error == 0);
+	}
+
+	#### Look it up ###
+
+	$opt =~ tr/A-Z/a-z/ if $Getopt::Long::ignorecase;
+
+	my $tryopt = $opt;
+	if ( $Getopt::Long::autoabbrev ) {
+	    my $pat;
+
+	    # Turn option name into pattern.
+	    ($pat = $opt) =~ s/(\W)/\\$1/g;
+	    # Look up in option names.
+	    my @hits = grep (/^$pat/, @opctl);
+	    print STDERR ("=> ", 0+@hits, " hits (@hits) with \"$pat\" ",
+			  "out of ", 0+@opctl, "\n") if $debug;
+
+	    # Check for ambiguous results.
+	    unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
+		print STDERR ("Option ", $opt, " is ambiguous (",
+			      join(", ", @hits), ")\n");
+		$Getopt::Long::error++;
+		next;
+	    }
+
+	    # Complete the option name, if appropriate.
+	    if ( @hits == 1 && $hits[0] ne $opt ) {
+		$tryopt = $hits[0];
+		print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
+		    if $debug;
+	    }
+	}
+
+	my $type;
+	unless  ( defined ( $type = $opctl{$tryopt} ) ) {
+	    print STDERR ("Unknown option: ", $opt, "\n");
+	    $Getopt::Long::error++;
+	    next;
+	}
+	$opt = $tryopt;
+	print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+
+	#### Determine argument status ####
+
+	# If it is an option w/o argument, we're almost finished with it.
+	if ( $type eq '' || $type eq '!' ) {
+	    if ( defined $optarg ) {
+		print STDERR ("Option ", $opt, " does not take an argument\n");
+		$Getopt::Long::error++;
+	    }
+	    elsif ( $type eq '' ) {
+		$arg = 1;		# supply explicit value
+	    }
+	    else {
+		substr ($opt, 0, 2) = ''; # strip NO prefix
+		$arg = 0;		# supply explicit value
+	    }
+	    next;
+	}
+
+	# Get mandatory status and type info.
+	my $mand;
+	($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
+
+	# Check if there is an option argument available.
+	if ( defined $optarg ? ($optarg eq '') : (@ARGV <= 0) ) {
+
+	    # Complain if this option needs an argument.
+	    if ( $mand eq "=" ) {
+		print STDERR ("Option ", $opt, " requires an argument\n");
+		$Getopt::Long::error++;
+	    }
+	    if ( $mand eq ":" ) {
+		$arg = $type eq "s" ? '' : 0;
+	    }
+	    next;
+	}
+
+	# Get (possibly optional) argument.
+	$arg = defined $optarg ? $optarg : shift (@ARGV);
+
+	#### Check if the argument is valid for this option ####
+
+	if ( $type eq "s" ) {	# string
+	    # A mandatory string takes anything. 
+	    next if $mand eq "=";
+
+	    # An optional string takes almost anything. 
+	    next if defined $optarg;
+	    next if $arg eq "-";
+
+	    # Check for option or option list terminator.
+	    if ($arg eq $argend ||
+		$arg =~ /^$genprefix.+/) {
+		# Push back.
+		unshift (@ARGV, $arg);
+		# Supply empty value.
+		$arg = '';
+	    }
+	    next;
+	}
+
+	if ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	    if ( $arg !~ /^-?[0-9]+$/ ) {
+		if ( defined $optarg || $mand eq "=" ) {
+		    print STDERR ("Value \"", $arg, "\" invalid for option ",
+				  $opt, " (number expected)\n");
+		    $Getopt::Long::error++;
+		    undef $arg;	# don't assign it
+		}
+		else {
+		    # Push back.
+		    unshift (@ARGV, $arg);
+		    # Supply default value.
+		    $arg = 0;
+		}
+	    }
+	    next;
+	}
+
+	if ( $type eq "f" ) { # fixed real number, int is also ok
+	    if ( $arg !~ /^-?[0-9.]+$/ ) {
+		if ( defined $optarg || $mand eq "=" ) {
+		    print STDERR ("Value \"", $arg, "\" invalid for option ",
+				  $opt, " (real number expected)\n");
+		    $Getopt::Long::error++;
+		    undef $arg;	# don't assign it
+		}
+		else {
+		    # Push back.
+		    unshift (@ARGV, $arg);
+		    # Supply default value.
+		    $arg = 0.0;
+		}
+	    }
+	    next;
+	}
+
+	die ("GetOpt::Long internal error (Can't happen)\n");
+    }
+
+    continue {
+	if ( defined $arg ) {
+	    $opt = $aliases{$opt} if defined $aliases{$opt};
+
+	    if ( defined $linkage{$opt} ) {
+		print STDERR ("=> ref(\$L{$opt}) -> ",
+			      ref($linkage{$opt}), "\n") if $debug;
+
+		if ( ref($linkage{$opt}) eq 'SCALAR' ) {
+		    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
+		    ${$linkage{$opt}} = $arg;
+		}
+		elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
+		    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+			if $debug;
+		    push (@{$linkage{$opt}}, $arg);
+		}
+		elsif ( ref($linkage{$opt}) eq 'CODE' ) {
+		    print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
+			if $debug;
+		    &{$linkage{$opt}}($opt, $arg);
+		}
+		else {
+		    print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
+				  "\" in linkage\n");
+		    die ("Getopt::Long -- internal error!\n");
+		}
+	    }
+	    # No entry in linkage means entry in userlinkage.
+	    elsif ( $array ) {
+		if ( defined $userlinkage->{$opt} ) {
+		    print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
+			if $debug;
+		    push (@{$userlinkage->{$opt}}, $arg);
+		}
+		else {
+		    print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
+			if $debug;
+		    $userlinkage->{$opt} = [$arg];
+		}
+	    }
+	    else {
+		print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+		$userlinkage->{$opt} = $arg;
+	    }
+	}
+    }
+
+    # Finish.
+    if ( $Getopt::Long::order == $Getopt::Long::PERMUTE ) {
+	#  Push back accumulated arguments
+	unshift (@ARGV, @ret) if @ret > 0;
+    }
+
+    return ($Getopt::Long::error == 0);
+}
+
+################ Package return ################
+
+# Returning 1 is so boring...
+$Getopt::Long::major_version * 1000 + $Getopt::Long::minor_version;
diff --git a/gnu/usr.bin/perl/lib/Getopt/Std.pm b/gnu/usr.bin/perl/lib/Getopt/Std.pm
new file mode 100644
index 00000000000..4117ca7f8b5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Getopt/Std.pm
@@ -0,0 +1,128 @@
+package Getopt::Std;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+getopt - Process single-character switches with switch clustering
+
+getopts - Process single-character switches with switch clustering
+
+=head1 SYNOPSIS
+
+    use Getopt::Std;
+    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
+		      # Sets opt_* as a side effect.
+
+=head1 DESCRIPTION
+
+The getopt() functions processes single-character switches with switch
+clustering.  Pass one argument which is a string containing all switches
+that take an argument.  For each switch found, sets $opt_x (where x is the
+switch name) to the value of the argument, or 1 if no argument.  Switches
+which take an argument don't care whether there is a space between the
+switch and the argument.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(getopt getopts);
+
+# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+
+# Process single-character switches with switch clustering.  Pass one argument
+# which is a string containing all switches that take an argument.  For each
+# switch found, sets $opt_x (where x is the switch name) to the value of the
+# argument, or 1 if no argument.  Switches which take an argument don't care
+# whether there is a space between the switch and the argument.
+
+# Usage:
+#	getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+sub getopt {
+    local($argumentative) = @_;
+    local($_,$first,$rest);
+    local $Exporter::ExportLevel;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	if (index($argumentative,$first) >= 0) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+	    eval "\$opt_$first = \$rest;";
+	    push( @EXPORT, "\$opt_$first" );
+	}
+	else {
+	    eval "\$opt_$first = 1;";
+	    push( @EXPORT, "\$opt_$first" );
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $Exporter::ExportLevel++;
+    import Getopt::Std;
+}
+
+# Usage:
+#   getopts('a:bc');	# -a takes arg. -b & -c not. Sets opt_* as a
+#			#  side effect.
+
+sub getopts {
+    local($argumentative) = @_;
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local $Exporter::ExportLevel;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	$pos = index($argumentative,$first);
+	if($pos >= 0) {
+	    if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
+		shift(@ARGV);
+		if($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		eval "\$opt_$first = \$rest;";
+		push( @EXPORT, "\$opt_$first" );
+	    }
+	    else {
+		eval "\$opt_$first = 1";
+		push( @EXPORT, "\$opt_$first" );
+		if($rest eq '') {
+		    shift(@ARGV);
+		}
+		else {
+		    $ARGV[0] = "-$rest";
+		}
+	    }
+	}
+	else {
+	    print STDERR "Unknown option: $first\n";
+	    ++$errs;
+	    if($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $Exporter::ExportLevel++;
+    import Getopt::Std;
+    $errs == 0;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/I18N/Collate.pm b/gnu/usr.bin/perl/lib/I18N/Collate.pm
new file mode 100644
index 00000000000..0d8314e12e4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/I18N/Collate.pm
@@ -0,0 +1,145 @@
+package I18N::Collate;
+
+=head1 NAME
+
+I18N::Collate - compare 8-bit scalar data according to the current locale
+
+=head1 SYNOPSIS
+
+    use I18N::Collate;
+    setlocale(LC_COLLATE, 'locale-of-your-choice'); 
+    $s1 = new I18N::Collate "scalar_data_1";
+    $s2 = new I18N::Collate "scalar_data_2";
+
+=head1 DESCRIPTION
+
+This module provides you with objects that will collate 
+according to your national character set, provided that the 
+POSIX setlocale() function is supported on your system.
+
+You can compare $s1 and $s2 above with
+
+    $s1 le $s2
+
+to extract the data itself, you'll need a dereference: $$s1
+
+This uses POSIX::setlocale(). The basic collation conversion is done by
+strxfrm() which terminates at NUL characters being a decent C routine.
+collate_xfrm() handles embedded NUL characters gracefully.  Due to C<cmp>
+and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also.  The
+available locales depend on your operating system; try whether C<locale
+-a> shows them or man pages for "locale" or "nlsinfo" or
+the direct approach C<ls /usr/lib/nls/loc> or C<ls
+/usr/lib/nls>.  Not all the locales that your vendor supports
+are necessarily installed: please consult your operating system's
+documentation and possibly your local system administration.
+
+The locale names are probably something like
+C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example
+C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr),
+ISO Latin (8859) 1 (-1) which is the Western European character set.
+
+=cut
+
+# I18N::Collate.pm
+#
+# Author:	Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
+#		Helsinki University of Technology, Finland
+#
+# Acks:		Guy Decoux <decoux@moulon.inra.fr> understood
+#		overloading magic much deeper than I and told
+#		how to cut the size of this code by more than half.
+#		(my first version did overload all of lt gt eq le ge cmp)
+#
+# Purpose:      compare 8-bit scalar data according to the current locale
+#
+# Requirements:	Perl5 POSIX::setlocale() and POSIX::strxfrm()
+#
+# Exports:	setlocale 1)
+#		collate_xfrm 2)
+#
+# Overloads:	cmp # 3)
+#
+# Usage:	use I18N::Collate;
+#	        setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
+#		$s1 = new I18N::Collate "scalar_data_1";
+#		$s2 = new I18N::Collate "scalar_data_2";
+#		
+#		now you can compare $s1 and $s2: $s1 le $s2
+#		to extract the data itself, you need to deref: $$s1
+#		
+# Notes:	
+#		1) this uses POSIX::setlocale
+#		2) the basic collation conversion is done by strxfrm() which
+#		   terminates at NUL characters being a decent C routine.
+#		   collate_xfrm handles embedded NUL characters gracefully.
+#		3) due to cmp and overload magic, lt le eq ge gt work also
+#		4) the available locales depend on your operating system;
+#		   try whether "locale -a" shows them or man pages for
+#		   "locale" or "nlsinfo" work or the more direct
+#		   approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
+#		   Not all the locales that your vendor supports
+#		   are necessarily installed: please consult your
+#		   operating system's documentation.
+#		   The locale names are probably something like
+#		   'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
+#		   for example 'fr_CH.ISO8859-1' is the Swiss (CH)
+#		   variant of French (fr), ISO Latin (8859) 1 (-1)
+#		   which is the Western European character set.
+#
+# Updated:	19960104 1946 GMT
+#
+# ---
+
+use POSIX qw(strxfrm LC_COLLATE);
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
+@EXPORT_OK = qw();
+
+use overload qw(
+fallback	1
+cmp		collate_cmp
+);
+
+sub new { my $new = $_[1]; bless \$new }
+
+sub setlocale {
+ my ($category, $locale) = @_[0,1];
+
+ POSIX::setlocale($category, $locale) if (defined $category);
+ # the current $LOCALE 
+ $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
+}
+
+sub C {
+  my $s = ${$_[0]};
+
+  $C->{$LOCALE}->{$s} = collate_xfrm($s)
+    unless (defined $C->{$LOCALE}->{$s}); # cache when met
+
+  $C->{$LOCALE}->{$s};
+}
+
+sub collate_xfrm {
+  my $s = $_[0];
+  my $x = '';
+  
+  for (split(/(\000+)/, $s)) {
+    $x .= (/^\000/) ? $_ : strxfrm("$_\000");
+  }
+
+  $x;
+}
+
+sub collate_cmp {
+  &C($_[0]) cmp &C($_[1]);
+}
+
+# init $LOCALE
+
+&I18N::Collate::setlocale();
+
+1; # keep require happy
diff --git a/gnu/usr.bin/perl/lib/IPC/Open2.pm b/gnu/usr.bin/perl/lib/IPC/Open2.pm
new file mode 100644
index 00000000000..243412ef094
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/IPC/Open2.pm
@@ -0,0 +1,107 @@
+package IPC::Open2;
+require 5.000;
+require Exporter;
+use Carp;
+
+=head1 NAME
+
+IPC::Open2, open2 - open a process for both reading and writing
+
+=head1 SYNOPSIS
+
+    use IPC::Open2;
+    $pid = open2(\*RDR, \*WTR, 'some cmd and args');
+      # or
+    $pid = open2(\*RDR, \*WTR, 'some', 'cmd', 'and', 'args');
+
+=head1 DESCRIPTION
+
+The open2() function spawns the given $cmd and connects $rdr for
+reading and $wtr for writing.  It's what you think should work 
+when you try
+
+    open(HANDLE, "|cmd args");
+
+open2() returns the process ID of the child process.  It doesn't return on
+failure: it just raises an exception matching C</^open2:/>.
+
+=head1 WARNING 
+
+It will not create these file handles for you.  You have to do this yourself.
+So don't pass it empty variables expecting them to get filled in for you.
+
+Additionally, this is very dangerous as you may block forever.
+It assumes it's going to talk to something like B<bc>, both writing to
+it and reading from it.  This is presumably safe because you "know"
+that commands like B<bc> will read a line at a time and output a line at
+a time.  Programs like B<sort> that read their entire input stream first,
+however, are quite apt to cause deadlock.  
+
+The big problem with this approach is that if you don't have control 
+over source code being run in the the child process, you can't control what it does 
+with pipe buffering.  Thus you can't just open a pipe to C<cat -v> and continually
+read and write a line from it.
+
+=head1 SEE ALSO
+
+See L<open3> for an alternative that handles STDERR as well.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(open2);
+
+# &open2: tom christiansen, <tchrist@convex.com>
+#
+# usage: $pid = open2('rdr', 'wtr', 'some cmd and args');
+#    or  $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#
+# spawn the given $cmd and connect $rdr for
+# reading and $wtr for writing.  return pid
+# of child, or 0 on failure.  
+# 
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.  
+# 
+# $wtr is left unbuffered.
+# 
+# abort program if
+#	rdr or wtr are null
+# 	pipe or fork or exec fails
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub open2 {
+    local($kidpid);
+    local($dad_rdr, $dad_wtr, @cmd) = @_;
+
+    $dad_rdr ne '' 		|| croak "open2: rdr should not be null";
+    $dad_wtr ne '' 		|| croak "open2: wtr should not be null";
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_rdr =~ s/^[^']+$/$package'$&/ unless ref $dad_rdr;
+    $dad_wtr =~ s/^[^']+$/$package'$&/ unless ref $dad_wtr;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+
+    pipe($dad_rdr, $kid_wtr) 	|| croak "open2: pipe 1 failed: $!";
+    pipe($kid_rdr, $dad_wtr) 	|| croak "open2: pipe 2 failed: $!";
+
+    if (($kidpid = fork) < 0) {
+	croak "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	close $dad_rdr; close $dad_wtr;
+	open(STDIN,  "<&$kid_rdr");
+	open(STDOUT, ">&$kid_wtr");
+	warn "execing @cmd\n" if $debug;
+	exec @cmd
+	    or croak "open2: exec of @cmd failed";   
+    } 
+    close $kid_rdr; close $kid_wtr;
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
+
diff --git a/gnu/usr.bin/perl/lib/IPC/Open3.pm b/gnu/usr.bin/perl/lib/IPC/Open3.pm
new file mode 100644
index 00000000000..d055c51ca84
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/IPC/Open3.pm
@@ -0,0 +1,144 @@
+package IPC::Open3;
+require 5.001;
+require Exporter;
+use Carp;
+
+=head1 NAME
+
+IPC::Open3, open3 - open a process for reading, writing, and error handling
+
+=head1 SYNOPSIS
+
+    $pid = open3(\*WTRFH, \*RDRFH, \*ERRFH 
+		    'some cmd and args', 'optarg', ...);
+
+=head1 DESCRIPTION
+
+Extremely similar to open2(), open3() spawns the given $cmd and
+connects RDRFH for reading, WTRFH for writing, and ERRFH for errors.  If
+ERRFH is '', or the same as RDRFH, then STDOUT and STDERR of the child are
+on the same file handle.
+
+If WTRFH begins with "<&", then WTRFH will be closed in the parent, and
+the child will read from it directly.  If RDRFH or ERRFH begins with
+">&", then the child will send output directly to that file handle.  In both
+cases, there will be a dup(2) instead of a pipe(2) made.
+
+If you try to read from the child's stdout writer and their stderr
+writer, you'll have problems with blocking, which means you'll
+want to use select(), which means you'll have to use sysread() instead
+of normal stuff.
+
+All caveats from open2() continue to apply.  See L<open2> for details.
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(open3);
+
+# &open3: Marc Horowitz <marc@mit.edu>
+# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+# fixed for 5.001 by Ulrich Kunitz <kunitz@mai-koeln.com>
+#
+# $Id: Open3.pm,v 1.1.1.1 1996/08/19 10:12:45 downsj Exp $
+#
+# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
+#
+# spawn the given $cmd and connect rdr for
+# reading, wtr for writing, and err for errors.
+# if err is '', or the same as rdr, then stdout and
+# stderr of the child are on the same fh.  returns pid
+# of child, or 0 on failure.
+
+
+# if wtr begins with '<&', then wtr will be closed in the parent, and
+# the child will read from it directly.  if rdr or err begins with
+# '>&', then the child will send output directly to that fd.  In both
+# cases, there will be a dup() instead of a pipe() made.
+
+
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.
+#
+# $wtr is left unbuffered.
+#
+# abort program if
+#   rdr or wtr are null
+#   pipe or fork or exec fails
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub open3 {
+    my($kidpid);
+    my($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    my($dup_wtr, $dup_rdr, $dup_err);
+
+    $dad_wtr			|| croak "open3: wtr should not be null";
+    $dad_rdr			|| croak "open3: rdr should not be null";
+    $dad_err = $dad_rdr if ($dad_err eq '');
+
+    $dup_wtr = ($dad_wtr =~ s/^[<>]&//);
+    $dup_rdr = ($dad_rdr =~ s/^[<>]&//);
+    $dup_err = ($dad_err =~ s/^[<>]&//);
+
+    # force unqualified filehandles into callers' package
+    my($package) = caller;
+    $dad_wtr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_wtr;
+    $dad_rdr =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_rdr;
+    $dad_err =~ s/^[^:]+$/$package\:\:$&/ unless ref $dad_err;
+
+    my($kid_rdr) = ++$fh;
+    my($kid_wtr) = ++$fh;
+    my($kid_err) = ++$fh;
+
+    if (!$dup_wtr) {
+	pipe($kid_rdr, $dad_wtr)    || croak "open3: pipe 1 (stdin) failed: $!";
+    }
+    if (!$dup_rdr) {
+	pipe($dad_rdr, $kid_wtr)    || croak "open3: pipe 2 (stdout) failed: $!";
+    }
+    if ($dad_err ne $dad_rdr && !$dup_err) {
+	pipe($dad_err, $kid_err)    || croak "open3: pipe 3 (stderr) failed: $!";
+    }
+
+    if (($kidpid = fork) < 0) {
+        croak "open3: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	if ($dup_wtr) {
+	    open(STDIN,  "<&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	} else {
+	    close($dad_wtr);
+	    open(STDIN,  "<&$kid_rdr");
+	}
+	if ($dup_rdr) {
+	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
+	} else {
+	    close($dad_rdr);
+	    open(STDOUT, ">&$kid_wtr");
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+		open(STDERR, ">&$dad_err")
+		    if (fileno(STDERR) != fileno($dad_err));
+	    } else {
+		close($dad_err);
+		open(STDERR, ">&$kid_err");
+	    }
+	} else {
+	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
+	}
+	local($")=(" ");
+	exec @cmd
+	    or croak "open3: exec of @cmd failed";
+    }
+
+    close $kid_rdr; close $kid_wtr; close $kid_err;
+    if ($dup_wtr) {
+	close($dad_wtr);
+    }
+
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
+
diff --git a/gnu/usr.bin/perl/lib/Math/BigFloat.pm b/gnu/usr.bin/perl/lib/Math/BigFloat.pm
new file mode 100644
index 00000000000..7551ad01a38
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/BigFloat.pm
@@ -0,0 +1,326 @@
+package Math::BigFloat;
+
+use Math::BigInt;
+
+use Exporter;  # just for use to be happy
+@ISA = (Exporter);
+
+use overload
+'+'	=>	sub {new Math::BigFloat &fadd},
+'-'	=>	sub {new Math::BigFloat
+		       $_[2]? fsub($_[1],${$_[0]}) : fsub(${$_[0]},$_[1])},
+'<=>'	=>	sub {new Math::BigFloat
+		       $_[2]? fcmp($_[1],${$_[0]}) : fcmp(${$_[0]},$_[1])},
+'cmp'	=>	sub {new Math::BigFloat
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Math::BigFloat &fmul},
+'/'	=>	sub {new Math::BigFloat 
+		       $_[2]? scalar fdiv($_[1],${$_[0]}) :
+			 scalar fdiv(${$_[0]},$_[1])},
+'neg'	=>	sub {new Math::BigFloat &fneg},
+'abs'	=>	sub {new Math::BigFloat &fabs},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+;
+
+sub new {
+  my ($class) = shift;
+  my ($foo) = fnorm(shift);
+  panic("Not a number initialized to Math::BigFloat") if $foo eq "NaN";
+  bless \$foo, $class;
+}
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+sub stringify {
+    my $n = ${$_[0]};
+
+    $n =~ s/^\+//;
+    $n =~ s/E//;
+
+    $n =~ s/([-+]\d+)$//;
+
+    my $e = $1;
+    my $ln = length($n);
+
+    if ($e > 0) {
+	$n .= "0" x $e . '.';
+    } elsif (abs($e) < $ln) {
+	substr($n, $ln + $e, 0) = '.';
+    } else {
+	$n = '.' . ("0" x (abs($e) - $ln)) . $n;
+    }
+
+    # 1 while $n =~ s/(.*\d)(\d\d\d)/$1,$2/;
+
+    return $n;
+}
+
+$div_scale = 40;
+
+# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
+
+$rnd_mode = 'even';
+
+sub fadd; sub fsub; sub fmul; sub fdiv;
+sub fneg; sub fabs; sub fcmp;
+sub fround; sub ffround;
+sub fnorm; sub fsqrt;
+
+# Convert a number to canonical string form.
+#   Takes something that looks like a number and converts it to
+#   the form /^[+-]\d+E[+-]\d+$/.
+sub fnorm { #(string) return fnum_str
+    local($_) = @_;
+    s/\s+//g;                               # strip white space
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
+	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    } else {
+	'NaN';
+    }
+}
+
+# normalize number -- for internal use
+sub norm { #(mantissa, exponent) return fnum_str
+    local($_, $exp) = @_;
+    if ($_ eq 'NaN') {
+	'NaN';
+    } else {
+	s/^([+-])0+/$1/;                        # strip leading zeros
+	if (length($_) == 1) {
+	    '+0E+0';
+	} else {
+	    $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
+	    sprintf("%sE%+ld", $_, $exp);
+	}
+    }
+}
+
+# negation
+sub fneg { #(fnum_str) return fnum_str
+    local($_) = fnorm($_[$[]);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+    s/^H/N/;
+    $_;
+}
+
+# absolute value
+sub fabs { #(fnum_str) return fnum_str
+    local($_) = fnorm($_[$[]);
+    s/^-/+/;		                       # mash sign
+    $_;
+}
+
+# multiplication
+sub fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	&norm(Math::BigInt::bmul($xm,$ym),$xe+$ye);
+    }
+}
+
+# addition
+sub fadd { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
+	&norm(Math::BigInt::badd($ym,$xm.('0' x ($xe-$ye))),$ye);
+    }
+}
+
+# subtraction
+sub fsub { #(fnum_str, fnum_str) return fnum_str
+    fadd($_[$[],fneg($_[$[+1]));    
+}
+
+# division
+#   args are dividend, divisor, scale (optional)
+#   result has at most max(scale, length(dividend), length(divisor)) digits
+sub fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
+{
+    local($x,$y,$scale) = (fnorm($_[$[]),fnorm($_[$[+1]),$_[$[+2]);
+    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if (length($xm)-1 > $scale);
+	$scale = length($ym)-1 if (length($ym)-1 > $scale);
+	$scale = $scale + length($ym) - length($xm);
+	&norm(&round(Math::BigInt::bdiv($xm.('0' x $scale),$ym),$ym),
+	    $xe-$ye-$scale);
+    }
+}
+
+# round int $q based on fraction $r/$base using $rnd_mode
+sub round { #(int_str, int_str, int_str) return int_str
+    local($q,$r,$base) = @_;
+    if ($q eq 'NaN' || $r eq 'NaN') {
+	'NaN';
+    } elsif ($rnd_mode eq 'trunc') {
+	$q;                         # just truncate
+    } else {
+	local($cmp) = Math::BigInt::bcmp(Math::BigInt::bmul($r,'+2'),$base);
+	if ( $cmp < 0 ||
+		 ($cmp == 0 &&
+		  ( $rnd_mode eq 'zero'                             ||
+		   ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    Math::BigInt::badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
+				    # round up
+	}
+    }
+}
+
+# round the mantissa of $x to $scale digits
+sub fround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN' || $scale <= 0) {
+	$x;
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if (length($xm)-1 <= $scale) {
+	    $x;
+	} else {
+	    &norm(&round(substr($xm,$[,$scale+1),
+			 "+0".substr($xm,$[+$scale+1,1),"+10"),
+		  $xe+length($xm)-$scale-1);
+	}
+    }
+}
+
+# round $x at the 10 to the $scale digit place
+sub ffround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= $scale) {
+	    $x;
+	} else {
+	    $xe = length($xm)+$xe-$scale;
+	    if ($xe < 1) {
+		'+0E+0';
+	    } elsif ($xe == 1) {
+		&norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale);
+	    } else {
+		&norm(&round(substr($xm,$[,$xe),
+		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+    
+# compare 2 values returns one of undef, <0, =0, >0
+#   returns undef if either or both input value are not numbers
+sub fcmp #(fnum_str, fnum_str) return cond_code
+{
+    local($x, $y) = (fnorm($_[$[]),fnorm($_[$[+1]));
+    if ($x eq "NaN" || $y eq "NaN") {
+	undef;
+    } else {
+	ord($y) <=> ord($x)
+	||
+	(  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
+	     (($xe <=> $ye) * (substr($x,$[,1).'1')
+             || Math::BigInt::cmp($xm,$ym))
+	);
+    }
+}
+
+# square root by Newtons method.
+sub fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (fnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN' || $x =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0E+0') {
+	'+0E+0';
+    } else {
+	local($xm, $xe) = split('E',$x);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if ($scale < length($xm)-1);
+	local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
+	while ($gs < 2*$scale) {
+	    $guess = fmul(fadd($guess,fdiv($x,$guess,$gs*2)),".5");
+	    $gs *= 2;
+	}
+	new Math::BigFloat &fround($guess, $scale);
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigFloat - Arbitrary length float math package
+
+=head1 SYNOPSIS
+
+  use Math::BogFloat;
+  $f = Math::BigFloat->new($string);
+
+  $f->fadd(NSTR) return NSTR            addition
+  $f->fsub(NSTR) return NSTR            subtraction
+  $f->fmul(NSTR) return NSTR            multiplication
+  $f->fdiv(NSTR[,SCALE]) returns NSTR   division to SCALE places
+  $f->fneg() return NSTR                negation
+  $f->fabs() return NSTR                absolute value
+  $f->fcmp(NSTR) return CODE            compare undef,<0,=0,>0
+  $f->fround(SCALE) return NSTR         round to SCALE digits
+  $f->ffround(SCALE) return NSTR        round at SCALEth place
+  $f->fnorm() return (NSTR)             normalize
+  $f->fsqrt([SCALE]) return NSTR        sqrt to SCALE places
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+floats as
+
+    $float = new Math::BigFloat "2.123123123123123123123123123123123";
+
+=over 2
+
+=item number format
+
+canonical strings have the form /[+-]\d+E[+-]\d+/ .  Input values can
+have inbedded whitespace.
+
+=item Error returns 'NaN'
+
+An input parameter was "Not a Number" or divide by zero or sqrt of
+negative number.
+
+=item Division is computed to 
+
+C<max($div_scale,length(dividend)+length(divisor))> digits by default.
+Also used for default sqrt scale.
+
+=back
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Math/BigInt.pm b/gnu/usr.bin/perl/lib/Math/BigInt.pm
new file mode 100644
index 00000000000..68856aea6e0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/BigInt.pm
@@ -0,0 +1,386 @@
+package Math::BigInt;
+
+use overload
+'+'	=>	sub {new Math::BigInt &badd},
+'-'	=>	sub {new Math::BigInt
+		       $_[2]? bsub($_[1],${$_[0]}) : bsub(${$_[0]},$_[1])},
+'<=>'	=>	sub {new Math::BigInt
+		       $_[2]? bcmp($_[1],${$_[0]}) : bcmp(${$_[0]},$_[1])},
+'cmp'	=>	sub {new Math::BigInt
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Math::BigInt &bmul},
+'/'	=>	sub {new Math::BigInt 
+		       $_[2]? scalar bdiv($_[1],${$_[0]}) :
+			 scalar bdiv(${$_[0]},$_[1])},
+'%'	=>	sub {new Math::BigInt
+		       $_[2]? bmod($_[1],${$_[0]}) : bmod(${$_[0]},$_[1])},
+'**'	=>	sub {new Math::BigInt
+		       $_[2]? bpow($_[1],${$_[0]}) : bpow(${$_[0]},$_[1])},
+'neg'	=>	sub {new Math::BigInt &bneg},
+'abs'	=>	sub {new Math::BigInt &babs},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+;
+
+$NaNOK=1;
+
+sub new {
+  my($class) = shift;
+  my($foo) = bnorm(shift);
+  die "Not a number initialized to Math::BigInt" if !$NaNOK && $foo eq "NaN";
+  bless \$foo, $class;
+}
+sub stringify { "${$_[0]}" }
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+
+$zero = 0;
+
+
+# normalize string form of number.   Strip leading zeros.  Strip any
+#   white space and add a sign, if missing.
+# Strings that are not numbers result the value 'NaN'.
+
+sub bnorm { #(num_str) return num_str
+    local($_) = @_;
+    s/\s+//g;                           # strip white space
+    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
+	substr($_,$[,0) = '+' unless $1; # Add missing sign
+	s/^-0/+0/;
+	$_;
+    } else {
+	'NaN';
+    }
+}
+
+# Convert a number from string format to internal base 100000 format.
+#   Assumes normalized value as input.
+sub internal { #(num_str) return int_num_array
+    local($d) = @_;
+    ($is,$il) = (substr($d,$[,1),length($d)-2);
+    substr($d,$[,1) = '';
+    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
+}
+
+# Convert a number from internal base 100000 format to string format.
+#   This routine scribbles all over input array.
+sub external { #(int_num_array) return num_str
+    $es = shift;
+    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
+    &bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
+}
+
+# Negate input value.
+sub bneg { #(num_str) return num_str
+    local($_) = &bnorm(@_);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
+    s/^H/N/;
+    $_;
+}
+
+# Returns the absolute value of the input.
+sub babs { #(num_str) return num_str
+    &abs(&bnorm(@_));
+}
+
+sub abs { # post-normalized abs for internal use
+    local($_) = @_;
+    s/^-/+/;
+    $_;
+}
+
+# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
+sub bcmp { #(num_str, num_str) return cond_code
+    local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	undef;
+    } elsif ($y eq 'NaN') {
+	undef;
+    } else {
+	&cmp($x,$y);
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    $cx cmp $cy
+    &&
+    (
+	ord($cy) <=> ord($cx)
+	||
+	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
+    );
+}
+
+sub badd { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);             # convert to internal form
+	@y = &internal($y);
+	local($sx, $sy) = (shift @x, shift @y); # get signs
+	if ($sx eq $sy) {
+	    &external($sx, &add(*x, *y)); # if same sign add
+	} else {
+	    ($x, $y) = (&abs($x),&abs($y)); # make abs
+	    if (&cmp($y,$x) > 0) {
+		&external($sy, &sub(*y, *x));
+	    } else {
+		&external($sx, &sub(*x, *y));
+	    }
+	}
+    }
+}
+
+sub bsub { #(num_str, num_str) return num_str
+    &badd($_[$[],&bneg($_[$[+1]));    
+}
+
+# GCD -- Euclids algorithm Knuth Vol 2 pg 296
+sub bgcd { #(num_str, num_str) return num_str
+    local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	($x, $y) = ($y,&bmod($x,$y)) while $y ne '+0';
+	$x;
+    }
+}
+
+# routine to add two base 1e5 numbers
+#   stolen from Knuth Vol 2 Algorithm A pg 231
+#   there are separate routines to add and sub as per Kunth pg 233
+sub add { #(int_num_array, int_num_array) return int_num_array
+    local(*x, *y) = @_;
+    $car = 0;
+    for $x (@x) {
+	last unless @y || $car;
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+    }
+    (@x, @y, $car);
+}
+
+# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+sub sub { #(int_num_array, int_num_array) return int_num_array
+    local(*sx, *sy) = @_;
+    $bar = 0;
+    for $sx (@sx) {
+	last unless @y || $bar;
+	$sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
+    }
+    @sx;
+}
+
+# multiply two numbers -- stolen from Knuth Vol 2 pg 233
+sub bmul { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	@y = &internal($y);
+	&external(&mul(*x,*y));
+    }
+}
+
+# multiply two numbers in internal representation
+# destroys the arguments, supposes that two arguments are different
+sub mul { #(*int_num_array, *int_num_array) return int_num_array
+    local(*x, *y) = (shift, shift);
+    local($signr) = (shift @x ne shift @y) ? '-' : '+';
+    @prod = ();
+    for $x (@x) {
+      ($car, $cty) = (0, $[);
+      for $y (@y) {
+	$prod = $x * $y + $prod[$cty] + $car;
+	$prod[$cty++] =
+	  $prod - ($car = int($prod * 1e-5)) * 1e5;
+      }
+      $prod[$cty] += $car if $car;
+      $x = shift @prod;
+    }
+    ($signr, @x, @prod);
+}
+
+# modulus
+sub bmod { #(num_str, num_str) return num_str
+    (&bdiv(@_))[$[+1];
+}
+
+sub bdiv { #(dividend: num_str, divisor: num_str) return num_str
+    local (*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    return wantarray ? ('NaN','NaN') : 'NaN'
+	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
+    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
+    @x = &internal($x); @y = &internal($y);
+    $srem = $y[$[];
+    $sr = (shift @x ne shift @y) ? '-' : '+';
+    $car = $bar = $prd = 0;
+    if (($dd = int(1e5/($y[$#y]+1))) != 1) {
+	for $x (@x) {
+	    $x = $x * $dd + $car;
+	    $x -= ($car = int($x * 1e-5)) * 1e5;
+	}
+	push(@x, $car); $car = 0;
+	for $y (@y) {
+	    $y = $y * $dd + $car;
+	    $y -= ($car = int($y * 1e-5)) * 1e5;
+	}
+    }
+    else {
+	push(@x, 0);
+    }
+    @q = (); ($v2,$v1) = @y[-2,-1];
+    while ($#x > $#y) {
+	($u2,$u1,$u0) = @x[-3..-1];
+	$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
+	--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
+	if ($q) {
+	    ($car, $bar) = (0,0);
+	    for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		$prd = $q * $y[$y] + $car;
+		$prd -= ($car = int($prd * 1e-5)) * 1e5;
+		$x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
+	    }
+	    if ($x[$#x] < $car + $bar) {
+		$car = 0; --$q;
+		for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		    $x[$x] -= 1e5
+			if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
+		}
+	    }   
+	}
+	pop(@x); unshift(@q, $q);
+    }
+    if (wantarray) {
+	@d = ();
+	if ($dd != 1) {
+	    $car = 0;
+	    for $x (reverse @x) {
+		$prd = $car * 1e5 + $x;
+		$car = $prd - ($tmp = int($prd / $dd)) * $dd;
+		unshift(@d, $tmp);
+	    }
+	}
+	else {
+	    @d = @x;
+	}
+	(&external($sr, @q), &external($srem, @d, $zero));
+    } else {
+	&external($sr, @q);
+    }
+}
+
+# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
+sub bpow { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } elsif ($x eq '+1') {
+	'+1';
+    } elsif ($x eq '-1') {
+	&bmod($x,2) ? '-1': '+1';
+    } elsif ($y =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0' && $y eq '+0') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	local(@pow2)=@x;
+	local(@pow)=&internal("+1");
+	local($y1,$res,@tmp1,@tmp2)=(1); # need tmp to send to mul
+	while ($y ne '+0') {
+	  ($y,$res)=&bdiv($y,2);
+	  if ($res ne '+0') {@tmp=@pow2; @pow=&mul(*pow,*tmp);}
+	  if ($y ne '+0') {@tmp=@pow2;@pow2=&mul(*pow2,*tmp);}
+	}
+	&external(@pow);
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::BigInt - Arbitrary size integer math package
+
+=head1 SYNOPSIS
+
+  use Math::BigInt;
+  $i = Math::BigInt->new($string);
+
+  $i->bneg return BINT               negation
+  $i->babs return BINT               absolute value
+  $i->bcmp(BINT) return CODE         compare numbers (undef,<0,=0,>0)
+  $i->badd(BINT) return BINT         addition
+  $i->bsub(BINT) return BINT         subtraction
+  $i->bmul(BINT) return BINT         multiplication
+  $i->bdiv(BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+  $i->bmod(BINT) return BINT         modulus
+  $i->bgcd(BINT) return BINT         greatest common divisor
+  $i->bnorm return BINT              normalization
+
+=head1 DESCRIPTION
+
+All basic math operations are overloaded if you declare your big
+integers as
+
+  $i = new Math::BigInt '123 456 789 123 456 789';
+
+
+=over 2
+
+=item Canonical notation
+
+Big integer value are strings of the form C</^[+-]\d+$/> with leading
+zeros suppressed.
+
+=item Input
+
+Input values to these routines may be strings of the form
+C</^\s*[+-]?[\d\s]+$/>.
+
+=item Output
+
+Output values always always in canonical form
+
+=back
+
+Actual math is done in an internal format consisting of an array
+whose first element is the sign (/^[+-]$/) and whose remaining 
+elements are base 100000 digits with the least significant digit first.
+The string 'NaN' is used to represent the result when input arguments 
+are not numbers, as well as the result of dividing by zero.
+
+=head1 EXAMPLES
+
+   '+0'                            canonical zero value
+   '   -123 123 123'               canonical value '-123123123'
+   '1 23 456 7890'                 canonical value '+1234567890'
+
+
+=head1 BUGS
+
+The current version of this module is a preliminary version of the
+real thing that is currently (as of perl5.002) under development.
+
+=head1 AUTHOR
+
+Mark Biggar, overloaded interface by Ilya Zakharevich.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Math/Complex.pm b/gnu/usr.bin/perl/lib/Math/Complex.pm
new file mode 100644
index 00000000000..969f3c2c79e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Math/Complex.pm
@@ -0,0 +1,163 @@
+package Math::Complex;
+
+require Exporter;
+
+@ISA = ('Exporter');
+
+# just to make use happy
+
+use overload
+    '+'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                      bless [ $x1+$x2, $y1+$y2];
+             },
+
+    '-'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                      bless [ $x1-$x2, $y1-$y2];
+             },
+
+    '*'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                    bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1];
+             },
+
+    '/'   => sub  { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]});
+                    my $q = $x2*$x2+$y2*$y2;
+                    bless [($x1*$x2+$y1*$y2)/$q, ($y1*$x2-$y2*$x1)/$q];
+             },
+
+    'neg' => sub  { my($x,$y) = @{$_[0]}; bless [ -$x, -$y];
+             },
+
+    '~'   => sub  { my($x,$y) = @{$_[0]}; bless [ $x, -$y];
+             },
+
+    'abs'   => sub  { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y;
+             },
+
+    'cos' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
+                   my $abr = 1/(2*$ab); $ab /= 2;
+                   bless [ ($abr+$ab)*$c, ($abr-$ab)*$s];
+             },
+
+    'sin' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $y, cos $x, sin $x);
+                   my $abr = 1/(2*$ab); $ab /= 2;
+                   bless [ (-$abr-$ab)*$s, ($abr-$ab)*$c];
+             },
+
+    'exp' => sub { my($x,$y) = @{$_[0]};
+                   my ($ab,$c,$s) = (exp $x, cos $y, sin $y);
+                   bless [ $ab*$c, $ab*$s ];
+              },
+
+    'sqrt' => sub { 
+	my($zr,$zi) = @{$_[0]};
+	my ($x, $y, $r, $w);
+	my $c = new Math::Complex (0,0);
+        if (($zr == 0) && ($zi == 0)) { 
+	    # nothing, $c already set
+	}
+        else {
+	  $x = abs($zr);
+	  $y = abs($zi);
+	  if ($x >= $y) { 
+	      $r = $y/$x; 
+	      $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r))); 
+	  }
+	  else { 
+	      $r = $x/$y; 
+	      $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r))); 
+	  }
+	  if ( $zr >= 0) { 
+	      @$c = ($w, $zi/(2 * $w) ); 
+	  }
+	  else { 
+	      $c->[1] = ($zi >= 0) ? $w : -$w;
+	      $c->[0] = $zi/(2.0* $c->[1]); 
+	  }
+        } 
+        return $c;
+      },
+
+    qw("" stringify)
+;
+
+sub new {
+    my $class = shift;
+    my @C = @_;
+    bless \@C, $class;
+}
+
+sub Re {
+    my($x,$y) = @{$_[0]};
+    $x;
+}
+
+sub Im {
+    my($x,$y) = @{$_[0]};
+    $y;
+}
+
+sub arg {
+    my($x,$y) = @{$_[0]};
+    atan2($y,$x);
+}
+
+sub stringify {
+    my($x,$y) = @{$_[0]};
+    my($re,$im);
+
+    $re = $x if ($x);
+    if ($y == 1) {$im = 'i';}  
+    elsif ($y == -1){$im = '-i';} 
+    elsif ($y) {$im = "${y}i"; }
+
+    local $_ = $re.'+'.$im;
+    s/\+-/-/;
+    s/^\+//;
+    s/[\+-]$//;
+    $_ = 0 if ($_ eq '');
+    return $_;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Math::Complex - complex numbers package
+
+=head1 SYNOPSIS
+
+  use Math::Complex;
+  $i = new Math::Complex;
+
+=head1 DESCRIPTION
+
+Complex numbers declared as
+
+    $i = Math::Complex->new(1,1);
+
+can be manipulated with overloaded math operators. The operators
+
+  + - * / neg ~ abs cos sin exp sqrt
+
+are supported as well as
+
+  "" (stringify)
+
+The methods
+
+  Re Im arg
+
+are also provided.
+
+=head1 BUGS
+
+sqrt() should return two roots, but only returns one.
+
+=head1 AUTHORS
+
+Dave Nadler, Tom Christiansen, Tim Bunce, Larry Wall.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Net/Ping.pm b/gnu/usr.bin/perl/lib/Net/Ping.pm
new file mode 100644
index 00000000000..3ba88d57518
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Net/Ping.pm
@@ -0,0 +1,106 @@
+package Net::Ping;
+
+# Authors: karrer@bernina.ethz.ch (Andreas Karrer)
+#          pmarquess@bfsec.bt.co.uk (Paul Marquess)
+
+require 5.002 ;
+require Exporter;
+
+use strict ;
+use vars qw(@ISA @EXPORT $VERSION $tcp_proto $echo_port) ;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(ping pingecho);
+$VERSION = 1.01;
+
+use Socket 'PF_INET', 'AF_INET', 'SOCK_STREAM';
+use Carp ;
+
+$tcp_proto = (getprotobyname('tcp'))[2];
+$echo_port = (getservbyname('echo', 'tcp'))[2];
+
+sub ping {
+    croak "ping not implemented yet. Use pingecho()";
+}
+
+
+sub pingecho {
+
+    croak "usage: pingecho host [timeout]" 
+        unless @_ == 1 or @_ == 2 ;
+
+    my ($host, $timeout) = @_;
+    my ($saddr, $ip);
+    my ($ret) ;
+    local (*PINGSOCK);
+
+    # check if $host is alive by connecting to its echo port, within $timeout
+    # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found
+
+    $timeout = 5 unless $timeout;
+
+    if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/)
+      { $ip = pack ('C4', split (/\./, $1)) }
+    else
+      { $ip = (gethostbyname($host))[4] }
+
+    return 0 unless $ip;		# "no such host"
+
+    $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip);
+    $SIG{'ALRM'} = sub { die } ;
+    alarm($timeout);
+    
+    $ret = 0;
+    eval <<'EOM' ;
+    return unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ;
+    return unless connect(PINGSOCK, $saddr) ;
+    $ret=1 ;
+EOM
+    alarm(0);
+    close(PINGSOCK);
+    $ret;
+}   
+
+1;
+__END__
+
+=cut
+
+=head1 NAME
+
+Net::Ping, pingecho - check a host for upness
+
+=head1 SYNOPSIS
+
+    use Net::Ping;
+    print "'jimmy' is alive and kicking\n" if pingecho('jimmy', 10) ;
+
+=head1 DESCRIPTION
+
+This module contains routines to test for the reachability of remote hosts.
+Currently the only routine implemented is pingecho(). 
+
+pingecho() uses a TCP echo (I<not> an ICMP one) to determine if the
+remote host is reachable. This is usually adequate to tell that a remote
+host is available to rsh(1), ftp(1), or telnet(1) onto.
+
+=head2 Parameters
+
+=over 5
+
+=item hostname
+
+The remote host to check, specified either as a hostname or as an IP address.
+
+=item timeout
+
+The timeout in seconds. If not specified it will default to 5 seconds.
+
+=back
+
+=head1 WARNING
+
+pingecho() uses alarm to implement the timeout, so don't set another alarm
+while you are using it.
+
+
diff --git a/gnu/usr.bin/perl/lib/Pod/Functions.pm b/gnu/usr.bin/perl/lib/Pod/Functions.pm
new file mode 100644
index 00000000000..a775cf61654
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Pod/Functions.pm
@@ -0,0 +1,295 @@
+package Pod::Functions;
+
+#:vi:set ts=20
+
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(%Kinds %Type %Flavor %Type_Descriptions @Type_Order);
+
+%Type_Description = (
+    'ARRAY'	=> 'Functions for real @ARRAYs',
+    'Binary'	=> 'Functions for fixed length data or records',
+    'File'	=> 'Functions for filehandles, files, or directories',
+    'Flow'	=> 'Keywords related to control flow of your perl program',
+    'HASH'	=> 'Functions for real %HASHes',
+    'I/O'	=> 'Input and output functions',
+    'LIST'	=> 'Functions for list data',
+    'Math'	=> 'Numeric functions',
+    'Misc'	=> 'Miscellaneous functions',
+    'Modules'	=> 'Keywords related to perl modules',
+    'Network'	=> 'Fetching network info',
+    'Objects'	=> 'Keywords related to classes and object-orientedness',
+    'Process'	=> 'Functions for processes and process groups',
+    'Regexp'	=> 'Regular expressions and pattern matching',
+    'Socket'	=> 'Low-level socket functions',
+    'String'	=> 'Functions for SCALARs or strings',
+    'SysV'	=> 'System V interprocess communication functions',
+    'Time'	=> 'Time-related functions',
+    'User'	=> 'Fetching user and group info',
+    'Namespace'	=> 'Keywords altering or affecting scoping of identifiers',
+);
+
+@Type_Order = qw{
+    String
+    Regexp
+    Math
+    ARRAY
+    LIST
+    HASH
+    I/O
+    Binary
+    File
+    Flow
+    Namespace
+    Misc
+    Process
+    Modules
+    Objects
+    Socket
+    SysV
+    User
+    Network
+    Time
+};
+
+while (<DATA>) {
+    chomp;
+    s/#.*//;
+    next unless $_;
+    ($name, $type, $text) = split " ", $_, 3;
+    $Type{$name} = $type;
+    $Flavor{$name} = $text;
+    for $type ( split /[,\s]+/, $type ) {
+	push @{$Kinds{$type}}, $name;
+    }
+} 
+
+unless (caller) { 
+    foreach $type ( @Type_Order ) {
+	$list = join(", ", sort @{$Kinds{$type}});
+	$typedesc = $Type_Description{$type} . ":";
+	write;
+    } 
+}
+
+format = 
+
+^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+    $typedesc 
+~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+    $typedesc 
+ ~~  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+	$list
+.
+
+1
+
+__DATA__
+-X	File	a file test (-r, -x, etc)
+abs	Math	absolute value function
+accept	Socket	accept an incoming socket connect
+alarm	Process	schedule a SIGALRM 
+atan2	Math	arctangent of Y/X 
+bind	Socket	binds an address to a socket
+binmode	I/O	prepare binary files on old systems
+bless	Objects	create an object 
+caller	Flow,Namespace	get context of the current subroutine call
+chdir	File	change your current working directory
+chmod	File	changes the permissions on a list of files
+chomp	String 	remove a trailing record separator from a string
+chop	String 	remove the last character from a string
+chown	File	change the owership on a list of files
+chr	String 	get character this number represents
+chroot	File	make directory new root for path lookups
+close	I/O	close file (or pipe or socket) handle
+closedir	I/O	close directory handle
+connect	Socket	connect to a remove socket
+continue	Flow	optional trailing block in a while or foreach 
+cos	Math	cosine function
+crypt	String	one-way passwd-style encryption
+dbmclose	Objects,I/O	breaks binding on a tied dbm file
+dbmopen	Objects,I/O	create binding on a tied dbm file
+defined	Misc	test whether a value, variable, or function is defined
+delete	HASH	deletes a value from a hash
+die	I/O,Flow	raise an exception or bail out
+do	Flow,Modules	turn a BLOCK into a TERM
+dump	Misc,Flow	create an immediate core dump
+each	HASH	retrieve the next key/value pair from a hash
+endgrent	User	be done using group file
+endhostent	User	be done using hosts file
+endnetent	User	be done using networks file
+endprotoent	Network	be done using protocols file
+endpwent	User	be done using passwd file
+endservent	Network	be done using services file
+eof	I/O	test a filehandle for its end
+eval	Flow,Misc	catch exceptions or compile code
+exec	Process	abandon this program to run another
+exists	HASH	test whether a hash key is present
+exit	Flow	terminate this program
+exp	Math	raise I<e> to a power
+fcntl	File	file control system all
+fileno	I/O	return file descriptor from filehandle
+flock	I/O	lock an entire file with an advisory lock
+fork	Process	create a new process just like this one
+format	I/O	declare a picture format with use by the write() function
+formline	Misc	internal function used for formats
+getc	I/O	get	the next character from the filehandle
+getgrent	User	get next group record 
+getgrgid	User	get group record given group user ID
+getgrnam	User	get group record given group name
+gethostbyaddr	Network	get host record given its address
+gethostbyname	Network	get host record given name
+gethostent	Network	get next hosts record 
+getlogin	User	return who logged in at this tty
+getnetbyaddr	Network	get network record given its address
+getnetbyname	Network	get networks record given name
+getnetent	Network	get next networks record 
+getpeername	Socket	find the other hend of a socket connection
+getpgrp	Process	get process group
+getppid	Process	get parent process ID
+getpriority	Process	get current nice value
+getprotobyname	Network	get protocol record given name
+getprotobynumber	Network	get protocol record numeric protocol
+getprotoent	Network	get next protocols record
+getpwent	User	get next passwd record
+getpwnam	User	get passwd record given user login name
+getpwuid	User	get passwd record given user ID
+getservbyname	Network	get services record given its name
+getservbyport	Network	get services record given numeric port
+getservent	Network	get next services record 
+getsockname	Socket	retrieve the sockaddr for a given socket
+getsockopt	Socket	get socket options on a given socket
+glob	File		expand filenames using wildcards
+gmtime	Time	convert UNIX time into record or string using Greenwich time
+goto	Flow	create spaghetti code
+grep	LIST	locate elements in a list test true against a given criterion
+hex	Math,String	convert a string to a hexadecimal number
+import	Modules,Namespace	patch a module's namespace into your own
+index	String	find a substring within a string
+int	Math	get the integer portion of a number
+ioctl	File	system-dependent device control system call
+join	LIST	join a list into a string using a separator
+keys	HASH	retrieve list of indices from a hash
+kill	Process	send a signal to a process or process group
+last	Flow	exit a block prematurely
+lc	String	return lower-case version of a string
+lcfirst	String	return a string with just the next letter in lower case
+length	String	return the number of bytes in a string
+link	File	create a hard link in the filesytem
+listen	Socket	register your socket as a server 
+local	Misc,Namespace	create a temporary value for a global variable (dynamic scoping)
+localtime	Time	convert UNIX time into record or string using local time
+log	Math	retrieve the natural logarithm for a number
+lstat	File	stat a symbolic link
+m//	Regexp	match a string with a regular expression pattern
+map	LIST	apply a change to a list to get back a new list with the changes
+mkdir	File	create a directory
+msgctl	SysV	SysV IPC message control operations
+msgget	SysV	get SysV IPC message queue
+msgrcv	SysV	receive a SysV IPC message from a message queue
+msgsnd	SysV	send a SysV IPC message to a message queue
+my	Misc,Namespace	declare and assign a local variable (lexical scoping)
+next	Flow	iterate a block prematurely
+no	Modules	unimport some module symbols or semantics at compile time
+package	Modules,Objects,Namespace	declare a separate global namespace
+oct	String,Math	convert a string to an octal number
+open	File	open a file, pipe, or descriptor
+opendir	File	open a directory
+ord	String	find a character's numeric representation
+pack	Binary,String	convert a list into a binary representation
+pipe	Process	open a pair of connected filehandles
+pop	ARRAY	remove the last element from an array and return it
+pos	Regexp	find or set the offset for the last/next m//g search
+print	I/O	output a list to a filehandle
+printf	I/O  	output a formatted list to a filehandle
+push	ARRAY	append one or more elements to an array
+q/STRING/	String	singly quote a string
+qq/STRING/	String	doubly quote a string
+quotemeta	Regexp	quote regular expression magic characters
+qw/STRING/	LIST	quote a list of words
+qx/STRING/	Process	backquote quote a string
+rand	Math	retrieve the next pseudorandom number 
+read	I/O,Binary	fixed-length buffered input from a filehandle
+readdir	I/O	get a directory from a directory handle
+readlink	File	determine where a symbolic link is pointing
+recv	Socket	receive a message over a Socket
+redo	Flow	start this loop iteration over again
+ref	Objects	find out the type of thing being referenced
+rename	File	change a filename
+require	Modules	load in external functions from a library at runtime
+reset	Misc	clear all variables of a given name
+return	Flow	get out of a function early
+reverse	String,LIST	flip a string or a list
+rewinddir	I/O	reset directory handle
+rindex	String	right-to-left substring search
+rmdir	File	remove a directory
+s///	Regexp	replace a pattern with a string
+scalar	Misc	force a scalar context
+seek	I/O	reposition file pointer for random-access I/O
+seekdir	I/O	reposition directory pointer 
+select	I/O	reset default output or do I/O multiplexing
+semctl	SysV	SysV semaphore control operations
+semget	SysV	get set of SysV semaphores
+semop	SysV	SysV semaphore operations
+send	Socket	send a message over a socket
+setgrent	User	prepare group file for use
+sethostent	Network	prepare hosts file for use
+setnetent	Network	prepare networks file for use
+setpgrp	Process	set the process group of a process
+setpriority	Process	set a process's nice value
+setprotoent	Network	prepare protocols file for use
+setpwent	User	prepare passwd file for use
+setservent	Network	prepare services file for use
+setsockopt	Socket	set some socket options
+shift	ARRAY	remove the first element of an array, and return it
+shmctl	SysV	SysV shared memory operations
+shmget	SysV	get SysV shared memory segment identifier
+shmread	SysV	read SysV shared memory 
+shmwrite	SysV	write SysV shared memory 
+shutdown	Socket	close down just half of a socket connection
+sin	Math	return the sin of a number
+sleep	Process	block for some number of seconds
+socket	Socket	create a socket
+socketpair	Socket	create a pair of sockets
+sort	LIST	sort a list of values 
+splice	ARRAY	add or remove elements anywhere in an array
+split	Regexp	split up a string using a regexp delimiter
+sprintf	String	formatted print into a string	
+sqrt	Math	square root function
+srand	Math	seed the random number generator
+stat	File	get a file's status information
+study	Regexp	optimize input data for repeated searches
+sub	Flow	declare a subroutine, possibly anonymously
+substr	String	get or alter a portion of a stirng
+symlink	File	create a symbolic link to a file
+syscall	I/O,Binary	execute an arbitrary system call
+sysread	I/O,Binary	fixed-length unbuffered input from a filehandle
+system	Process	run a separate program 
+syswrite	I/O,Binary	fixed-length unbuffered output to a filehandle
+tell	I/O	get current seekpointer on a filehandle
+telldir	I/O	get current seekpointer on a directory handle
+tie	Objects	bind a variable to an object class 
+time	Time	return number of seconds since 1970
+times	Process,Time	return elapsed time for self and child processes
+tr///	String	transliterate a string
+truncate	I/O	shorten a file
+uc	String	return upper-case version of a string
+ucfirst	String	return a string with just the next letter in upper case
+umask	File	set file creation mode mask
+undef	Misc	remove a variable or function definition
+unlink	File	remove one link to a file
+unpack	Binary,LIST	convert binary structure into normal perl variables
+unshift	ARRAY	prepend more elements to the beginning of a list
+untie	Objects	break a tie binding to a variable
+use	Modules,Namespace	load a module and import its namespace
+use 	Objects	load in a module at compile time
+utime	File	set a file's last access and modify times
+values	HASH	return a list of the values in a hash
+vec	Binary	test or set particular bits in a string
+wait	Process	wait for any child process to die
+waitpid	Process	wait for  a particular child process to die
+wantarray	Misc,Flow	get list vs array context of current subroutine call
+warn	I/O	print debugging info
+write	I/O	print a picture record
+y///	String	transliterate a string
diff --git a/gnu/usr.bin/perl/lib/Pod/Text.pm b/gnu/usr.bin/perl/lib/Pod/Text.pm
new file mode 100644
index 00000000000..ac4f72b688b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Pod/Text.pm
@@ -0,0 +1,483 @@
+package Pod::Text;
+
+# Version 1.01
+
+=head1 NAME
+
+Pod::Text - convert POD data to formatted ASCII text
+
+=head1 SYNOPSIS
+
+	use Pod::Text;
+
+	pod2text("perlfunc.pod");
+
+Also:
+
+	pod2text < input.pod
+
+=head1 DESCRIPTION
+
+Pod::Text is a module that can convert documentation in the POD format (such
+as can be found throughout the Perl distribution) into formatted ASCII.
+Termcap is optionally supported for boldface/underline, and can enabled via
+C<$Pod::Text::termcap=1>. If termcap has not been enabled, then backspaces
+will be used to simulate bold and underlined text.
+
+A separate F<pod2text> program is included that is primarily a wrapper for
+Pod::Text.
+
+The single function C<pod2text()> can take one or two arguments. The first
+should be the name of a file to read the pod from, or "<&STDIN" to read from
+STDIN. A second argument, if provided, should be a filehandle glob where
+output should be sent.
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=head1 TODO
+
+Cleanup work. The input and output locations need to be more flexible,
+termcap shouldn't be a global variable, and the terminal speed needs to
+be properly calculated.
+
+=cut
+
+use Term::Cap;
+require Exporter;
+@ISA = Exporter;
+@EXPORT = qw(pod2text);
+
+$termcap=0;
+
+#$use_format=1;
+
+$UNDL = "\x1b[4m";
+$INV = "\x1b[7m";
+$BOLD = "\x1b[1m";
+$NORM = "\x1b[0m";
+
+sub pod2text {
+local($file,*OUTPUT) = @_;
+*OUTPUT = *STDOUT if @_<2;
+
+if($termcap and !$setuptermcap) {
+	$setuptermcap=1;
+
+    my($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
+    $UNDL = $term->{'_us'};
+    $INV = $term->{'_mr'};
+    $BOLD = $term->{'_md'};
+    $NORM = $term->{'_me'};
+}
+
+$SCREEN = ($_[0] =~ /^-(\d+)/ && (shift, $1))
+       || ($ENV{TERMCAP} =~ /co#(\d+)/)[0]
+       ||  $ENV{COLUMNS}
+       || (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]
+       || 72;
+
+$/ = "";
+
+$FANCY = 0;
+
+$cutting = 1;
+$DEF_INDENT = 4;
+$indent = $DEF_INDENT;
+$needspace = 0;
+
+open(IN, $file) || die "Couldn't open $file: $!";
+
+POD_DIRECTIVE: while (<IN>) {
+    if ($cutting) {
+	next unless /^=/;
+	$cutting = 0;
+    }
+    1 while s{^(.*?)(\t+)(.*)$}{
+	$1
+	. (' ' x (length($2) * 8 - length($1) % 8))
+	. $3
+    }me;
+    # Translate verbatim paragraph
+    if (/^\s/) {
+	$needspace = 1;
+	output($_);
+	next;
+    }
+
+sub prepare_for_output {
+
+    s/\s*$/\n/;
+    &init_noremap;
+
+    # need to hide E<> first; they're processed in clear_noremap
+    s/(E<[^<>]+>)/noremap($1)/ge;
+    $maxnest = 10;
+    while ($maxnest-- && /[A-Z]</) {
+	unless ($FANCY) {
+	    s/C<(.*?)>/`$1'/g;
+	} else {
+	    s/C<(.*?)>/noremap("E<lchevron>${1}E<rchevron>")/ge;
+	}
+        # s/[IF]<(.*?)>/italic($1)/ge;
+        s/I<(.*?)>/*$1*/g;
+        # s/[CB]<(.*?)>/bold($1)/ge;
+	s/X<.*?>//g;
+	# LREF: a manpage(3f)
+	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the $1$2 manpage:g;
+	# LREF: an =item on another manpage
+	s{
+	    L<
+		([^/]+)
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	} {the "$2" entry in the $1 manpage}gx;
+
+	# LREF: an =item on this manpage
+	s{
+	   ((?:
+	    L<
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	    (,?\s+(and\s+)?)?
+	  )+)
+	} { internal_lrefs($1) }gex;
+
+	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
+	# the "func" can disambiguate
+	s{
+	    L<
+		(?:
+		    ([a-zA-Z]\S+?) / 
+		)?
+		"?(.*?)"?
+	    >
+	}{
+	    do {
+		$1 	# if no $1, assume it means on this page.
+		    ?  "the section on \"$2\" in the $1 manpage"
+		    :  "the section on \"$2\""
+	    }
+	}gex;
+
+        s/[A-Z]<(.*?)>/$1/g;
+    }
+    clear_noremap(1);
+}
+
+    &prepare_for_output;
+
+    if (s/^=//) {
+	# $needspace = 0;		# Assume this.
+	# s/\n/ /g;
+	($Cmd, $_) = split(' ', $_, 2);
+	# clear_noremap(1);
+	if ($Cmd eq 'cut') {
+	    $cutting = 1;
+	}
+	elsif ($Cmd eq 'head1') {
+	    makespace();
+	    print OUTPUT;
+	    # print OUTPUT uc($_);
+	}
+	elsif ($Cmd eq 'head2') {
+	    makespace();
+	    # s/(\w+)/\u\L$1/g;
+	    #print ' ' x $DEF_INDENT, $_;
+	    # print "\xA7";
+	    s/(\w)/\xA7 $1/ if $FANCY;
+	    print OUTPUT ' ' x ($DEF_INDENT/2), $_, "\n";
+	}
+	elsif ($Cmd eq 'over') {
+	    push(@indent,$indent);
+	    $indent += ($_ + 0) || $DEF_INDENT;
+	}
+	elsif ($Cmd eq 'back') {
+	    $indent = pop(@indent);
+	    warn "Unmatched =back\n" unless defined $indent;
+	    $needspace = 1;
+	}
+	elsif ($Cmd eq 'item') {
+	    makespace();
+	    # s/\A(\s*)\*/$1\xb7/ if $FANCY;
+	    # s/^(\s*\*\s+)/$1 /;
+	    {
+		if (length() + 3 < $indent) {
+		    my $paratag = $_;
+		    $_ = <IN>;
+		    if (/^=/) {  # tricked!
+			local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+			output($paratag);
+			redo POD_DIRECTIVE;
+		    }
+		    &prepare_for_output;
+		    IP_output($paratag, $_);
+		} else {
+		    local($indent) = $indent[$#index - 1] || $DEF_INDENT;
+		    output($_);
+		}
+	    }
+	}
+	else {
+	    warn "Unrecognized directive: $Cmd\n";
+	}
+    }
+    else {
+	# clear_noremap(1);
+	makespace();
+	output($_, 1);
+    }
+}
+
+close(IN);
+
+}
+
+#########################################################################
+
+sub makespace {
+    if ($needspace) {
+	print OUTPUT "\n";
+	$needspace = 0;
+    }
+}
+
+sub bold {
+    my $line = shift;
+    return $line if $use_format;
+    if($termcap) {
+    	$line = "$BOLD$line$NORM";
+    } else {
+	    $line =~ s/(.)/$1\b$1/g;
+	}
+#    $line = "$BOLD$line$NORM" if $ansify;
+    return $line;
+}
+
+sub italic {
+    my $line = shift;
+    return $line if $use_format;
+    if($termcap) {
+    	$line = "$UNDL$line$NORM";
+    } else {
+	    $line =~ s/(.)/$1\b_/g;
+    }
+#    $line = "$UNDL$line$NORM" if $ansify;
+    return $line;
+}
+
+# Fill a paragraph including underlined and overstricken chars.
+# It's not perfect for words longer than the margin, and it's probably
+# slow, but it works.
+sub fill {
+    local $_ = shift;
+    my $par = "";
+    my $indent_space = " " x $indent;
+    my $marg = $SCREEN-$indent;
+    my $line = $indent_space;
+    my $line_length;
+    foreach (split) {
+	my $word_length = length;
+	$word_length -= 2 while /\010/g;  # Subtract backspaces
+
+	if ($line_length + $word_length > $marg) {
+	    $par .= $line . "\n";
+	    $line= $indent_space . $_;
+	    $line_length = $word_length;
+	}
+	else {
+	    if ($line_length) {
+		$line_length++;
+		$line .= " ";
+	    }
+	    $line_length += $word_length;
+	    $line .= $_;
+	}
+    }
+    $par .= "$line\n" if $line;
+    $par .= "\n";
+    return $par;
+}
+
+sub IP_output {
+    local($tag, $_) = @_;
+    local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT;
+    $tag_cols = $SCREEN - $tag_indent;
+    $cols = $SCREEN - $indent;
+    $tag =~ s/\s*$//;
+    s/\s+/ /g;
+    s/^ //;
+    $str = "format OUTPUT = \n"
+	. (" " x ($tag_indent))
+	. '@' . ('<' x ($indent - $tag_indent - 1))
+	. "^" .  ("<" x ($cols - 1)) . "\n"
+	. '$tag, $_'
+	. "\n~~"
+	. (" " x ($indent-2))
+	. "^" .  ("<" x ($cols - 5)) . "\n"
+	. '$_' . "\n\n.\n1";
+    #warn $str; warn "tag is $tag, _ is $_";
+    eval $str || die;
+    write OUTPUT;
+}
+
+sub output {
+    local($_, $reformat) = @_;
+    if ($reformat) {
+	$cols = $SCREEN - $indent;
+	s/\s+/ /g;
+	s/^ //;
+	$str = "format OUTPUT = \n~~"
+	    . (" " x ($indent-2))
+	    . "^" .  ("<" x ($cols - 5)) . "\n"
+	    . '$_' . "\n\n.\n1";
+	eval $str || die;
+	write OUTPUT;
+    } else {
+	s/^/' ' x $indent/gem;
+	s/^\s+\n$/\n/gm;
+	print OUTPUT;
+    }
+}
+
+sub noremap {
+    local($thing_to_hide) = shift;
+    $thing_to_hide =~ tr/\000-\177/\200-\377/;
+    return $thing_to_hide;
+}
+
+sub init_noremap {
+    die "unmatched init" if $mapready++;
+    if ( /[\200-\377]/ ) {
+	warn "hit bit char in input stream";
+    }
+}
+
+sub clear_noremap {
+    my $ready_to_print = $_[0];
+    die "unmatched clear" unless $mapready--;
+    tr/\200-\377/\000-\177/;
+    # now for the E<>s, which have been hidden until now
+    # otherwise the interative \w<> processing would have
+    # been hosed by the E<gt>
+    s {
+	    E<	
+	    ( [A-Za-z]+ )	
+	    >	
+    } {
+	 do {
+	     defined $HTML_Escapes{$1}
+		? do { $HTML_Escapes{$1} }
+		: do {
+		    warn "Unknown escape: $& in $_";
+		    "E<$1>";
+		}
+	 }
+    }egx if $ready_to_print;
+}
+
+sub internal_lrefs {
+    local($_) = shift;
+    s{L</([^>]+)>}{$1}g;
+    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
+    my $retstr = "the ";
+    my $i;
+    for ($i = 0; $i <= $#items; $i++) {
+	$retstr .= "C<$items[$i]>";
+	$retstr .= ", " if @items > 2 && $i != $#items;
+	$retstr .= " and " if $i+2 == @items;
+    }
+
+    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
+	    .  " elsewhere in this document ";
+
+    return $retstr;
+
+}
+
+BEGIN {
+
+%HTML_Escapes = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1",	#   capital A, acute accent
+    "aacute"	=>	"\xE1",	#   small a, acute accent
+    "Acirc"	=>	"\xC2",	#   capital A, circumflex accent
+    "acirc"	=>	"\xE2",	#   small a, circumflex accent
+    "AElig"	=>	"\xC6",	#   capital AE diphthong (ligature)
+    "aelig"	=>	"\xE6",	#   small ae diphthong (ligature)
+    "Agrave"	=>	"\xC0",	#   capital A, grave accent
+    "agrave"	=>	"\xE0",	#   small a, grave accent
+    "Aring"	=>	"\xC5",	#   capital A, ring
+    "aring"	=>	"\xE5",	#   small a, ring
+    "Atilde"	=>	"\xC3",	#   capital A, tilde
+    "atilde"	=>	"\xE3",	#   small a, tilde
+    "Auml"	=>	"\xC4",	#   capital A, dieresis or umlaut mark
+    "auml"	=>	"\xE4",	#   small a, dieresis or umlaut mark
+    "Ccedil"	=>	"\xC7",	#   capital C, cedilla
+    "ccedil"	=>	"\xE7",	#   small c, cedilla
+    "Eacute"	=>	"\xC9",	#   capital E, acute accent
+    "eacute"	=>	"\xE9",	#   small e, acute accent
+    "Ecirc"	=>	"\xCA",	#   capital E, circumflex accent
+    "ecirc"	=>	"\xEA",	#   small e, circumflex accent
+    "Egrave"	=>	"\xC8",	#   capital E, grave accent
+    "egrave"	=>	"\xE8",	#   small e, grave accent
+    "ETH"	=>	"\xD0",	#   capital Eth, Icelandic
+    "eth"	=>	"\xF0",	#   small eth, Icelandic
+    "Euml"	=>	"\xCB",	#   capital E, dieresis or umlaut mark
+    "euml"	=>	"\xEB",	#   small e, dieresis or umlaut mark
+    "Iacute"	=>	"\xCD",	#   capital I, acute accent
+    "iacute"	=>	"\xED",	#   small i, acute accent
+    "Icirc"	=>	"\xCE",	#   capital I, circumflex accent
+    "icirc"	=>	"\xEE",	#   small i, circumflex accent
+    "Igrave"	=>	"\xCD",	#   capital I, grave accent
+    "igrave"	=>	"\xED",	#   small i, grave accent
+    "Iuml"	=>	"\xCF",	#   capital I, dieresis or umlaut mark
+    "iuml"	=>	"\xEF",	#   small i, dieresis or umlaut mark
+    "Ntilde"	=>	"\xD1",		#   capital N, tilde
+    "ntilde"	=>	"\xF1",		#   small n, tilde
+    "Oacute"	=>	"\xD3",	#   capital O, acute accent
+    "oacute"	=>	"\xF3",	#   small o, acute accent
+    "Ocirc"	=>	"\xD4",	#   capital O, circumflex accent
+    "ocirc"	=>	"\xF4",	#   small o, circumflex accent
+    "Ograve"	=>	"\xD2",	#   capital O, grave accent
+    "ograve"	=>	"\xF2",	#   small o, grave accent
+    "Oslash"	=>	"\xD8",	#   capital O, slash
+    "oslash"	=>	"\xF8",	#   small o, slash
+    "Otilde"	=>	"\xD5",	#   capital O, tilde
+    "otilde"	=>	"\xF5",	#   small o, tilde
+    "Ouml"	=>	"\xD6",	#   capital O, dieresis or umlaut mark
+    "ouml"	=>	"\xF6",	#   small o, dieresis or umlaut mark
+    "szlig"	=>	"\xDF",		#   small sharp s, German (sz ligature)
+    "THORN"	=>	"\xDE",	#   capital THORN, Icelandic
+    "thorn"	=>	"\xFE",	#   small thorn, Icelandic
+    "Uacute"	=>	"\xDA",	#   capital U, acute accent
+    "uacute"	=>	"\xFA",	#   small u, acute accent
+    "Ucirc"	=>	"\xDB",	#   capital U, circumflex accent
+    "ucirc"	=>	"\xFB",	#   small u, circumflex accent
+    "Ugrave"	=>	"\xD9",	#   capital U, grave accent
+    "ugrave"	=>	"\xF9",	#   small u, grave accent
+    "Uuml"	=>	"\xDC",	#   capital U, dieresis or umlaut mark
+    "uuml"	=>	"\xFC",	#   small u, dieresis or umlaut mark
+    "Yacute"	=>	"\xDD",	#   capital Y, acute accent
+    "yacute"	=>	"\xFD",	#   small y, acute accent
+    "yuml"	=>	"\xFF",	#   small y, dieresis or umlaut mark
+
+    "lchevron"	=>	"\xAB",	#   left chevron (double less than)
+    "rchevron"	=>	"\xBB",	#   right chevron (double greater than)
+);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Search/Dict.pm b/gnu/usr.bin/perl/lib/Search/Dict.pm
new file mode 100644
index 00000000000..295da6b31d2
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Search/Dict.pm
@@ -0,0 +1,75 @@
+package Search::Dict;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(look);
+
+=head1 NAME
+
+Search::Dict, look - search for key in dictionary file
+
+=head1 SYNOPSIS
+
+    use Search::Dict;
+    look *FILEHANDLE, $key, $dict, $fold;
+
+=head1 DESCRIPTION
+
+Sets file position in FILEHANDLE to be first line greater than or equal
+(stringwise) to I<$key>.  Returns the new file position, or -1 if an error
+occurs.
+
+The flags specify dictionary order and case folding:
+
+If I<$dict> is true, search by dictionary order (ignore anything but word
+characters and whitespace).
+
+If I<$fold> is true, ignore case.
+
+=cut
+
+sub look {
+    local(*FH,$key,$dict,$fold) = @_;
+    local($_);
+    my(@stat) = stat(FH)
+	or return -1;
+    my($size, $blksize) = @stat[7,11];
+    $blksize ||= 8192;
+    $key =~ s/[^\w\s]//g if $dict;
+    $key =~ tr/A-Z/a-z/ if $fold;
+    my($min, $max, $mid) = (0, int($size / $blksize));
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH, $mid * $blksize, 0)
+	    or return -1;
+	<FH> if $mid;			# probably a partial line
+	$_ = <FH>;
+	chop;
+	s/[^\w\s]//g if $dict;
+	tr/A-Z/a-z/ if $fold;
+	if (defined($_) && $_ lt $key) {
+	    $min = $mid;
+	}
+	else {
+	    $max = $mid;
+	}
+    }
+    $min *= $blksize;
+    seek(FH,$min,0)
+	or return -1;
+    <FH> if $min;
+    for (;;) {
+	$min = tell(FH);
+	$_ = <FH>
+	    or last;
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	last if $_ ge $key;
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/SelectSaver.pm b/gnu/usr.bin/perl/lib/SelectSaver.pm
new file mode 100644
index 00000000000..4c764bedcf1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/SelectSaver.pm
@@ -0,0 +1,50 @@
+package SelectSaver;
+
+=head1 NAME
+
+SelectSaver - save and restore selected file handle
+
+=head1 SYNOPSIS
+
+    use SelectSaver;
+
+    {
+       my $saver = new SelectSaver(FILEHANDLE);
+       # FILEHANDLE is selected
+    }
+    # previous handle is selected
+
+    {
+       my $saver = new SelectSaver;
+       # new handle may be selected, or not
+    }
+    # previous handle is selected
+
+=head1 DESCRIPTION
+
+A C<SelectSaver> object contains a reference to the file handle that
+was selected when it was created.  If its C<new> method gets an extra
+parameter, then that parameter is selected; otherwise, the selected
+file handle remains unchanged.
+
+When a C<SelectSaver> is destroyed, it re-selects the file handle
+that was selected when it was created.
+
+=cut
+
+require 5.000;
+use Carp;
+use Symbol;
+
+sub new {
+    @_ >= 1 && @_ <= 2 or croak 'usage: new SelectSaver [FILEHANDLE]';
+    my $fh = (@_ > 1) ? (select qualify($_[1], caller)) : select;
+    bless [$fh], $_[0];
+}
+
+sub DESTROY {
+    my $this = $_[0];
+    select $$this[0];
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/SelfLoader.pm b/gnu/usr.bin/perl/lib/SelfLoader.pm
new file mode 100644
index 00000000000..e3da9ebadbc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/SelfLoader.pm
@@ -0,0 +1,285 @@
+package SelfLoader;
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(AUTOLOAD);
+$VERSION = 1.06; sub Version {$VERSION}
+$DEBUG = 0;
+
+my %Cache;      # private cache for all SelfLoader's client packages
+
+AUTOLOAD {
+    print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG;
+    my $code = $Cache{$AUTOLOAD};
+    unless ($code) {
+        # Maybe this pack had stubs before __DATA__, and never initialized.
+        # Or, this maybe an automatic DESTROY method call when none exists.
+        $AUTOLOAD =~ m/^(.*)::/;
+        SelfLoader->_load_stubs($1) unless exists $Cache{"${1}::<DATA"};
+        $code = $Cache{$AUTOLOAD};
+        $code = "sub $AUTOLOAD { }" if (!$code and $AUTOLOAD =~ m/::DESTROY$/);
+        croak "Undefined subroutine $AUTOLOAD" unless $code;
+    }
+    print STDERR "SelfLoader::AUTOLOAD eval: $code\n" if $DEBUG;
+    eval $code;
+    if ($@) {
+        $@ =~ s/ at .*\n//;
+        croak $@;
+    }
+    defined(&$AUTOLOAD) || die "SelfLoader inconsistency error";
+    delete $Cache{$AUTOLOAD};
+    goto &$AUTOLOAD
+}
+
+sub load_stubs { shift->_load_stubs((caller)[0]) }
+
+sub _load_stubs {
+    my($self, $callpack) = @_;
+    my $fh = \*{"${callpack}::DATA"};
+    my $currpack = $callpack;
+    my($line,$name,@lines, @stubs, $protoype);
+
+    print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG;
+    croak("$callpack doesn't contain an __DATA__ token")
+        unless fileno($fh);
+    $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+
+    while($line = <$fh> and $line !~ m/^__END__/) {
+        if ($line =~ m/^sub\s+([\w:]+)\s*(\([\$\@\;\%\\]*\))?/) {       # A sub declared
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $protoype = $2;
+            @lines = ($line);
+            if (index($1,'::') == -1) {         # simple sub name
+                $name = "${currpack}::$1";
+            } else {                            # sub name with package
+                $name = $1;
+                $name =~ m/^(.*)::/;
+                if (defined(&{"${1}::AUTOLOAD"})) {
+                    \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                        die 'SelfLoader Error: attempt to specify Selfloading',
+                            " sub $name in non-selfloading module $1";
+                } else {
+                    $self->export($1,'AUTOLOAD');
+                }
+            }
+        } elsif ($line =~ m/^package\s+([\w:]+)/) { # A package declared
+            push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+            $self->_package_defined($line);
+            $name = '';
+            @lines = ();
+            $currpack = $1;
+            $Cache{"${currpack}::<DATA"} = 1;   # indicate package is cached
+            if (defined(&{"${1}::AUTOLOAD"})) {
+                \&{"${1}::AUTOLOAD"} == \&SelfLoader::AUTOLOAD ||
+                    die 'SelfLoader Error: attempt to specify Selfloading',
+                        " package $currpack which already has AUTOLOAD";
+            } else {
+                $self->export($currpack,'AUTOLOAD');
+            }
+        } else {
+            push(@lines,$line);
+        }
+    }
+    close($fh) unless defined($line) && $line =~ /^__END__\s*DATA/;     # __END__
+    push(@stubs, $self->_add_to_cache($name, $currpack, \@lines, $protoype));
+    eval join('', @stubs) if @stubs;
+}
+
+
+sub _add_to_cache {
+    my($self,$fullname,$pack,$lines, $protoype) = @_;
+    return () unless $fullname;
+    carp("Redefining sub $fullname") if exists $Cache{$fullname};
+    $Cache{$fullname} = join('', "package $pack; ",@$lines);
+    print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG;
+    # return stub to be eval'd
+    defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;"
+}
+
+sub _package_defined {}
+
+1;
+__END__
+
+=head1 NAME
+
+SelfLoader - load functions only on demand
+
+=head1 SYNOPSIS
+
+    package FOOBAR;
+    use SelfLoader;
+    
+    ... (initializing code)
+    
+    __DATA__
+    sub {....
+
+
+=head1 DESCRIPTION
+
+This module tells its users that functions in the FOOBAR package are to be
+autoloaded from after the __DATA__ token.  See also L<perlsub/"Autoloading">.
+
+=head2 The __DATA__ token
+
+The __DATA__ token tells the perl compiler that the perl code
+for compilation is finished. Everything after the __DATA__ token
+is available for reading via the filehandle FOOBAR::DATA,
+where FOOBAR is the name of the current package when the __DATA__
+token is reached. This works just the same as __END__ does in
+package 'main', but for other modules data after __END__ is not
+automatically retreivable , whereas data after __DATA__ is.
+The __DATA__ token is not recognized in versions of perl prior to
+5.001m.
+
+Note that it is possible to have __DATA__ tokens in the same package
+in multiple files, and that the last __DATA__ token in a given
+package that is encountered by the compiler is the one accessible
+by the filehandle. This also applies to __END__ and main, i.e. if
+the 'main' program has an __END__, but a module 'require'd (_not_ 'use'd)
+by that program has a 'package main;' declaration followed by an '__DATA__',
+then the DATA filehandle is set to access the data after the __DATA__
+in the module, _not_ the data after the __END__ token in the 'main'
+program, since the compiler encounters the 'require'd file later.
+
+=head2 SelfLoader autoloading
+
+The SelfLoader works by the user placing the __DATA__
+token _after_ perl code which needs to be compiled and
+run at 'require' time, but _before_ subroutine declarations
+that can be loaded in later - usually because they may never
+be called.
+
+The SelfLoader will read from the FOOBAR::DATA filehandle to
+load in the data after __DATA__, and load in any subroutine
+when it is called. The costs are the one-time parsing of the
+data after __DATA__, and a load delay for the _first_
+call of any autoloaded function. The benefits (hopefully)
+are a speeded up compilation phase, with no need to load
+functions which are never used.
+
+The SelfLoader will stop reading from __DATA__ if
+it encounters the __END__ token - just as you would expect.
+If the __END__ token is present, and is followed by the
+token DATA, then the SelfLoader leaves the FOOBAR::DATA
+filehandle open on the line after that token.
+
+The SelfLoader exports the AUTOLOAD subroutine to the
+package using the SelfLoader, and this loads the called
+subroutine when it is first called.
+
+There is no advantage to putting subroutines which will _always_
+be called after the __DATA__ token.
+
+=head2 Autoloading and package lexicals
+
+A 'my $pack_lexical' statement makes the variable $pack_lexical
+local _only_ to the file up to the __DATA__ token. Subroutines
+declared elsewhere _cannot_ see these types of variables,
+just as if you declared subroutines in the package but in another
+file, they cannot see these variables.
+
+So specifically, autoloaded functions cannot see package
+lexicals (this applies to both the SelfLoader and the Autoloader).
+
+=head2 SelfLoader and AutoLoader
+
+The SelfLoader can replace the AutoLoader - just change 'use AutoLoader'
+to 'use SelfLoader' (though note that the SelfLoader exports
+the AUTOLOAD function - but if you have your own AUTOLOAD and
+are using the AutoLoader too, you probably know what you're doing),
+and the __END__ token to __DATA__. You will need perl version 5.001m
+or later to use this (version 5.001 with all patches up to patch m).
+
+There is no need to inherit from the SelfLoader.
+
+The SelfLoader works similarly to the AutoLoader, but picks up the
+subs from after the __DATA__ instead of in the 'lib/auto' directory.
+There is a maintainance gain in not needing to run AutoSplit on the module
+at installation, and a runtime gain in not needing to keep opening and
+closing files to load subs. There is a runtime loss in needing
+to parse the code after the __DATA__.
+
+=head2 __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+This section is only relevant if you want to use
+the FOOBAR::DATA together with the SelfLoader.
+
+Data after the __DATA__ token in a module is read using the
+FOOBAR::DATA filehandle. __END__ can still be used to denote the end
+of the __DATA__ section if followed by the token DATA - this is supported
+by the SelfLoader. The FOOBAR::DATA filehandle is left open if an __END__
+followed by a DATA is found, with the filehandle positioned at the start
+of the line after the __END__ token. If no __END__ token is present,
+or an __END__ token with no DATA token on the same line, then the filehandle
+is closed.
+
+The SelfLoader reads from wherever the current
+position of the FOOBAR::DATA filehandle is, until the
+EOF or __END__. This means that if you want to use
+that filehandle (and ONLY if you want to), you should either
+
+1. Put all your subroutine declarations immediately after
+the __DATA__ token and put your own data after those
+declarations, using the __END__ token to mark the end
+of subroutine declarations. You must also ensure that the SelfLoader
+reads first by  calling 'SelfLoader->load_stubs();', or by using a
+function which is selfloaded;
+
+or
+
+2. You should read the FOOBAR::DATA filehandle first, leaving
+the handle open and positioned at the first line of subroutine
+declarations.
+
+You could conceivably do both.
+
+=head2 Classes and inherited methods.
+
+For modules which are not classes, this section is not relevant.
+This section is only relevant if you have methods which could
+be inherited.
+
+A subroutine stub (or forward declaration) looks like
+
+  sub stub;
+
+i.e. it is a subroutine declaration without the body of the
+subroutine. For modules which are not classes, there is no real
+need for stubs as far as autoloading is concerned.
+
+For modules which ARE classes, and need to handle inherited methods,
+stubs are needed to ensure that the method inheritance mechanism works
+properly. You can load the stubs into the module at 'require' time, by
+adding the statement 'SelfLoader->load_stubs();' to the module to do
+this.
+
+The alternative is to put the stubs in before the __DATA__ token BEFORE
+releasing the module, and for this purpose the Devel::SelfStubber
+module is available.  However this does require the extra step of ensuring
+that the stubs are in the module. If this is done I strongly recommend
+that this is done BEFORE releasing the module - it should NOT be done
+at install time in general.
+
+=head1 Multiple packages and fully qualified subroutine names
+
+Subroutines in multiple packages within the same file are supported - but you
+should note that this requires exporting the SelfLoader::AUTOLOAD to
+every package which requires it. This is done automatically by the
+SelfLoader when it first loads the subs into the cache, but you should
+really specify it in the initialization before the __DATA__ by putting
+a 'use SelfLoader' statement in each package.
+
+Fully qualified subroutine names are also supported. For example,
+
+   __DATA__
+   sub foo::bar {23}
+   package baz;
+   sub dob {32}
+
+will all be loaded correctly by the SelfLoader, and the SelfLoader
+will ensure that the packages 'foo' and 'baz' correctly have the
+SelfLoader AUTOLOAD method when the data after __DATA__ is first parsed.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Shell.pm b/gnu/usr.bin/perl/lib/Shell.pm
new file mode 100644
index 00000000000..bb44b5398b5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Shell.pm
@@ -0,0 +1,126 @@
+package Shell;
+
+use Config;
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    my @EXPORT;
+    if (@_) {
+	@EXPORT = @_;
+    }
+    else {
+	@EXPORT = 'AUTOLOAD';
+    }
+    foreach $sym (@EXPORT) {
+        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
+    }
+};
+
+AUTOLOAD {
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/^.*:://;
+    eval qq {
+	sub $AUTOLOAD {
+	    if (\@_ < 1) {
+		`$cmd`;
+	    }
+	    elsif (\$Config{'archname'} eq 'os2') {
+		local(\*SAVEOUT, \*READ, \*WRITE);
+
+		open SAVEOUT, '>&STDOUT' or die;
+		pipe READ, WRITE or die;
+		open STDOUT, '>&WRITE' or die;
+		close WRITE;
+
+		my \$pid = system(1, \$cmd, \@_);
+		die "Can't execute $cmd: \$!\n" if \$pid < 0;
+
+		open STDOUT, '>&SAVEOUT' or die;
+		close SAVEOUT;
+
+		if (wantarray) {
+		    my \@ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \@ret;
+		}
+		else {
+		    local(\$/) = undef;
+		    my \$ret = <READ>;
+		    close READ;
+		    waitpid \$pid, 0;
+		    \$ret;
+		}
+	    }
+	    else {
+		open(SUBPROC, "-|")
+			or exec '$cmd', \@_
+			or die "Can't exec $cmd: \$!\n";
+		if (wantarray) {
+		    my \@ret = <SUBPROC>;
+		    close SUBPROC;	# XXX Oughta use a destructor.
+		    \@ret;
+		}
+		else {
+		    local(\$/) = undef;
+		    my \$ret = <SUBPROC>;
+		    close SUBPROC;
+		    \$ret;
+		}
+	    }
+	}
+    };
+    goto &$AUTOLOAD;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+See below.
+
+=head1 DESCRIPTION
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072@scalpel.netlabs.com>
+  To: perl5-porters@isu.edu
+  From: Larry Wall <lwall@scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/tmp/passwd");
+
+That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
+package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+Larry
+
+
+=head1 AUTHOR
+
+Larry Wall
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Symbol.pm b/gnu/usr.bin/perl/lib/Symbol.pm
new file mode 100644
index 00000000000..67808af082a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Symbol.pm
@@ -0,0 +1,100 @@
+package Symbol;
+
+=head1 NAME
+
+Symbol - manipulate Perl symbols and their names
+
+=head1 SYNOPSIS
+
+    use Symbol;
+
+    $sym = gensym;
+    open($sym, "filename");
+    $_ = <$sym>;
+    # etc.
+
+    ungensym $sym;      # no effect
+
+    print qualify("x"), "\n";              # "Test::x"
+    print qualify("x", "FOO"), "\n"        # "FOO::x"
+    print qualify("BAR::x"), "\n";         # "BAR::x"
+    print qualify("BAR::x", "FOO"), "\n";  # "BAR::x"
+    print qualify("STDOUT", "FOO"), "\n";  # "main::STDOUT" (global)
+    print qualify(\*x), "\n";              # returns \*x
+    print qualify(\*x, "FOO"), "\n";       # returns \*x
+
+=head1 DESCRIPTION
+
+C<Symbol::gensym> creates an anonymous glob and returns a reference
+to it.  Such a glob reference can be used as a file or directory
+handle.
+
+For backward compatibility with older implementations that didn't
+support anonymous globs, C<Symbol::ungensym> is also provided.
+But it doesn't do anything.
+
+C<Symbol::qualify> turns unqualified symbol names into qualified
+variable names (e.g. "myvar" -> "MyPackage::myvar").  If it is given a
+second parameter, C<qualify> uses it as the default package;
+otherwise, it uses the package of its caller.  Regardless, global
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
+"main::".
+
+Qualification applies only to symbol names (strings).  References are
+left unchanged under the assumption that they are glob references,
+which are qualified by their nature.
+
+=cut
+
+BEGIN { require 5.002; }
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(gensym ungensym qualify);
+
+my $genpkg = "Symbol::";
+my $genseq = 0;
+
+my %global;
+while (<DATA>) {
+    chomp;
+    $global{$_} = 1;
+}
+close DATA;
+
+sub gensym () {
+    my $name = "GEN" . $genseq++;
+    local *{$genpkg . $name};
+    \delete ${$genpkg}{$name};
+}
+
+sub ungensym ($) {}
+
+sub qualify ($;$) {
+    my ($name) = @_;
+    if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) {
+	my $pkg;
+	# Global names: special character, "^x", or other. 
+	if ($name =~ /^([^a-z])|(\^[a-z])$/i || $global{$name}) {
+	    $pkg = "main";
+	}
+	else {
+	    $pkg = (@_ > 1) ? $_[1] : caller;
+	}
+	$name = $pkg . "::" . $name;
+    }
+    $name;
+}
+
+1;
+
+__DATA__
+ARGV
+ARGVOUT
+ENV
+INC
+SIG
+STDERR
+STDIN
+STDOUT
diff --git a/gnu/usr.bin/perl/lib/Sys/Hostname.pm b/gnu/usr.bin/perl/lib/Sys/Hostname.pm
new file mode 100644
index 00000000000..2c40361b51a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Sys/Hostname.pm
@@ -0,0 +1,99 @@
+package Sys::Hostname;
+
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(hostname);
+
+=head1 NAME
+
+Sys::Hostname - Try every conceivable way to get hostname
+
+=head1 SYNOPSIS
+
+    use Sys::Hostname;
+    $host = hostname;
+
+=head1 DESCRIPTION
+
+Attempts several methods of getting the system hostname and
+then caches the result.  It tries C<syscall(SYS_gethostname)>,
+C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
+If all that fails it C<croak>s.
+
+All nulls, returns, and newlines are removed from the result.
+
+=head1 AUTHOR
+
+David Sundstrom <sunds@asictest.sc.ti.com>
+
+Texas Instruments
+
+=cut
+
+sub hostname {
+
+  # method 1 - we already know it
+  return $host if defined $host;
+
+  if ($^O eq 'VMS') {
+
+    # method 2 - no sockets ==> return DECnet node name
+    eval {gethostbyname('me')};
+    if ($@) { return $host = $ENV{'SYS$NODE'}; }
+
+    # method 3 - has someone else done the job already?  It's common for the
+    #    TCP/IP stack to advertise the hostname via a logical name.  (Are
+    #    there any other logicals which TCP/IP stacks use for the host name?)
+    $host = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
+            $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
+            $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
+    return $host if $host;
+
+    # method 4 - does hostname happen to work?
+    my($rslt) = `hostname`;
+    if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; }
+    return $host if $host;
+
+    # rats!
+    $host = '';
+    Carp::croak "Cannot get host name of local machine";  
+
+  }
+  else {  # Unix
+
+    # method 2 - syscall is preferred since it avoids tainting problems
+    eval {
+	{
+	    package main;
+	    require "syscall.ph";
+	}
+	$host = "\0" x 65; ## preload scalar
+	syscall(&main::SYS_gethostname, $host, 65) == 0;
+    }
+
+    # method 3 - trusty old hostname command
+    || eval {
+	$host = `(hostname) 2>/dev/null`; # bsdish
+    }
+
+    # method 4 - sysV uname command (may truncate)
+    || eval {
+	$host = `uname -n 2>/dev/null`; ## sysVish
+    }
+
+    # method 5 - Apollo pre-SR10
+    || eval {
+	($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
+    }
+
+    # bummer
+    || Carp::croak "Cannot get host name of local machine";  
+
+    # remove garbage 
+    $host =~ tr/\0\r\n//d;
+    $host;
+  }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Sys/Syslog.pm b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
new file mode 100644
index 00000000000..f02a2b516c3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Sys/Syslog.pm
@@ -0,0 +1,221 @@
+package Sys::Syslog;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(openlog closelog setlogmask syslog);
+
+use Socket;
+
+# adapted from syslog.pl
+#
+# Tom Christiansen <tchrist@convex.com>
+# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
+# NOTE: openlog now takes three arguments, just like openlog(3)
+
+=head1 NAME
+
+Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
+
+=head1 SYNOPSIS
+
+    use Sys::Syslog;
+
+    openlog $ident, $logopt, $facility;
+    syslog $priority, $mask, $format, @args;
+    $oldmask = setlogmask $mask_priority;
+    closelog;
+
+=head1 DESCRIPTION
+
+Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
+Call C<syslog()> with a string priority and a list of C<printf()> args
+just like C<syslog(3)>.
+
+Syslog provides the functions:
+
+=over
+
+=item openlog $ident, $logopt, $facility
+
+I<$ident> is prepended to every message.
+I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
+I<$facility> specifies the part of the system
+
+=item syslog $priority, $mask, $format, @args
+
+If I<$priority> and I<$mask> permit, logs I<($format, @args)>
+printed as by C<printf(3V)>, with the addition that I<%m>
+is replaced with C<"$!"> (the latest error message).
+
+=item setlogmask $mask_priority
+
+Sets log mask I<$mask_priority> and returns the old mask.
+
+=item closelog
+
+Closes the log file.
+
+=back
+
+Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
+
+=head1 EXAMPLES
+
+    openlog($program, 'cons,pid', 'user');
+    syslog('info', 'this is another test');
+    syslog('mail|warning', 'this is a better test: %d', time);
+    closelog();
+
+    syslog('debug', 'this is the last test');
+    openlog("$program $$", 'ndelay', 'user');
+    syslog('notice', 'fooprogram: this is really done');
+
+    $! = 55;
+    syslog('info', 'problem was %m'); # %m == $! in syslog(3)
+
+=head1 DEPENDENCIES
+
+B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
+
+=head1 SEE ALSO
+
+L<syslog(3)>
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<lwall@sems.com>E<gt>
+
+=cut
+
+$host = hostname() unless $host;	# set $Syslog::host to change
+
+require 'syslog.ph';
+
+$maskpri = &LOG_UPTO(&LOG_DEBUG);
+
+sub openlog {
+    ($ident, $logopt, $facility) = @_;  # package vars
+    $lo_pid = $logopt =~ /\bpid\b/;
+    $lo_ndelay = $logopt =~ /\bndelay\b/;
+    $lo_cons = $logopt =~ /\bcons\b/;
+    $lo_nowait = $logopt =~ /\bnowait\b/;
+    &connect if $lo_ndelay;
+} 
+
+sub closelog {
+    $facility = $ident = '';
+    &disconnect;
+} 
+
+sub setlogmask {
+    local($oldmask) = $maskpri;
+    $maskpri = shift;
+    $oldmask;
+}
+ 
+sub syslog {
+    local($priority) = shift;
+    local($mask) = shift;
+    local($message, $whoami);
+    local(@words, $num, $numpri, $numfac, $sum);
+    local($facility) = $facility;	# may need to change temporarily.
+
+    croak "syslog: expected both priority and mask" unless $mask && $priority;
+
+    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
+    undef $numpri;
+    undef $numfac;
+    foreach (@words) {
+	$num = &xlate($_);		# Translate word to number.
+	if (/^kern$/ || $num < 0) {
+	    croak "syslog: invalid level/facility: $_";
+	}
+	elsif ($num <= &LOG_PRIMASK) {
+	    croak "syslog: too many levels given: $_" if defined($numpri);
+	    $numpri = $num;
+	    return 0 unless &LOG_MASK($numpri) & $maskpri;
+	}
+	else {
+	    croak "syslog: too many facilities given: $_" if defined($numfac);
+	    $facility = $_;
+	    $numfac = $num;
+	}
+    }
+
+    croak "syslog: level must be given" unless defined($numpri);
+
+    if (!defined($numfac)) {	# Facility not specified in this call.
+	$facility = 'user' unless $facility;
+	$numfac = &xlate($facility);
+    }
+
+    &connect unless $connected;
+
+    $whoami = $ident;
+
+    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+	$whoami = $1;
+	$mask = $2;
+    } 
+
+    unless ($whoami) {
+	($whoami = getlogin) ||
+	    ($whoami = getpwuid($<)) ||
+		($whoami = 'syslog');
+    }
+
+    $whoami .= "[$$]" if $lo_pid;
+
+    $mask =~ s/%m/$!/g;
+    $mask .= "\n" unless $mask =~ /\n$/;
+    $message = sprintf ($mask, @_);
+
+    $sum = $numpri + $numfac;
+    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+	if ($lo_cons) {
+	    if ($pid = fork) {
+		unless ($lo_nowait) {
+		    $died = waitpid($pid, 0);
+		}
+	    }
+	    else {
+		open(CONS,">/dev/console");
+		print CONS "<$facility.$priority>$whoami: $message\r";
+		exit if defined $pid;		# if fork failed, we're parent
+		close CONS;
+	    }
+	}
+    }
+}
+
+sub xlate {
+    local($name) = @_;
+    $name =~ y/a-z/A-Z/;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "Sys::Syslog::$name";
+    eval(&$name) || -1;
+}
+
+sub connect {
+    unless ($host) {
+	require Sys::Hostname;
+	$host = Sys::Hostname::hostname();
+    }
+    my $udp = getprotobyname('udp');
+    my $syslog = getservbyname('syslog','udp');
+    my $this = sockaddr_in($syslog, INADDR_ANY);
+    my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
+    socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) 	     || croak "socket: $!";
+    connect(SYSLOG,$that) 			     || croak "connect: $!";
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Term/Cap.pm b/gnu/usr.bin/perl/lib/Term/Cap.pm
new file mode 100644
index 00000000000..656889591a6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/Cap.pm
@@ -0,0 +1,403 @@
+package Term::Cap;
+use Carp;
+
+# Last updated: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com
+
+# TODO:
+# support Berkeley DB termcaps
+# should probably be a .xs module
+# force $FH into callers package?
+# keep $FH in object at Tgetent time?
+
+=head1 NAME
+
+Term::Cap - Perl termcap interface
+
+=head1 SYNOPSIS
+
+    require Term::Cap;
+    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
+    $terminal->Trequire(qw/ce ku kd/);
+    $terminal->Tgoto('cm', $col, $row, $FH);
+    $terminal->Tputs('dl', $count, $FH);
+    $terminal->Tpad($string, $count, $FH);
+
+=head1 DESCRIPTION
+
+These are low-level functions to extract and use capabilities from
+a terminal capability (termcap) database.
+
+The B<Tgetent> function extracts the entry of the specified terminal
+type I<TERM> (defaults to the environment variable I<TERM>) from the
+database.
+
+It will look in the environment for a I<TERMCAP> variable.  If
+found, and the value does not begin with a slash, and the terminal
+type name is the same as the environment string I<TERM>, the
+I<TERMCAP> string is used instead of reading a termcap file.  If
+it does begin with a slash, the string is used as a path name of
+the termcap file to search.  If I<TERMCAP> does not begin with a
+slash and name is different from I<TERM>, B<Tgetent> searches the
+files F<$HOME/.termcap>, F</etc/termcap>, and F</usr/share/misc/termcap>,
+in that order, unless the environment variable I<TERMPATH> exists,
+in which case it specifies a list of file pathnames (separated by
+spaces or colons) to be searched B<instead>.  Whenever multiple
+files are searched and a tc field occurs in the requested entry,
+the entry it names must be found in the same file or one of the
+succeeding files.  If there is a C<:tc=...:> in the I<TERMCAP>
+environment variable string it will continue the search in the
+files as above.
+
+I<OSPEED> is the terminal output bit rate (often mistakenly called
+the baud rate).  I<OSPEED> can be specified as either a POSIX
+termios/SYSV termio speeds (where 9600 equals 9600) or an old
+BSD-style speeds (where 13 equals 9600).
+
+B<Tgetent> returns a blessed object reference which the user can
+then use to send the control strings to the terminal using B<Tputs>
+and B<Tgoto>.  It calls C<croak> on failure.
+
+B<Tgoto> decodes a cursor addressing string with the given parameters.
+
+The output strings for B<Tputs> are cached for counts of 1 for performance.
+B<Tgoto> and B<Tpad> do not cache.  C<$self-E<gt>{_xx}> is the raw termcap
+data and C<$self-E<gt>{xx}> is the cached version.
+
+    print $terminal->Tpad($self->{_xx}, 1);
+
+B<Tgoto>, B<Tputs>, and B<Tpad> return the string and will also
+output the string to $FH if specified.
+
+The extracted termcap entry is available in the object
+as C<$self-E<gt>{TERMCAP}>.
+
+=head1 EXAMPLES
+
+    # Get terminal output speed
+    require POSIX;
+    my $termios = new POSIX::Termios;
+    $termios->getattr;
+    my $ospeed = $termios->getospeed;
+
+    # Old-style ioctl code to get ospeed:
+    #     require 'ioctl.pl';
+    #     ioctl(TTY,$TIOCGETP,$sgtty);
+    #     ($ispeed,$ospeed) = unpack('cc',$sgtty);
+
+    # allocate and initialize a terminal structure
+    $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
+
+    # require certain capabilities to be available
+    $terminal->Trequire(qw/ce ku kd/);
+
+    # Output Routines, if $FH is undefined these just return the string
+
+    # Tgoto does the % expansion stuff with the given args
+    $terminal->Tgoto('cm', $col, $row, $FH);
+
+    # Tputs doesn't do any % expansion.
+    $terminal->Tputs('dl', $count = 1, $FH);
+
+=cut
+
+# Returns a list of termcap files to check.
+sub termcap_path { ## private
+    my @termcap_path;
+    # $TERMCAP, if it's a filespec
+    push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) &&
+                                           ($ENV{TERMCAP} =~ /^\//));
+    if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) {
+	# Add the users $TERMPATH
+	push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH}))
+    }
+    else {
+	# Defaults
+	push(@termcap_path,
+	    $ENV{'HOME'} . '/.termcap',
+	    '/etc/termcap',
+	    '/usr/share/misc/termcap',
+	);
+    }
+    # return the list of those termcaps that exist
+    grep(-f, @termcap_path);
+}
+
+sub Tgetent { ## public -- static method
+    my $class = shift;
+    my $self = bless shift, $class;
+    my($term,$cap,$search,$field,$max,$tmp_term,$TERMCAP);
+    local($termpat,$state,$first,$entry);	# used inside eval
+    local $_;
+
+    # Compute PADDING factor from OSPEED (to be used by Tpad)
+    if (! $self->{OSPEED}) {
+	carp "OSPEED was not set, defaulting to 9600";
+	$self->{OSPEED} = 9600;
+    }
+    if ($self->{OSPEED} < 16) {
+	# delays for old style speeds
+	my @pad = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
+	$self->{PADDING} = $pad[$self->{OSPEED}];
+    }
+    else {
+	$self->{PADDING} = 10000 / $self->{OSPEED};
+    }
+
+    $self->{TERM} = ($self->{TERM} || $ENV{TERM} || croak "TERM not set");
+    $term = $self->{TERM};	# $term is the term type we are looking for
+
+    # $tmp_term is always the next term (possibly :tc=...:) we are looking for
+    $tmp_term = $self->{TERM};
+    # protect any pattern metacharacters in $tmp_term 
+    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+
+    my $foo = (exists $ENV{TERMCAP} ? $ENV{TERMCAP} : '');
+
+    # $entry is the extracted termcap entry
+    if (($foo !~ m:^/:) && ($foo =~ m/(^|\|)${termpat}[:|]/)) {
+	$entry = $foo;
+    }
+
+    my @termcap_path = termcap_path;
+    croak "Can't find a valid termcap file" unless @termcap_path || $entry;
+
+    $state = 1;					# 0 == finished
+						# 1 == next file
+						# 2 == search again
+
+    $first = 0;					# first entry (keeps term name)
+
+    $max = 32;					# max :tc=...:'s
+
+    if ($entry) {
+	# ok, we're starting with $TERMCAP
+	$first++;				# we're the first entry
+	# do we need to continue?
+	if ($entry =~ s/:tc=([^:]+):/:/) {
+	    $tmp_term = $1;
+	    # protect any pattern metacharacters in $tmp_term 
+	    $termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+	}
+	else {
+	    $state = 0;				# we're already finished
+	}
+    }
+
+    # This is eval'ed inside the while loop for each file
+    $search = q{
+	while ($_ = <TERMCAP>) {
+	    next if /^\\t/ || /^#/;
+	    if ($_ =~ m/(^|\\|)${termpat}[:|]/o) {
+		chomp;
+		s/^[^:]*:// if $first++;
+		$state = 0;
+		while ($_ =~ s/\\\\$//) { $_ .= <TERMCAP>; chomp; }
+		last;
+	    }
+	}
+	$entry .= $_;
+    };
+
+    while ($state != 0) {
+	if ($state == 1) {
+	    # get the next TERMCAP
+	    $TERMCAP = shift @termcap_path
+		|| croak "failed termcap lookup on $tmp_term";
+	}
+	else {
+	    # do the same file again
+	    # prevent endless recursion
+	    $max-- || croak "failed termcap loop at $tmp_term";
+	    $state = 1;		# ok, maybe do a new file next time
+	}
+
+	open(TERMCAP,"< $TERMCAP\0") || croak "open $TERMCAP: $!";
+	eval $search;
+	die $@ if $@;
+	close TERMCAP;
+
+	# If :tc=...: found then search this file again
+	$entry =~ s/:tc=([^:]+):/:/ && ($tmp_term = $1, $state = 2);
+	# protect any pattern metacharacters in $tmp_term 
+	$termpat = $tmp_term; $termpat =~ s/(\W)/\\$1/g;
+    }
+
+    croak "Can't find $term" if $entry eq '';
+    $entry =~ s/:+\s*:+/:/g;				# cleanup $entry
+    $entry =~ s/:+/:/g;					# cleanup $entry
+    $self->{TERMCAP} = $entry;				# save it
+    # print STDERR "DEBUG: $entry = ", $entry, "\n";
+
+    # Precompile $entry into the object
+    $entry =~ s/^[^:]*://;
+    foreach $field (split(/:[\s:\\]*/,$entry)) {
+	if ($field =~ /^(\w\w)$/) {
+	    $self->{'_' . $field} = 1 unless defined $self->{'_' . $1};
+	    # print STDERR "DEBUG: flag $1\n";
+	}
+	elsif ($field =~ /^(\w\w)\@/) {
+	    $self->{'_' . $1} = "";
+	    # print STDERR "DEBUG: unset $1\n";
+	}
+	elsif ($field =~ /^(\w\w)#(.*)/) {
+	    $self->{'_' . $1} = $2 unless defined $self->{'_' . $1};
+	    # print STDERR "DEBUG: numeric $1 = $2\n";
+	}
+	elsif ($field =~ /^(\w\w)=(.*)/) {
+	    # print STDERR "DEBUG: string $1 = $2\n";
+	    next if defined $self->{'_' . ($cap = $1)};
+	    $_ = $2;
+	    s/\\E/\033/g;
+	    s/\\(\d\d\d)/pack('c',oct($1) & 0177)/eg;
+	    s/\\n/\n/g;
+	    s/\\r/\r/g;
+	    s/\\t/\t/g;
+	    s/\\b/\b/g;
+	    s/\\f/\f/g;
+	    s/\\\^/\377/g;
+	    s/\^\?/\177/g;
+	    s/\^(.)/pack('c',ord($1) & 31)/eg;
+	    s/\\(.)/$1/g;
+	    s/\377/^/g;
+	    $self->{'_' . $cap} = $_;
+	}
+	# else { carp "junk in $term ignored: $field"; }
+    }
+    $self->{'_pc'} = "\0" unless defined $self->{'_pc'};
+    $self->{'_bc'} = "\b" unless defined $self->{'_bc'};
+    $self;
+}
+
+# $terminal->Tpad($string, $cnt, $FH);
+sub Tpad { ## public
+    my $self = shift;
+    my($string, $cnt, $FH) = @_;
+    my($decr, $ms);
+
+    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
+	$ms = $1;
+	$ms *= $cnt if $2;
+	$string = $3;
+	$decr = $self->{PADDING};
+	if ($decr > .1) {
+	    $ms += $decr / 2;
+	    $string .= $self->{'_pc'} x ($ms / $decr);
+	}
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+# $terminal->Tputs($cap, $cnt, $FH);
+sub Tputs { ## public
+    my $self = shift;
+    my($cap, $cnt, $FH) = @_;
+    my $string;
+
+    if ($cnt > 1) {
+	$string = Tpad($self, $self->{'_' . $cap}, $cnt);
+    } else {
+	# cache result because Tpad can be slow
+	$string = defined $self->{$cap} ? $self->{$cap} :
+	    ($self->{$cap} = Tpad($self, $self->{'_' . $cap}, 1));
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+# %%   output `%'
+# %d   output value as in printf %d
+# %2   output value as in printf %2d
+# %3   output value as in printf %3d
+# %.   output value as in printf %c
+# %+x  add x to value, then do %.
+#
+# %>xy if value > x then add y, no output
+# %r   reverse order of two parameters, no output
+# %i   increment by one, no output
+# %B   BCD (16*(value/10)) + (value%10), no output
+#
+# %n   exclusive-or all parameters with 0140 (Datamedia 2500)
+# %D   Reverse coding (value - 2*(value%16)), no output (Delta Data)
+#
+# $terminal->Tgoto($cap, $col, $row, $FH);
+sub Tgoto { ## public
+    my $self = shift;
+    my($cap, $code, $tmp, $FH) = @_;
+    my $string = $self->{'_' . $cap};
+    my $result = '';
+    my $after = '';
+    my $online = 0;
+    my @tmp = ($tmp,$code);
+    my $cnt = $code;
+
+    while ($string =~ /^([^%]*)%(.)(.*)/) {
+	$result .= $1;
+	$code = $2;
+	$string = $3;
+	if ($code eq 'd') {
+	    $result .= sprintf("%d",shift(@tmp));
+	}
+	elsif ($code eq '.') {
+	    $tmp = shift(@tmp);
+	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
+		if ($online) {
+		    ++$tmp, $after .= $self->{'_up'} if $self->{'_up'};
+		}
+		else {
+		    ++$tmp, $after .= $self->{'_bc'};
+		}
+	    }
+	    $result .= sprintf("%c",$tmp);
+	    $online = !$online;
+	}
+	elsif ($code eq '+') {
+	    $result .= sprintf("%c",shift(@tmp)+ord($string));
+	    $string = substr($string,1,99);
+	    $online = !$online;
+	}
+	elsif ($code eq 'r') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($tmp,$code);
+	    $online = !$online;
+	}
+	elsif ($code eq '>') {
+	    ($code,$tmp,$string) = unpack("CCa99",$string);
+	    if ($tmp[$[] > $code) {
+		$tmp[$[] += $tmp;
+	    }
+	}
+	elsif ($code eq '2') {
+	    $result .= sprintf("%02d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq '3') {
+	    $result .= sprintf("%03d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq 'i') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($code+1,$tmp+1);
+	}
+	else {
+	    return "OOPS";
+	}
+    }
+    $string = Tpad($self, $result . $string . $after, $cnt);
+    print $FH $string if $FH;
+    $string;
+}
+
+# $terminal->Trequire(qw/ce ku kd/);
+sub Trequire { ## public
+    my $self = shift;
+    my($cap,@undefined);
+    foreach $cap (@_) {
+	push(@undefined, $cap)
+	    unless defined $self->{'_' . $cap} && $self->{'_' . $cap};
+    }
+    croak "Terminal does not support: (@undefined)" if @undefined;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Term/Complete.pm b/gnu/usr.bin/perl/lib/Term/Complete.pm
new file mode 100644
index 00000000000..6faef2296ed
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/Complete.pm
@@ -0,0 +1,146 @@
+package Term::Complete;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(Complete);
+
+#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
+
+=head1 NAME
+
+Term::Complete - Perl word completion module
+
+=head1 SYNOPSIS
+
+    $input = complete('prompt_string', \@completion_list);
+    $input = complete('prompt_string', @completion_list);
+
+=head1 DESCRIPTION
+
+This routine provides word completion on the list of words in
+the array (or array ref).
+
+The tty driver is put into raw mode using the system command
+C<stty raw -echo> and restored using C<stty -raw echo>.
+
+The following command characters are defined:
+
+=over 4
+
+=item <tab>
+Attempts word completion.
+Cannot be changed.
+
+=item ^D
+
+Prints completion list.
+Defined by I<$Term::Complete::complete>.
+
+=item ^U
+
+Erases the current input.
+Defined by I<$Term::Complete::kill>.
+
+=item <del>, <bs>
+
+Erases one character.
+Defined by I<$Term::Complete::erase1> and I<$Term::Complete::erase2>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+Bell sounds when word completion fails.
+
+=head1 BUGS
+
+The completion charater <tab> cannot be changed.
+
+=head1 AUTHOR
+
+Wayne Thompson
+
+=cut
+
+CONFIG: {
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
+sub Complete {
+    $prompt = shift;
+    if (ref $_[0] || $_[0] =~ /^\*/) {
+	@cmp_lst = sort @{$_[0]};
+    }
+    else {
+	@cmp_lst = sort(@_);
+    }
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef($r, $return);
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
+    }
+    system('stty -raw echo');
+    print("\n");
+    $return;
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
new file mode 100644
index 00000000000..2ce74231867
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm
@@ -0,0 +1,189 @@
+=head1 NAME
+
+Term::ReadLine - Perl interface to various C<readline> packages. If
+no real package is found, substitutes stubs instead of basic functions.
+
+=head1 SYNOPSIS
+
+  use Term::ReadLine;
+  $term = new Term::ReadLine 'Simple Perl calc';
+  $prompt = "Enter your arithmetic expression: ";
+  $OUT = $term->OUT || STDOUT;
+  while ( defined ($_ = $term->readline($prompt)) ) {
+    $res = eval($_), "\n";
+    warn $@ if $@;
+    print $OUT $res, "\n" unless $@;
+    $term->addhistory($_) if /\S/;
+  }
+
+=head1 DESCRIPTION
+
+This package is just a front end to some other packages. At the moment
+this description is written, the only such package is Term-ReadLine,
+available on CPAN near you. The real target of this stub package is to
+set up a common interface to whatever Readline emerges with time.
+
+=head1 Minimal set of supported functions
+
+All the supported functions should be called as methods, i.e., either as 
+
+  $term = new Term::ReadLine 'name';
+
+or as 
+
+  $term->addhistory('row');
+
+where $term is a return value of Term::ReadLine->Init.
+
+=over 12
+
+=item C<ReadLine>
+
+returns the actual package that executes the commands. Among possible
+values are C<Term::ReadLine::Gnu>, C<Term::ReadLine::Perl>,
+C<Term::ReadLine::Stub Exporter>.
+
+=item C<new>
+
+returns the handle for subsequent calls to following
+functions. Argument is the name of the application. Optionally can be
+followed by two arguments for C<IN> and C<OUT> filehandles. These
+arguments should be globs.
+
+=item C<readline>
+
+gets an input line, I<possibly> with actual C<readline>
+support. Trailing newline is removed. Returns C<undef> on C<EOF>.
+
+=item C<addhistory>
+
+adds the line to the history of input, from where it can be used if
+the actual C<readline> is present.
+
+=item C<IN>, $C<OUT>
+
+return the filehandles for input and output or C<undef> if C<readline>
+input and output cannot be used for Perl.
+
+=item C<MinLine>
+
+If argument is specified, it is an advice on minimal size of line to
+be included into history.  C<undef> means do not include anything into
+history. Returns the old value.
+
+=item C<findConsole>
+
+returns an array with two strings that give most appropriate names for
+files for input and output using conventions C<"<$in">, C<"E<gt>out">.
+
+=item C<Features>
+
+Returns a reference to a hash with keys being features present in
+current implementation. Several optional features are used in the
+minimal interface: C<appname> should be present if the first argument
+to C<new> is recognized, and C<minline> should be present if
+C<MinLine> method is not dummy.  C<autohistory> should be present if
+lines are put into history automatically (maybe subject to
+C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy.
+
+=back
+
+Actually C<Term::ReadLine> can use some other package, that will
+support reacher set of commands.
+
+=head1 EXPORTS
+
+None
+
+=cut
+
+package Term::ReadLine::Stub;
+
+$DB::emacs = $DB::emacs;	# To peacify -w
+
+sub ReadLine {'Term::ReadLine::Stub'}
+sub readline {
+  my ($in,$out,$str) = @{shift()};
+  print $out shift; 
+  $str = scalar <$in>;
+  # bug in 5.000: chomping empty string creats length -1:
+  chomp $str if defined $str;
+  $str;
+}
+sub addhistory {}
+
+sub findConsole {
+    my $console;
+
+    if (-e "/dev/tty") {
+	$console = "/dev/tty";
+    } elsif (-e "con") {
+	$console = "con";
+    } else {
+	$console = "sys\$command";
+    }
+
+    if (defined $ENV{'OS2_SHELL'}) { # In OS/2
+      if ($DB::emacs) {
+	$console = undef;
+      } else {
+	$console = "/dev/con";
+      }
+    }
+
+    $consoleOUT = $console;
+    $console = "&STDIN" unless defined $console;
+    if (!defined $consoleOUT) {
+      $consoleOUT = defined fileno(STDERR) ? "&STDERR" : "&STDOUT";
+    }
+    ($console,$consoleOUT);
+}
+
+sub new {
+  die "method new called with wrong number of arguments" 
+    unless @_==2 or @_==4;
+  #local (*FIN, *FOUT);
+  my ($FIN, $FOUT);
+  if (@_==2) {
+    ($console, $consoleOUT) = findConsole;
+
+    open(FIN, "<$console"); 
+    open(FOUT,">$consoleOUT");
+    #OUT->autoflush(1);		# Conflicts with debugger?
+    $sel = select(FOUT);
+    $| = 1;				# for DB::OUT
+    select($sel);
+    bless [\*FIN, \*FOUT];
+  } else {			# Filehandles supplied
+    $FIN = $_[2]; $FOUT = $_[3];
+    #OUT->autoflush(1);		# Conflicts with debugger?
+    $sel = select($FOUT);
+    $| = 1;				# for DB::OUT
+    select($sel);
+    bless [$FIN, $FOUT];
+  }
+}
+sub IN { shift->[0] }
+sub OUT { shift->[1] }
+sub MinLine { undef }
+sub Features { {} }
+
+package Term::ReadLine;		# So late to allow the above code be defined?
+eval "use Term::ReadLine::Gnu;" or eval "use Term::ReadLine::Perl;";
+
+#require FileHandle;
+
+# To make possible switch off RL in debugger: (Not needed, work done
+# in debugger).
+
+if (defined &Term::ReadLine::Gnu::readline) {
+  @ISA = qw(Term::ReadLine::Gnu Term::ReadLine::Stub);
+} elsif (defined &Term::ReadLine::Perl::readline) {
+  @ISA = qw(Term::ReadLine::Perl Term::ReadLine::Stub);
+} else {
+  @ISA = qw(Term::ReadLine::Stub);
+}
+
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Test/Harness.pm b/gnu/usr.bin/perl/lib/Test/Harness.pm
new file mode 100644
index 00000000000..7d899a69f92
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/Harness.pm
@@ -0,0 +1,258 @@
+package Test::Harness;
+
+use Exporter;
+use Benchmark;
+use Config;
+use FileHandle;
+use vars qw($VERSION $verbose $switches);
+require 5.002;
+
+$VERSION = "1.07";
+
+@ISA=('Exporter');
+@EXPORT= qw(&runtests);
+@EXPORT_OK= qw($verbose $switches);
+
+
+$verbose = 0;
+$switches = "-w";
+
+sub runtests {
+    my(@tests) = @_;
+    local($|) = 1;
+    my($test,$te,$ok,$next,$max,$pct);
+    my $totmax = 0;
+    my $files = 0;
+    my $bad = 0;
+    my $good = 0;
+    my $total = @tests;
+    local($ENV{'PERL5LIB'}) = join($Config{path_sep}, @INC); # pass -I flags to children
+
+    my $t_start = new Benchmark;
+    while ($test = shift(@tests)) {
+	$te = $test;
+	chop($te);
+	print "$te" . '.' x (20 - length($te));
+	my $fh = new FileHandle;
+	$fh->open("$^X $switches $test|") || (print "can't run. $!\n");
+	$ok = $next = $max = 0;
+	@failed = ();
+	while (<$fh>) {
+	    if( $verbose ){
+		print $_;
+	    }
+	    unless (/^\s*\#/) {
+		if (/^1\.\.([0-9]+)/) {
+		    $max = $1;
+		    $totmax += $max;
+		    $files++;
+		    $next = 1;
+		} elsif ($max && /^(not\s+)?ok\b/) {
+		    my $this = $next;
+		    if (/^not ok\s*(\d*)/){
+			$this = $1 if $1 > 0;
+			push @failed, $this;
+		    } elsif (/^ok\s*(\d*)/) {
+			$this = $1 if $1 > 0;
+			$ok++;
+			$totok++;
+		    }
+		    if ($this > $next) {
+			# warn "Test output counter mismatch [test $this]\n";
+			# no need to warn probably
+			push @failed, $next..$this-1;
+		    } elsif ($this < $next) {
+			#we have seen more "ok" lines than the number suggests
+			warn "Aborting test: output counter mismatch [test $this answered when test $next expected]\n";
+			last;
+		    }
+		    $next = $this + 1;
+		}
+	    }
+	}
+	$fh->close; # must close to reap child resource values
+	my $wstatus = $?;
+	my $estatus = $wstatus >> 8;
+	if ($ok == $max && $next == $max+1 && ! $estatus) {
+	    print "ok\n";
+	    $good++;
+	} elsif ($max) {
+	    if ($next <= $max) {
+		push @failed, $next..$max;
+	    }
+	    if (@failed) {
+		print canonfailed($max,@failed);
+	    } else {
+		print "Don't know which tests failed for some reason\n";
+	    }
+	    $bad++;
+	} elsif ($next == 0) {
+	    print "FAILED before any test output arrived\n";
+	    $bad++;
+	}
+	if ($wstatus) {
+	    print "\tTest returned status $estatus (wstat $wstatus)\n";
+	}
+    }
+    my $t_total = timediff(new Benchmark, $t_start);
+    
+    if ($bad == 0 && $totmax) {
+	    print "All tests successful.\n";
+    } elsif ($total==0){
+	die "FAILED--no tests were run for some reason.\n";
+    } elsif ($totmax==0) {
+	my $blurb = $total==1 ? "script" : "scripts";
+	die "FAILED--$total test $blurb could be run, alas -- no output ever seen\n";
+    } else {
+	$pct = sprintf("%.2f", $good / $total * 100);
+	my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
+	$totmax - $totok, $totmax, 100*$totok/$totmax;
+	if ($bad == 1) {
+	    die "Failed 1 test script, $pct% okay.$subpct\n";
+	} else {
+	    die "Failed $bad/$total test scripts, $pct% okay.$subpct\n";
+	}
+    }
+    printf("Files=%d,  Tests=%d, %s\n", $files, $totmax, timestr($t_total, 'nop'));
+}
+
+sub canonfailed ($@) {
+    my($max,@failed) = @_;
+    my %seen;
+    @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
+    my $failed = @failed;
+    my @result = ();
+    my @canon = ();
+    my $min;
+    my $last = $min = shift @failed;
+    if (@failed) {
+	for (@failed, $failed[-1]) { # don't forget the last one
+	    if ($_ > $last+1 || $_ == $last) {
+		if ($min == $last) {
+		    push @canon, $last;
+		} else {
+		    push @canon, "$min-$last";
+		}
+		$min = $_;
+	    }
+	    $last = $_;
+	}
+	local $" = ", ";
+	push @result, "FAILED tests @canon\n";
+    } else {
+	push @result, "FAILED test $last\n";
+    }
+
+    push @result, "\tFailed $failed/$max tests, ";
+    push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
+    join "", @result;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Test::Harness - run perl standard test scripts with statistics
+
+=head1 SYNOPSIS
+
+use Test::Harness;
+
+runtests(@tests);
+
+=head1 DESCRIPTION
+
+Perl test scripts print to standard output C<"ok N"> for each single
+test, where C<N> is an increasing sequence of integers. The first line
+output by a standard test scxript is C<"1..M"> with C<M> being the
+number of tests that should be run within the test
+script. Test::Harness::runscripts(@tests) runs all the testscripts
+named as arguments and checks standard output for the expected
+C<"ok N"> strings.
+
+After all tests have been performed, runscripts() prints some
+performance statistics that are computed by the Benchmark module.
+
+=head2 The test script output
+
+Any output from the testscript to standard error is ignored and
+bypassed, thus will be seen by the user. Lines written to standard
+output that look like perl comments (start with C</^\s*\#/>) are
+discarded. Lines containing C</^(not\s+)?ok\b/> are interpreted as
+feedback for runtests().
+
+It is tolerated if the test numbers after C<ok> are omitted. In this
+case Test::Harness maintains temporarily its own counter until the
+script supplies test numbers again. So the following test script
+
+    print <<END;
+    1..6
+    not ok
+    ok
+    not ok
+    ok
+    ok
+    END
+
+will generate 
+
+    FAILED tests 1, 3, 6
+    Failed 3/6 tests, 50.00% okay
+
+The global variable $Test::Harness::verbose is exportable and can be
+used to let runscripts() display the standard output of the script
+without altering the behavior otherwise.
+
+=head1 EXPORT
+
+C<&runscripts> is exported by Test::Harness per default.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
+
+If all tests are successful some statistics about the performance are
+printed.
+
+=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
+
+For any single script that has failing subtests statistics like the
+above are printed.
+
+=item C<Test returned status %d (wstat %d)>
+
+Scripts that return a non-zero exit status, both $?>>8 and $? are
+printed in a message similar to the above.
+
+=item C<Failed 1 test, %.2f%% okay. %s>
+
+=item C<Failed %d/%d tests, %.2f%% okay. %s>
+
+If not all tests were successful, the script dies with one of the
+above messages.
+
+=back
+
+=head1 SEE ALSO
+
+See L<Benchmark> for the underlying timing routines.
+
+=head1 AUTHORS
+
+Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+sure is, that it was inspired by Larry Wall's TEST script that came
+with perl distributions for ages. Current maintainer is Andreas
+Koenig.
+
+=head1 BUGS
+
+Test::Harness uses $^X to determine the perl binary to run the tests
+with. Test scripts running via the shebang (C<#!>) line may not be
+portable because $^X is not consistent for shebang scripts across
+platforms. This is no problem when Test::Harness is run with an
+absolute path to the perl binary or when $^X can be found in the path.
+
+=cut
diff --git a/gnu/usr.bin/perl/lib/Text/Abbrev.pm b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
new file mode 100644
index 00000000000..d12dfb36a69
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Abbrev.pm
@@ -0,0 +1,59 @@
+package Text::Abbrev;
+require 5.000;
+require Exporter;
+
+=head1 NAME
+
+abbrev - create an abbreviation table from a list
+
+=head1 SYNOPSIS
+
+    use Abbrev;
+    abbrev *HASH, LIST
+
+
+=head1 DESCRIPTION
+
+Stores all unambiguous truncations of each element of LIST
+as keys key in the associative array indicated by C<*hash>.
+The values are the original list elements.
+
+=head1 EXAMPLE
+
+    abbrev(*hash,qw("list edit send abort gripe"));
+
+=cut
+
+@ISA = qw(Exporter);
+@EXPORT = qw(abbrev);
+
+# Usage:
+#	&abbrev(*foo,LIST);
+#	...
+#	$long = $foo{$short};
+
+sub abbrev {
+    local(*domain) = shift;
+    @cmp = @_;
+    %domain = ();
+    foreach $name (@_) {
+	@extra = split(//,$name);
+	$abbrev = shift(@extra);
+	$len = 1;
+	foreach $cmp (@cmp) {
+	    next if $cmp eq $name;
+	    while (substr($cmp,0,$len) eq $abbrev) {
+		$abbrev .= shift(@extra);
+		++$len;
+	    }
+	}
+	$domain{$abbrev} = $name;
+	while (@extra) {
+	    $abbrev .= shift(@extra);
+	    $domain{$abbrev} = $name;
+	}
+    }
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/Text/ParseWords.pm b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
new file mode 100644
index 00000000000..89951387ef6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/ParseWords.pm
@@ -0,0 +1,173 @@
+package Text::ParseWords;
+
+require 5.000;
+require Exporter;
+require AutoLoader;
+use Carp;
+
+@ISA = qw(Exporter AutoLoader);
+@EXPORT = qw(shellwords quotewords);
+@EXPORT_OK = qw(old_shellwords);
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens
+
+=head1 SYNOPSIS
+
+  use Text::ParseWords;
+  @words = &quotewords($delim, $keep, @lines);
+  @words = &shellwords(@lines);
+  @words = &old_shellwords(@lines);
+
+=head1 DESCRIPTION
+
+&quotewords() accepts a delimiter (which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes.
+
+The $keep argument is a boolean flag.  If true, the quotes are kept
+with each word, otherwise quotes are stripped in the splitting process.
+$keep also defines whether unprotected backslashes are retained.
+
+A &shellwords() replacement is included to demonstrate the new package.
+This version differs from the original in that it will _NOT_ default
+to using $_ if no arguments are given.  I personally find the old behavior
+to be a mis-feature.
+
+
+&quotewords() works by simply jamming all of @lines into a single
+string in $_ and then pulling off words a bit at a time until $_
+is exhausted.
+
+=head1 AUTHORS
+
+Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
+
+Basically an update and generalization of the old shellwords.pl.
+Much code shamelessly stolen from the old version (author unknown).
+
+=cut
+
+1;
+__END__
+
+sub shellwords {
+    local(@lines) = @_;
+    $lines[$#lines] =~ s/\s+$//;
+    &quotewords('\s+', 0, @lines);
+}
+
+
+
+sub quotewords {
+
+# The inner "for" loop builds up each word (or $field) one $snippet
+# at a time.  A $snippet is a quoted string, a backslashed character,
+# or an unquoted string.  We fall out of the "for" loop when we reach
+# the end of $_ or when we hit a delimiter.  Falling out of the "for"
+# loop, we push the $field we've been building up onto the list of
+# @words we'll be returning, and then loop back and pull another word
+# off of $_.
+#
+# The first two cases inside the "for" loop deal with quoted strings.
+# The first case matches a double quoted string, removes it from $_,
+# and assigns the double quoted string to $snippet in the body of the
+# conditional.  The second case handles single quoted strings.  In
+# the third case we've found a quote at the current beginning of $_,
+# but it didn't match the quoted string regexps in the first two cases,
+# so it must be an unbalanced quote and we croak with an error (which can
+# be caught by eval()).
+#
+# The next case handles backslashed characters, and the next case is the
+# exit case on reaching the end of the string or finding a delimiter.
+#
+# Otherwise, we've found an unquoted thing and we pull of characters one
+# at a time until we reach something that could start another $snippet--
+# a quote of some sort, a backslash, or the delimiter.  This one character
+# at a time behavior was necessary if the delimiter was going to be a
+# regexp (love to hear it if you can figure out a better way).
+
+    local($delim, $keep, @lines) = @_;
+    local(@words,$snippet,$field,$_);
+
+    $_ = join('', @lines);
+    while ($_) {
+	$field = '';
+	for (;;) {
+            $snippet = '';
+	    if (s/^"(([^"\\]|\\[\\"])*)"//) {
+		$snippet = $1;
+                $snippet = "\"$snippet\"" if ($keep);
+	    }
+	    elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
+		$snippet = $1;
+                $snippet = "'$snippet'" if ($keep);
+	    }
+	    elsif (/^["']/) {
+		croak "Unmatched quote";
+	    }
+            elsif (s/^\\(.)//) {
+                $snippet = $1;
+                $snippet = "\\$snippet" if ($keep);
+            }
+	    elsif (!$_ || s/^$delim//) {
+               last;
+	    }
+	    else {
+                while ($_ && !(/^$delim/ || /^['"\\]/)) {
+		   $snippet .=  substr($_, 0, 1);
+                   substr($_, 0, 1) = '';
+                }
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
+
+
+sub old_shellwords {
+
+    # Usage:
+    #	use ParseWords;
+    #	@words = old_shellwords($line);
+    #	or
+    #	@words = old_shellwords(@lines);
+
+    local($_) = join('', @_);
+    my(@words,$snippet,$field);
+
+    s/^\s+//;
+    while ($_ ne '') {
+	$field = '';
+	for (;;) {
+	    if (s/^"(([^"\\]|\\.)*)"//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^"/) {
+		croak "Unmatched double quote: $_";
+	    }
+	    elsif (s/^'(([^'\\]|\\.)*)'//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^'/) {
+		croak "Unmatched single quote: $_";
+	    }
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+	    }
+	    elsif (s/^([^\s\\'"]+)//) {
+		$snippet = $1;
+	    }
+	    else {
+		s/^\s+//;
+		last;
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
diff --git a/gnu/usr.bin/perl/lib/Text/Soundex.pm b/gnu/usr.bin/perl/lib/Text/Soundex.pm
new file mode 100644
index 00000000000..82df8c0d74d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Soundex.pm
@@ -0,0 +1,152 @@
+package Text::Soundex;
+require 5.000;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&soundex $soundex_nocode);
+
+# $Id: Soundex.pm,v 1.1.1.1 1996/08/19 10:12:51 downsj Exp $
+#
+# Implementation of soundex algorithm as described by Knuth in volume
+# 3 of The Art of Computer Programming, with ideas stolen from Ian
+# Phillips <ian@pipex.net>.
+#
+# Mike Stok <Mike.Stok@meiko.concord.ma.us>, 2 March 1994.
+#
+# Knuth's test cases are:
+# 
+# Euler, Ellery -> E460
+# Gauss, Ghosh -> G200
+# Hilbert, Heilbronn -> H416
+# Knuth, Kant -> K530
+# Lloyd, Ladd -> L300
+# Lukasiewicz, Lissajous -> L222
+#
+# $Log: Soundex.pm,v $
+# Revision 1.1.1.1  1996/08/19 10:12:51  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+# Revision 1.2  1994/03/24  00:30:27  mike
+# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
+# in the way I handles leasing characters which were different but had
+# the same soundex code.  This showed up comparing it with Oracle's
+# soundex output.
+#
+# Revision 1.1  1994/03/02  13:01:30  mike
+# Initial revision
+#
+#
+##############################################################################
+
+# $soundex_nocode is used to indicate a string doesn't have a soundex
+# code, I like undef other people may want to set it to 'Z000'.
+
+$soundex_nocode = undef;
+
+sub soundex
+{
+  local (@s, $f, $fc, $_) = @_;
+
+  push @s, '' unless @s;	# handle no args as a single empty string
+
+  foreach (@s)
+  {
+    tr/a-z/A-Z/;
+    tr/A-Z//cd;
+
+    if ($_ eq '')
+    {
+      $_ = $soundex_nocode;
+    }
+    else
+    {
+      ($f) = /^(.)/;
+      tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/;
+      ($fc) = /^(.)/;
+      s/^$fc+//;
+      tr///cs;
+      tr/0//d;
+      $_ = $f . $_ . '000';
+      s/^(.{4}).*/$1/;
+    }
+  }
+
+  wantarray ? @s : shift @s;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::Soundex - Implementation of the Soundex Algorithm as Described by Knuth
+
+=head1 SYNOPSIS
+
+  use Text::Soundex;
+
+  $code = soundex $string;            # get soundex code for a string
+  @codes = soundex @list;             # get list of codes for list of strings
+
+  # set value to be returned for strings without soundex code
+
+  $soundex_nocode = 'Z000';
+
+=head1 DESCRIPTION
+
+This module implements the soundex algorithm as described by Donald Knuth
+in Volume 3 of B<The Art of Computer Programming>.  The algorithm is
+intended to hash words (in particular surnames) into a small space using a
+simple model which approximates the sound of the word when spoken by an English
+speaker.  Each word is reduced to a four character string, the first
+character being an upper case letter and the remaining three being digits.
+
+If there is no soundex code representation for a string then the value of
+C<$soundex_nocode> is returned.  This is initially set to C<undef>, but
+many people seem to prefer an I<unlikely> value like C<Z000>
+(how unlikely this is depends on the data set being dealt with.)  Any value
+can be assigned to C<$soundex_nocode>.
+
+In scalar context C<soundex> returns the soundex code of its first
+argument, and in array context a list is returned in which each element is the 
+soundex code for the corresponding argument passed to C<soundex> e.g.
+
+  @codes = soundex qw(Mike Stok);
+
+leaves C<@codes> containing C<('M200', 'S320')>.
+
+=head1 EXAMPLES
+
+Knuth's examples of various names and the soundex codes they map to
+are listed below:
+
+  Euler, Ellery -> E460
+  Gauss, Ghosh -> G200
+  Hilbert, Heilbronn -> H416
+  Knuth, Kant -> K530
+  Lloyd, Ladd -> L300
+  Lukasiewicz, Lissajous -> L222
+
+so:
+
+  $code = soundex 'Knuth';              # $code contains 'K530'
+  @list = soundex qw(Lloyd Gauss);	# @list contains 'L300', 'G200'
+
+=head1 LIMITATIONS
+
+As the soundex algorithm was originally used a B<long> time ago in the US
+it considers only the English alphabet and pronunciation.
+
+As it is mapping a large space (arbitrary length strings) onto a small
+space (single letter plus 3 digits) no inference can be made about the
+similarity of two strings which end up with the same soundex code.  For 
+example, both C<Hilbert> and C<Heilbronn> end up with a soundex code
+of C<H416>.
+
+=head1 AUTHOR
+
+This code was implemented by Mike Stok (C<stok@cybercom.net>) from the 
+description given by Knuth.  Ian Phillips (C<ian@pipex.net>) and Rich Pinder 
+(C<rpinder@hsc.usc.edu>) supplied ideas and spotted mistakes.
diff --git a/gnu/usr.bin/perl/lib/Text/Tabs.pm b/gnu/usr.bin/perl/lib/Text/Tabs.pm
new file mode 100644
index 00000000000..2481d81ec6b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Tabs.pm
@@ -0,0 +1,80 @@
+#
+# expand and unexpand tabs as per the unix expand and 
+# unexpand programs.
+#
+# expand and unexpand operate on arrays of lines.  Do not
+# feed strings that contain newlines to them.
+#
+# David Muir Sharnoff <muir@idiom.com>
+# 
+# Version: 9/21/95
+#
+
+=head1 NAME
+
+Text::Tabs -- expand and unexpand tabs
+
+=head1 SYNOPSIS
+
+	use Text::Tabs;
+	
+	#$tabstop = 8; # Defaults
+	print expand("Hello\tworld");
+	print unexpand("Hello,        world");
+	$tabstop = 4;
+	print join("\n",expand(split(/\n/,
+		"Hello\tworld,\nit's a nice day.\n"
+		)));
+
+=head1 DESCRIPTION
+
+This module expands and unexpands tabs into spaces, as per the unix expand
+and unexpand programs. Either function should be passed an array of strings
+(newlines may I<not> be included, and should be used to split an incoming
+string into separate elements.) which will be processed and returned.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
+
+=cut
+
+package Text::Tabs;
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(expand unexpand $tabstop);
+
+$tabstop = 8;
+
+sub expand
+{
+	my @l = @_;
+	for $_ (@l) {
+		1 while s/^([^\t]*)(\t+)/
+			$1 . (" " x 
+				($tabstop * length($2)
+				- (length($1) % $tabstop)))
+			/e;
+	}
+	return @l if wantarray;
+	return @l[0];
+}
+
+sub unexpand
+{
+	my @l = &expand(@_);
+	my @e;
+	for $x (@l) {
+		@e = split(/(.{$tabstop})/,$x);
+		for $_ (@e) {
+			s/  +$/\t/;
+		}
+		$x = join('',@e);
+	}
+	return @l if wantarray;
+	return @l[0];
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Text/Wrap.pm b/gnu/usr.bin/perl/lib/Text/Wrap.pm
new file mode 100644
index 00000000000..b665752f942
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Text/Wrap.pm
@@ -0,0 +1,93 @@
+
+package Text::Wrap;
+
+#
+# This is a very simple paragraph formatter.  It formats one 
+# paragraph at a time by wrapping and indenting text.
+#
+# Usage:
+#
+#	use Text::Wrap;
+#
+#	print wrap($initial_tab,$subsequent_tab,@text);
+#
+# You can also set the number of columns to wrap before:
+#
+#	$Text::Wrap::columns = 135; # <= width of screen
+#
+#	use Text::Wrap qw(wrap $columns); 
+#	$columns = 70;
+#	
+#
+# The first line will be printed with $initial_tab prepended.  All
+# following lines will have $subsequent_tab prepended.
+#
+# Example:
+#
+#	print wrap("\t","","This is a bit of text that ...");
+#
+# David Muir Sharnoff <muir@idiom.com>
+# Version: 9/21/95
+#
+
+=head1 NAME
+
+Text::Wrap -- wrap text into a paragraph
+
+=head1 SYNOPSIS
+
+	use Text::Wrap;
+	
+	$Text::Wrap::columns = 20; # Default
+	print wrap("\t","",Hello, world, it's a nice day, isn't it?");
+
+=head1 DESCRIPTION
+
+This module is a simple paragraph formatter that wraps text into a paragraph
+and indents each line. The single exported function, wrap(), takes three
+arguments. The first is included before the first output line, and the
+second argument is included before each subsequest output line. The third
+argument is the text to be wrapped.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <muir@idiom.com>
+
+=cut
+
+require Exporter;
+
+@ISA = (Exporter);
+@EXPORT = qw(wrap);
+@EXPORT_OK = qw($columns);
+
+BEGIN	{
+	$Text::Wrap::columns = 76;  # <= screen width
+}
+
+use Text::Tabs;
+use strict;
+
+sub wrap
+{
+	my ($ip, $xp, @t) = @_;
+
+	my $r;
+	my $t = expand(join(" ",@t));
+	my $lead = $ip;
+	my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+	if ($t =~ s/^([^\n]{0,$ll})\s//) {
+		$r .= unexpand($lead . $1 . "\n");
+		$lead = $xp;
+		my $ll = $Text::Wrap::columns - length(expand($lead)) - 1;
+		while ($t =~ s/^([^\n]{0,$ll})\s//) {
+			$r .= unexpand($lead . $1 . "\n");
+		}
+	} 
+	die "couldn't wrap '$t'" 
+		if length($t) > $ll;
+	$r .= $t;
+	return $r;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/Hash.pm b/gnu/usr.bin/perl/lib/Tie/Hash.pm
new file mode 100644
index 00000000000..9a9d059a7f7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/Hash.pm
@@ -0,0 +1,158 @@
+package Tie::Hash;
+
+=head1 NAME
+
+Tie::Hash, Tie::StdHash - base class definitions for tied hashes
+
+=head1 SYNOPSIS
+
+    package NewHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::Hash);
+    
+    sub DELETE { ... }		# Provides needed method
+    sub CLEAR { ... }		# Overrides inherited method
+    
+    
+    package NewStdHash;
+    require Tie::Hash;
+    
+    @ISA = (Tie::StdHash);
+    
+    # All methods provided by default, define only those needing overrides
+    sub DELETE { ... }
+    
+    
+    package main;
+    
+    tie %new_hash, NewHash;
+    tie %new_std_hash, NewStdHash;
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for hash-tying classes. See
+L<perltie> for a list of the functions required in order to tie a hash
+to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
+as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
+provides most methods required for hashes in L<perltie>. It inherits from
+B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
+allowing for selective overloading of methods. The C<new> method is provided
+as grandfathering in the case a class forgets to include a C<TIEHASH> method.
+
+For developers wishing to write their own tied hashes, the required methods
+are briefly defined below. See the L<perltie> section for more detailed
+descriptive, as well as example code:
+
+=over
+
+=item TIEHASH classname, LIST
+
+The method invoked by the command C<tie %hash, classname>. Associates a new
+hash instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item STORE this, key, value
+
+Store datum I<value> into I<key> for the tied hash I<this>.
+
+=item FETCH this, key
+
+Retrieve the datum in I<key> for the tied hash I<this>.
+
+=item FIRSTKEY this
+
+Return the (key, value) pair for the first key in the hash.
+
+=item NEXTKEY this, lastkey
+
+Return the next (key, value) pair for the hash.
+
+=item EXISTS this, key
+
+Verify that I<key> exists with the tied hash I<this>.
+
+=item DELETE this, key
+
+Delete the key I<key> from the tied hash I<this>.
+
+=item CLEAR this
+
+Clear all values from the tied hash I<this>.
+
+=back
+
+=head1 CAVEATS
+
+The L<perltie> documentation includes a method called C<DESTROY> as
+a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
+define a default for this method. This is a standard for class packages,
+but may be omitted in favor of a simple default.
+
+=head1 MORE INFORMATION
+
+The packages relating to various DBM-related implemetations (F<DB_File>,
+F<NDBM_File>, etc.) show examples of general tied hashes, as does the
+L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
+good working examples.
+
+=cut
+    
+use Carp;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIEHASH(@_);
+}
+
+# Grandfather "new"
+
+sub TIEHASH {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
+	    if $^W;
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIEHASH method";
+    }
+}
+
+sub EXISTS {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define an EXISTS method";
+}
+
+sub CLEAR {
+    my $self = shift;
+    my $key = $self->FIRSTKEY(@_);
+    my @keys;
+
+    while (defined $key) {
+	push @keys, $key;
+	$key = $self->NEXTKEY(@_, $key);
+    }
+    foreach $key (@keys) {
+	$self->DELETE(@_, $key);
+    }
+}
+
+# The Tie::StdHash package implements standard perl hash behaviour.
+# It exists to act as a base class for classes which only wish to
+# alter some parts of their behaviour.
+
+package Tie::StdHash;
+@ISA = qw(Tie::Hash);
+
+sub TIEHASH  { bless {}, $_[0] }
+sub STORE    { $_[0]->{$_[1]} = $_[2] }
+sub FETCH    { $_[0]->{$_[1]} }
+sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
+sub NEXTKEY  { each %{$_[0]} }
+sub EXISTS   { exists $_[0]->{$_[1]} }
+sub DELETE   { delete $_[0]->{$_[1]} }
+sub CLEAR    { %{$_[0]} = () }
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/Scalar.pm b/gnu/usr.bin/perl/lib/Tie/Scalar.pm
new file mode 100644
index 00000000000..2db02ae1daf
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/Scalar.pm
@@ -0,0 +1,138 @@
+package Tie::Scalar;
+
+=head1 NAME
+
+Tie::Scalar, Tie::StdScalar - base class definitions for tied scalars
+
+=head1 SYNOPSIS
+
+    package NewScalar;
+    require Tie::Scalar;
+     
+    @ISA = (Tie::Scalar);
+     
+    sub FETCH { ... }		# Provide a needed method
+    sub TIESCALAR { ... }	# Overrides inherited method
+         
+     
+    package NewStdScalar;
+    require Tie::Scalar;
+    
+    @ISA = (Tie::StdScalar);
+    
+    # All methods provided by default, so define only what needs be overridden
+    sub FETCH { ... }
+    
+    
+    package main;
+    
+    tie $new_scalar, NewScalar;
+    tie $new_std_scalar, NewStdScalar;
+
+=head1 DESCRIPTION
+
+This module provides some skeletal methods for scalar-tying classes. See
+L<perltie> for a list of the functions required in tying a scalar to a
+package. The basic B<Tie::Scalar> package provides a C<new> method, as well
+as methods C<TIESCALAR>, C<FETCH> and C<STORE>. The B<Tie::StdScalar>
+package provides all the methods specified in  L<perltie>. It inherits from
+B<Tie::Scalar> and causes scalars tied to it to behave exactly like the
+built-in scalars, allowing for selective overloading of methods. The C<new>
+method is provided as a means of grandfathering, for classes that forget to
+provide their own C<TIESCALAR> method.
+
+For developers wishing to write their own tied-scalar classes, the methods
+are summarized below. The L<perltie> section not only documents these, but
+has sample code as well:
+
+=over
+
+=item TIESCALAR classname, LIST
+
+The method invoked by the command C<tie $scalar, classname>. Associates a new
+scalar instance with the specified class. C<LIST> would represent additional
+arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
+complete the association.
+
+=item FETCH this
+
+Retrieve the value of the tied scalar referenced by I<this>.
+
+=item STORE this, value
+
+Store data I<value> in the tied scalar referenced by I<this>.
+
+=item DESTROY this
+
+Free the storage associated with the tied scalar referenced by I<this>.
+This is rarely needed, as Perl manages its memory quite well. But the
+option exists, should a class wish to perform specific actions upon the
+destruction of an instance.
+
+=back
+
+=head1 MORE INFORMATION
+
+The L<perltie> section uses a good example of tying scalars by associating
+process IDs with priority.
+
+=cut
+
+use Carp;
+
+sub new {
+    my $pkg = shift;
+    $pkg->TIESCALAR(@_);
+}
+
+# "Grandfather" the new, a la Tie::Hash
+
+sub TIESCALAR {
+    my $pkg = shift;
+    if (defined &{"{$pkg}::new"}) {
+	carp "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
+	    if $^W;
+	$pkg->new(@_);
+    }
+    else {
+	croak "$pkg doesn't define a TIESCALAR method";
+    }
+}
+
+sub FETCH {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a FETCH method";
+}
+
+sub STORE {
+    my $pkg = ref $_[0];
+    croak "$pkg doesn't define a STORE method";
+}
+
+#
+# The Tie::StdScalar package provides scalars that behave exactly like
+# Perl's built-in scalars. Good base to inherit from, if you're only going to
+# tweak a small bit.
+#
+package Tie::StdScalar;
+@ISA = (Tie::Scalar);
+
+sub TIESCALAR {
+    my $class = shift;
+    my $instance = shift || undef;
+    return bless \$instance => $class;
+}
+
+sub FETCH {
+    return ${$_[0]};
+}
+
+sub STORE {
+    ${$_[0]} = $_[1];
+}
+
+sub DESTROY {
+    undef ${$_[0]};
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
new file mode 100644
index 00000000000..a01c66ef8d5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Tie/SubstrHash.pm
@@ -0,0 +1,176 @@
+package Tie::SubstrHash;
+
+=head1 NAME
+
+Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
+
+=head1 SYNOPSIS
+
+    require Tie::SubstrHash;
+
+    tie %myhash, Tie::SubstrHash, $key_len, $value_len, $table_size;
+
+=head1 DESCRIPTION
+
+The B<Tie::SubstrHash> package provides a hash-table-like interface to
+an array of determinate size, with constant key size and record size.
+
+Upon tying a new hash to this package, the developer must specify the
+size of the keys that will be used, the size of the value fields that the
+keys will index, and the size of the overall table (in terms of key-value
+pairs, not size in hard memory). I<These values will not change for the
+duration of the tied hash>. The newly-allocated hash table may now have
+data stored and retrieved. Efforts to store more than C<$table_size>
+elements will result in a fatal error, as will efforts to store a value
+not exactly C<$value_len> characters in length, or reference through a
+key not exactly C<$key_len> characters in length. While these constraints
+may seem excessive, the result is a hash table using much less internal
+memory than an equivalent freely-allocated hash table.
+
+=head1 CAVEATS
+
+Because the current implementation uses the table and key sizes for the
+hashing algorithm, there is no means by which to dynamically change the
+value of any of the initialization parameters.
+
+=cut
+
+use Carp;
+
+sub TIEHASH {
+    my $pack = shift;
+    my ($klen, $vlen, $tsize) = @_;
+    my $rlen = 1 + $klen + $vlen;
+    $tsize = findprime($tsize * 1.1);	# Allow 10% empty.
+    $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
+    $$self[0] x= $rlen * $tsize;
+    $self;
+}
+
+sub FETCH {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    return substr($record, 1+$klen, $vlen);
+	}
+	&rehash;
+    }
+}
+
+sub STORE {
+    local($self,$key,$val) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    croak("Table is full") if $self[5] == $tsize;
+    croak(qq/Value "$val" is not $vlen characters long./)
+	if length($val) != $vlen;
+    my $writeoffset;
+
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    $writeoffset = $offset unless defined $writeoffset;
+	    substr($$self[0], $writeoffset, $rlen) = $record;
+	    ++$$self[5];
+	    return;
+	}
+	elsif (ord($record) == 1) {
+	    $writeoffset = $offset unless defined $writeoffset;
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    $record = "\2". $key . $val;
+	    die "panic" unless length($record) == $rlen;
+	    substr($$self[0], $offset, $rlen) = $record;
+	    return;
+	}
+	&rehash;
+    }
+}
+
+sub DELETE {
+    local($self,$key) = @_;
+    local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
+    &hashkey;
+    for (;;) {
+	$offset = $hash * $rlen;
+	$record = substr($$self[0], $offset, $rlen);
+	if (ord($record) == 0) {
+	    return undef;
+	}
+	elsif (ord($record) == 1) {
+	}
+	elsif (substr($record, 1, $klen) eq $key) {
+	    substr($$self[0], $offset, 1) = "\1";
+	    return substr($record, 1+$klen, $vlen);
+	    --$$self[5];
+	}
+	&rehash;
+    }
+}
+
+sub FIRSTKEY {
+    local($self) = @_;
+    $$self[6] = -1;
+    &NEXTKEY;
+}
+
+sub NEXTKEY {
+    local($self) = @_;
+    local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6];
+    for (++$iterix; $iterix < $tsize; ++$iterix) {
+	next unless substr($$self[0], $iterix * $rlen, 1) eq "\2";
+	$$self[6] = $iterix;
+	return substr($$self[0], $iterix * $rlen + 1, $klen);
+    }
+    $$self[6] = -1;
+    undef;
+}
+
+sub hashkey {
+    croak(qq/Key "$key" is not $klen characters long.\n/)
+	if length($key) != $klen;
+    $hash = 2;
+    for (unpack('C*', $key)) {
+	$hash = $hash * 33 + $_;
+    }
+    $hash = $hash - int($hash / $tsize) * $tsize
+	if $hash >= $tsize;
+    $hash = 1 unless $hash;
+    $hashbase = $hash;
+}
+
+sub rehash {
+    $hash += $hashbase;
+    $hash -= $tsize if $hash >= $tsize;
+}
+
+sub findprime {
+    use integer;
+
+    my $num = shift;
+    $num++ unless $num % 2;
+
+    $max = int sqrt $num;
+
+  NUM:
+    for (;; $num += 2) {
+	for ($i = 3; $i <= $max; $i += 2) {
+	    next NUM unless $num % $i;
+	}
+	return $num;
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/Time/Local.pm b/gnu/usr.bin/perl/lib/Time/Local.pm
new file mode 100644
index 00000000000..451c7fa20c7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Time/Local.pm
@@ -0,0 +1,112 @@
+package Time::Local;
+require 5.000;
+require Exporter;
+use Carp;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(timegm timelocal);
+
+=head1 NAME
+
+Time::Local - efficiently compute tome from local and GMT time
+
+=head1 SYNOPSIS
+
+    $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+    $time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+=head1 DESCRIPTION
+
+These routines are quite efficient and yet are always guaranteed to agree
+with localtime() and gmtime().  We manage this by caching the start times
+of any months we've seen before.  If we know the start time of the month,
+we can always calculate any time within the month.  The start times
+themselves are guessed by successive approximation starting at the
+current time, since most dates seen in practice are close to the
+current date.  Unlike algorithms that do a binary search (calling gmtime
+once for each bit of the time value, resulting in 32 calls), this algorithm
+calls it at most 6 times, and usually only once or twice.  If you hit
+the month cache, of course, it doesn't call it at all.
+
+timelocal is implemented using the same cache.  We just assume that we're
+translating a GMT time, and then fudge it when we're done for the timezone
+and daylight savings arguments.  The timezone is determined by examining
+the result of localtime(0) when the package is initialized.  The daylight
+savings offset is currently assumed to be one hour.
+
+Both routines return -1 if the integer limit is hit. I.e. for dates
+after the 1st of January, 2038 on most machines.
+
+=cut
+
+@epoch = localtime(0);
+$tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
+if ($tzmin > 0) {
+    $tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
+    $tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
+}
+
+$SEC = 1;
+$MIN = 60 * $SEC;
+$HR = 60 * $MIN;
+$DAYS = 24 * $HR;
+$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+
+sub timegm {
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    return -1 if $cheat<0;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    $time = &timegm + $tzmin*$MIN;
+    return -1 if $cheat<0;
+    @test = localtime($time);
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    croak "Month out of range 0..11 in timelocal.pl" 
+	if $month > 11 || $month < 0;
+    croak "Day out of range 1..31 in timelocal.pl" 
+	if $_[3] > 31 || $_[3] < 1;
+    croak "Hour out of range 0..23 in timelocal.pl"
+	if $_[2] > 23 || $_[2] < 0;
+    croak "Minute out of range 0..59 in timelocal.pl"
+	if $_[1] > 59 || $_[1] < 0;
+    croak "Second out of range 0..59 in timelocal.pl"
+	if $_[0] > 59 || $_[0] < 0;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
+    $lastguess = "";
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (363 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (27 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    @gfake = gmtime($guess-1); #still being sceptic
+    if ("@gfake" eq $lastguess){
+	return -1; #date beyond this machine's integer limit
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $cheat{$ym} = $guess;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/abbrev.pl b/gnu/usr.bin/perl/lib/abbrev.pl
new file mode 100644
index 00000000000..c233d4af7e6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/abbrev.pl
@@ -0,0 +1,33 @@
+;# Usage:
+;#	%foo = ();
+;#	&abbrev(*foo,LIST);
+;#	...
+;#	$long = $foo{$short};
+
+package abbrev;
+
+sub main'abbrev {
+    local(*domain) = @_;
+    shift(@_);
+    @cmp = @_;
+    local($[) = 0;
+    foreach $name (@_) {
+	@extra = split(//,$name);
+	$abbrev = shift(@extra);
+	$len = 1;
+	foreach $cmp (@cmp) {
+	    next if $cmp eq $name;
+	    while (substr($cmp,0,$len) eq $abbrev) {
+		$abbrev .= shift(@extra);
+		++$len;
+	    }
+	}
+	$domain{$abbrev} = $name;
+	while ($#extra >= 0) {
+	    $abbrev .= shift(@extra);
+	    $domain{$abbrev} = $name;
+	}
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/assert.pl b/gnu/usr.bin/perl/lib/assert.pl
new file mode 100644
index 00000000000..4c9ebf20a0d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/assert.pl
@@ -0,0 +1,55 @@
+# assert.pl
+# tchrist@convex.com (Tom Christiansen)
+# 
+# Usage:
+# 
+#     &assert('@x > @y');
+#     &assert('$var > 10', $var, $othervar, @various_info);
+# 
+# That is, if the first expression evals false, we blow up.  The
+# rest of the args, if any, are nice to know because they will
+# be printed out by &panic, which is just the stack-backtrace
+# routine shamelessly borrowed from the perl debugger.
+
+sub assert {
+    &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
+} 
+
+sub panic {
+    package DB;
+
+    select(STDERR);
+
+    print "\npanic: @_\n";
+
+    exit 1 if $] <= 4.003;  # caller broken
+
+    # stack traceback gratefully borrowed from perl debugger
+
+    local $_;
+    my $i;
+    my ($p,$f,$l,$s,$h,$a,@a,@frames);
+    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+	@a = @args;
+	for (@a) {
+	    if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+		$_ = sprintf("%s",$_);
+	    }
+	    else {
+		s/'/\\'/g;
+		s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+		s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    }
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	push(@frames, "$w&$s$a from file $f line $l\n");
+    }
+    for ($i=0; $i <= $#frames; $i++) {
+	print $frames[$i];
+    }
+    exit 1;
+} 
+
+1;
diff --git a/gnu/usr.bin/perl/lib/bigfloat.pl b/gnu/usr.bin/perl/lib/bigfloat.pl
new file mode 100644
index 00000000000..9ad171f295a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigfloat.pl
@@ -0,0 +1,233 @@
+package bigfloat;
+require "bigint.pl";
+# Arbitrary length float math package
+#
+# by Mark Biggar
+#
+# number format
+#   canonical strings have the form /[+-]\d+E[+-]\d+/
+#   Input values can have inbedded whitespace
+# Error returns
+#   'NaN'           An input parameter was "Not a Number" or 
+#                       divide by zero or sqrt of negative number
+# Division is computed to 
+#   max($div_scale,length(dividend)+length(divisor)) 
+#   digits by default.
+# Also used for default sqrt scale
+
+$div_scale = 40;
+
+# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
+
+$rnd_mode = 'even';
+
+#   bigfloat routines
+#
+#   fadd(NSTR, NSTR) return NSTR            addition
+#   fsub(NSTR, NSTR) return NSTR            subtraction
+#   fmul(NSTR, NSTR) return NSTR            multiplication
+#   fdiv(NSTR, NSTR[,SCALE]) returns NSTR   division to SCALE places
+#   fneg(NSTR) return NSTR                  negation
+#   fabs(NSTR) return NSTR                  absolute value
+#   fcmp(NSTR,NSTR) return CODE             compare undef,<0,=0,>0
+#   fround(NSTR, SCALE) return NSTR         round to SCALE digits
+#   ffround(NSTR, SCALE) return NSTR        round at SCALEth place
+#   fnorm(NSTR) return (NSTR)               normalize
+#   fsqrt(NSTR[, SCALE]) return NSTR        sqrt to SCALE places
+
+# Convert a number to canonical string form.
+#   Takes something that looks like a number and converts it to
+#   the form /^[+-]\d+E[+-]\d+$/.
+sub main'fnorm { #(string) return fnum_str
+    local($_) = @_;
+    s/\s+//g;                               # strip white space
+    if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') {
+	&norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6));
+    } else {
+	'NaN';
+    }
+}
+
+# normalize number -- for internal use
+sub norm { #(mantissa, exponent) return fnum_str
+    local($_, $exp) = @_;
+    if ($_ eq 'NaN') {
+	'NaN';
+    } else {
+	s/^([+-])0+/$1/;                        # strip leading zeros
+	if (length($_) == 1) {
+	    '+0E+0';
+	} else {
+	    $exp += length($1) if (s/(0+)$//);  # strip trailing zeros
+	    sprintf("%sE%+ld", $_, $exp);
+	}
+    }
+}
+
+# negation
+sub main'fneg { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[$[]);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
+    s/^H/N/;
+    $_;
+}
+
+# absolute value
+sub main'fabs { #(fnum_str) return fnum_str
+    local($_) = &'fnorm($_[$[]);
+    s/^-/+/;		                       # mash sign
+    $_;
+}
+
+# multiplication
+sub main'fmul { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	&norm(&'bmul($xm,$ym),$xe+$ye);
+    }
+}
+
+# addition
+sub main'fadd { #(fnum_str, fnum_str) return fnum_str
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye);
+	&norm(&'badd($ym,$xm.('0' x ($xe-$ye))),$ye);
+    }
+}
+
+# subtraction
+sub main'fsub { #(fnum_str, fnum_str) return fnum_str
+    &'fadd($_[$[],&'fneg($_[$[+1]));    
+}
+
+# division
+#   args are dividend, divisor, scale (optional)
+#   result has at most max(scale, length(dividend), length(divisor)) digits
+sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
+{
+    local($x,$y,$scale) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]),$_[$[+2]);
+    if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	local($ym,$ye) = split('E',$y);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if (length($xm)-1 > $scale);
+	$scale = length($ym)-1 if (length($ym)-1 > $scale);
+	$scale = $scale + length($ym) - length($xm);
+	&norm(&round(&'bdiv($xm.('0' x $scale),$ym),$ym),
+	    $xe-$ye-$scale);
+    }
+}
+
+# round int $q based on fraction $r/$base using $rnd_mode
+sub round { #(int_str, int_str, int_str) return int_str
+    local($q,$r,$base) = @_;
+    if ($q eq 'NaN' || $r eq 'NaN') {
+	'NaN';
+    } elsif ($rnd_mode eq 'trunc') {
+	$q;                         # just truncate
+    } else {
+	local($cmp) = &'bcmp(&'bmul($r,'+2'),$base);
+	if ( $cmp < 0 ||
+		 ($cmp == 0 &&
+		  ( $rnd_mode eq 'zero'                             ||
+		   ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
+		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
+		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
+	    $q;                     # round down
+	} else {
+	    &'badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
+				    # round up
+	}
+    }
+}
+
+# round the mantissa of $x to $scale digits
+sub main'fround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN' || $scale <= 0) {
+	$x;
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if (length($xm)-1 <= $scale) {
+	    $x;
+	} else {
+	    &norm(&round(substr($xm,$[,$scale+1),
+			 "+0".substr($xm,$[+$scale+1,1),"+10"),
+		  $xe+length($xm)-$scale-1);
+	}
+    }
+}
+
+# round $x at the 10 to the $scale digit place
+sub main'ffround { #(fnum_str, scale) return fnum_str
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } else {
+	local($xm,$xe) = split('E',$x);
+	if ($xe >= $scale) {
+	    $x;
+	} else {
+	    $xe = length($xm)+$xe-$scale;
+	    if ($xe < 1) {
+		'+0E+0';
+	    } elsif ($xe == 1) {
+		&norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale);
+	    } else {
+		&norm(&round(substr($xm,$[,$xe),
+		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
+	    }
+	}
+    }
+}
+    
+# compare 2 values returns one of undef, <0, =0, >0
+#   returns undef if either or both input value are not numbers
+sub main'fcmp #(fnum_str, fnum_str) return cond_code
+{
+    local($x, $y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
+    if ($x eq "NaN" || $y eq "NaN") {
+	undef;
+    } else {
+	ord($y) <=> ord($x)
+	||
+	(  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
+	     (($xe <=> $ye) * (substr($x,$[,1).'1')
+             || &bigint'cmp($xm,$ym))
+	);
+    }
+}
+
+# square root by Newtons method.
+sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
+    local($x, $scale) = (&'fnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN' || $x =~ /^-/) {
+	'NaN';
+    } elsif ($x eq '+0E+0') {
+	'+0E+0';
+    } else {
+	local($xm, $xe) = split('E',$x);
+	$scale = $div_scale if (!$scale);
+	$scale = length($xm)-1 if ($scale < length($xm)-1);
+	local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2));
+	while ($gs < 2*$scale) {
+	    $guess = &'fmul(&'fadd($guess,&'fdiv($x,$guess,$gs*2)),".5");
+	    $gs *= 2;
+	}
+	&'fround($guess, $scale);
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/bigint.pl b/gnu/usr.bin/perl/lib/bigint.pl
new file mode 100644
index 00000000000..e6ba644e3b3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigint.pl
@@ -0,0 +1,275 @@
+package bigint;
+
+# arbitrary size integer math package
+#
+# by Mark Biggar
+#
+# Canonical Big integer value are strings of the form
+#       /^[+-]\d+$/ with leading zeros suppressed
+# Input values to these routines may be strings of the form
+#       /^\s*[+-]?[\d\s]+$/.
+# Examples:
+#   '+0'                            canonical zero value
+#   '   -123 123 123'               canonical value '-123123123'
+#   '1 23 456 7890'                 canonical value '+1234567890'
+# Output values always always in canonical form
+#
+# Actual math is done in an internal format consisting of an array
+#   whose first element is the sign (/^[+-]$/) and whose remaining 
+#   elements are base 100000 digits with the least significant digit first.
+# The string 'NaN' is used to represent the result when input arguments 
+#   are not numbers, as well as the result of dividing by zero
+#
+# routines provided are:
+#
+#   bneg(BINT) return BINT              negation
+#   babs(BINT) return BINT              absolute value
+#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
+#   badd(BINT,BINT) return BINT         addition
+#   bsub(BINT,BINT) return BINT         subtraction
+#   bmul(BINT,BINT) return BINT         multiplication
+#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
+#   bmod(BINT,BINT) return BINT         modulus
+#   bgcd(BINT,BINT) return BINT         greatest common divisor
+#   bnorm(BINT) return BINT             normalization
+#
+
+$zero = 0;
+
+
+# normalize string form of number.   Strip leading zeros.  Strip any
+#   white space and add a sign, if missing.
+# Strings that are not numbers result the value 'NaN'.
+
+sub main'bnorm { #(num_str) return num_str
+    local($_) = @_;
+    s/\s+//g;                           # strip white space
+    if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
+	substr($_,$[,0) = '+' unless $1; # Add missing sign
+	s/^-0/+0/;
+	$_;
+    } else {
+	'NaN';
+    }
+}
+
+# Convert a number from string format to internal base 100000 format.
+#   Assumes normalized value as input.
+sub internal { #(num_str) return int_num_array
+    local($d) = @_;
+    ($is,$il) = (substr($d,$[,1),length($d)-2);
+    substr($d,$[,1) = '';
+    ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
+}
+
+# Convert a number from internal base 100000 format to string format.
+#   This routine scribbles all over input array.
+sub external { #(int_num_array) return num_str
+    $es = shift;
+    grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_);   # zero pad
+    &'bnorm(join('', $es, reverse(@_)));    # reverse concat and normalize
+}
+
+# Negate input value.
+sub main'bneg { #(num_str) return num_str
+    local($_) = &'bnorm(@_);
+    vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0';
+    s/^H/N/;
+    $_;
+}
+
+# Returns the absolute value of the input.
+sub main'babs { #(num_str) return num_str
+    &abs(&'bnorm(@_));
+}
+
+sub abs { # post-normalized abs for internal use
+    local($_) = @_;
+    s/^-/+/;
+    $_;
+}
+
+# Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
+sub main'bcmp { #(num_str, num_str) return cond_code
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	undef;
+    } elsif ($y eq 'NaN') {
+	undef;
+    } else {
+	&cmp($x,$y);
+    }
+}
+
+sub cmp { # post-normalized compare for internal use
+    local($cx, $cy) = @_;
+    $cx cmp $cy
+    &&
+    (
+	ord($cy) <=> ord($cx)
+	||
+	($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx)
+    );
+}
+
+sub main'badd { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);             # convert to internal form
+	@y = &internal($y);
+	local($sx, $sy) = (shift @x, shift @y); # get signs
+	if ($sx eq $sy) {
+	    &external($sx, &add(*x, *y)); # if same sign add
+	} else {
+	    ($x, $y) = (&abs($x),&abs($y)); # make abs
+	    if (&cmp($y,$x) > 0) {
+		&external($sy, &sub(*y, *x));
+	    } else {
+		&external($sx, &sub(*x, *y));
+	    }
+	}
+    }
+}
+
+sub main'bsub { #(num_str, num_str) return num_str
+    &'badd($_[$[],&'bneg($_[$[+1]));    
+}
+
+# GCD -- Euclids algorithm Knuth Vol 2 pg 296
+sub main'bgcd { #(num_str, num_str) return num_str
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
+    if ($x eq 'NaN' || $y eq 'NaN') {
+	'NaN';
+    } else {
+	($x, $y) = ($y,&'bmod($x,$y)) while $y ne '+0';
+	$x;
+    }
+}
+
+# routine to add two base 1e5 numbers
+#   stolen from Knuth Vol 2 Algorithm A pg 231
+#   there are separate routines to add and sub as per Kunth pg 233
+sub add { #(int_num_array, int_num_array) return int_num_array
+    local(*x, *y) = @_;
+    $car = 0;
+    for $x (@x) {
+	last unless @y || $car;
+	$x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5);
+    }
+    for $y (@y) {
+	last unless $car;
+	$y -= 1e5 if $car = (($y += $car) >= 1e5);
+    }
+    (@x, @y, $car);
+}
+
+# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+sub sub { #(int_num_array, int_num_array) return int_num_array
+    local(*sx, *sy) = @_;
+    $bar = 0;
+    for $sx (@sx) {
+	last unless @y || $bar;
+	$sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0);
+    }
+    @sx;
+}
+
+# multiply two numbers -- stolen from Knuth Vol 2 pg 233
+sub main'bmul { #(num_str, num_str) return num_str
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($y eq 'NaN') {
+	'NaN';
+    } else {
+	@x = &internal($x);
+	@y = &internal($y);
+	local($signr) = (shift @x ne shift @y) ? '-' : '+';
+	@prod = ();
+	for $x (@x) {
+	    ($car, $cty) = (0, $[);
+	    for $y (@y) {
+		$prod = $x * $y + $prod[$cty] + $car;
+		$prod[$cty++] =
+		    $prod - ($car = int($prod * 1e-5)) * 1e5;
+	    }
+	    $prod[$cty] += $car if $car;
+	    $x = shift @prod;
+	}
+	&external($signr, @x, @prod);
+    }
+}
+
+# modulus
+sub main'bmod { #(num_str, num_str) return num_str
+    (&'bdiv(@_))[$[+1];
+}
+
+sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
+    local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
+    return wantarray ? ('NaN','NaN') : 'NaN'
+	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
+    return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
+    @x = &internal($x); @y = &internal($y);
+    $srem = $y[$[];
+    $sr = (shift @x ne shift @y) ? '-' : '+';
+    $car = $bar = $prd = 0;
+    if (($dd = int(1e5/($y[$#y]+1))) != 1) {
+	for $x (@x) {
+	    $x = $x * $dd + $car;
+	    $x -= ($car = int($x * 1e-5)) * 1e5;
+	}
+	push(@x, $car); $car = 0;
+	for $y (@y) {
+	    $y = $y * $dd + $car;
+	    $y -= ($car = int($y * 1e-5)) * 1e5;
+	}
+    }
+    else {
+	push(@x, 0);
+    }
+    @q = (); ($v2,$v1) = @y[-2,-1];
+    while ($#x > $#y) {
+	($u2,$u1,$u0) = @x[-3..-1];
+	$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
+	--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
+	if ($q) {
+	    ($car, $bar) = (0,0);
+	    for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		$prd = $q * $y[$y] + $car;
+		$prd -= ($car = int($prd * 1e-5)) * 1e5;
+		$x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
+	    }
+	    if ($x[$#x] < $car + $bar) {
+		$car = 0; --$q;
+		for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
+		    $x[$x] -= 1e5
+			if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
+		}
+	    }   
+	}
+	pop(@x); unshift(@q, $q);
+    }
+    if (wantarray) {
+	@d = ();
+	if ($dd != 1) {
+	    $car = 0;
+	    for $x (reverse @x) {
+		$prd = $car * 1e5 + $x;
+		$car = $prd - ($tmp = int($prd / $dd)) * $dd;
+		unshift(@d, $tmp);
+	    }
+	}
+	else {
+	    @d = @x;
+	}
+	(&external($sr, @q), &external($srem, @d, $zero));
+    } else {
+	&external($sr, @q);
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/bigrat.pl b/gnu/usr.bin/perl/lib/bigrat.pl
new file mode 100644
index 00000000000..fb436ce5708
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/bigrat.pl
@@ -0,0 +1,149 @@
+package bigrat;
+require "bigint.pl";
+
+# Arbitrary size rational math package
+#
+# by Mark Biggar
+#
+# Input values to these routines consist of strings of the form 
+#   m|^\s*[+-]?[\d\s]+(/[\d\s]+)?$|.
+# Examples:
+#   "+0/1"                          canonical zero value
+#   "3"                             canonical value "+3/1"
+#   "   -123/123 123"               canonical value "-1/1001"
+#   "123 456/7890"                  canonical value "+20576/1315"
+# Output values always include a sign and no leading zeros or
+#   white space.
+# This package makes use of the bigint package.
+# The string 'NaN' is used to represent the result when input arguments 
+#   that are not numbers, as well as the result of dividing by zero and
+#       the sqrt of a negative number.
+# Extreamly naive algorthims are used.
+#
+# Routines provided are:
+#
+#   rneg(RAT) return RAT                negation
+#   rabs(RAT) return RAT                absolute value
+#   rcmp(RAT,RAT) return CODE           compare numbers (undef,<0,=0,>0)
+#   radd(RAT,RAT) return RAT            addition
+#   rsub(RAT,RAT) return RAT            subtraction
+#   rmul(RAT,RAT) return RAT            multiplication
+#   rdiv(RAT,RAT) return RAT            division
+#   rmod(RAT) return (RAT,RAT)          integer and fractional parts
+#   rnorm(RAT) return RAT               normalization
+#   rsqrt(RAT, cycles) return RAT       square root
+
+# Convert a number to the canonical string form m|^[+-]\d+/\d+|.
+sub main'rnorm { #(string) return rat_num
+    local($_) = @_;
+    s/\s+//g;
+    if (m#^([+-]?\d+)(/(\d*[1-9]0*))?$#) {
+	&norm($1, $3 ? $3 : '+1');
+    } else {
+	'NaN';
+    }
+}
+
+# Normalize by reducing to lowest terms
+sub norm { #(bint, bint) return rat_num
+    local($num,$dom) = @_;
+    if ($num eq 'NaN') {
+	'NaN';
+    } elsif ($dom eq 'NaN') {
+	'NaN';
+    } elsif ($dom =~ /^[+-]?0+$/) {
+	'NaN';
+    } else {
+	local($gcd) = &'bgcd($num,$dom);
+	$gcd =~ s/^-/+/;
+	if ($gcd ne '+1') { 
+	    $num = &'bdiv($num,$gcd);
+	    $dom = &'bdiv($dom,$gcd);
+	} else {
+	    $num = &'bnorm($num);
+	    $dom = &'bnorm($dom);
+	}
+	substr($dom,$[,1) = '';
+	"$num/$dom";
+    }
+}
+
+# negation
+sub main'rneg { #(rat_num) return rat_num
+    local($_) = &'rnorm(@_);
+    tr/-+/+-/ if ($_ ne '+0/1');
+    $_;
+}
+
+# absolute value
+sub main'rabs { #(rat_num) return $rat_num
+    local($_) = &'rnorm(@_);
+    substr($_,$[,1) = '+' unless $_ eq 'NaN';
+    $_;
+}
+
+# multipication
+sub main'rmul { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
+}
+
+# division
+sub main'rdiv { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
+}
+
+# addition
+sub main'radd { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# subtraction
+sub main'rsub { #(rat_num, rat_num) return rat_num
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
+}
+
+# comparison
+sub main'rcmp { #(rat_num, rat_num) return cond_code
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
+    &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
+}
+
+# int and frac parts
+sub main'rmod { #(rat_num) return (rat_num,rat_num)
+    local($xn,$xd) = split('/',&'rnorm(@_));
+    local($i,$f) = &'bdiv($xn,$xd);
+    if (wantarray) {
+	("$i/1", "$f/$xd");
+    } else {
+	"$i/1";
+    }   
+}
+
+# square root by Newtons method.
+#   cycles specifies the number of iterations default: 5
+sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
+    local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
+    if ($x eq 'NaN') {
+	'NaN';
+    } elsif ($x =~ /^-/) {
+	'NaN';
+    } else {
+	local($gscale, $guess) = (0, '+1/1');
+	$scale = 5 if (!$scale);
+	while ($gscale++ < $scale) {
+	    $guess = &'rmul(&'radd($guess,&'rdiv($x,$guess)),"+1/2");
+	}
+	"$guess";          # quotes necessary due to perl bug
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/cacheout.pl b/gnu/usr.bin/perl/lib/cacheout.pl
new file mode 100644
index 00000000000..48d594bf825
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/cacheout.pl
@@ -0,0 +1,46 @@
+# Open in their package.
+
+sub cacheout'open {
+    open($_[0], $_[1]);
+}
+
+# Close as well
+
+sub cacheout'close {
+    close($_[0]);
+}
+
+# But only this sub name is visible to them.
+
+sub cacheout {
+    package cacheout;
+
+    ($file) = @_;
+    if (!$isopen{$file}) {
+	if (++$numopen > $maxopen) {
+	    local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
+	    splice(@lru, $maxopen / 3);
+	    $numopen -= @lru;
+	    for (@lru) { &close($_); delete $isopen{$_}; }
+	}
+	&open($file, ($saw{$file}++ ? '>>' : '>') . $file)
+	    || die "Can't create $file: $!\n";
+    }
+    $isopen{$file} = ++$seq;
+}
+
+package cacheout;
+
+$seq = 0;
+$numopen = 0;
+
+if (open(PARAM,'/usr/include/sys/param.h')) {
+    local($.);
+    while (<PARAM>) {
+	$maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
+    }
+    close PARAM;
+}
+$maxopen = 16 unless $maxopen;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/chat2.inter b/gnu/usr.bin/perl/lib/chat2.inter
new file mode 100644
index 00000000000..6934f1cc285
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/chat2.inter
@@ -0,0 +1,495 @@
+Article 20992 of comp.lang.perl:
+Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!cs.utexas.edu!swrinde!ihnp4.ucsd.edu!ames!koriel!male.EBay.Sun.COM!jethro.Corp.Sun.COM!eric
+From: eric.arnold@sun.com (Eric Arnold)
+Newsgroups: comp.lang.perl
+Subject: Re: Need a bidirectional filter for interactive Unix applications
+Date: 15 Apr 94 21:24:03 GMT
+Organization: Sun Microsystems
+Lines: 478
+Sender: news@sun.com
+Message-ID: <ERIC.94Apr15212403@sun.com>
+References: <dgfCo9F2J.Jzw@netcom.com> <1994Apr15.110134.4581@chemabs.uucp>
+NNTP-Posting-Host: animus.corp.sun.com
+X-Newsreader: prn Ver 1.09
+In-reply-to: btf64@cas.org's message of Fri, 15 Apr 1994 11:01:34 GMT
+
+In article <1994Apr15.110134.4581@chemabs.uucp>
+	btf64@cas.org (Bernard T. French) writes:
+
+>In article <dgfCo9F2J.Jzw@netcom.com> dgf@netcom.com (David Feldman) writes:
+>>I need to write a bidirectional filter that would (ideally) sit between a
+..
+>>program's stdin & stdout to point to a pty pair known to perl. The perl app-
+>>lication would talk to the user's crt/keyboard, translate (application-specific)
+>>the input & output streams, and pass these as appropriate to/from the pty pair,
+..
+>
+>     I'm afraid I can't offer you a perl solution, but err..... there is a
+>Tcl solution.  There is a Tcl extension called "expect" that is designed to
+
+There *is* an old, established Perl solution:  "chat2.pl" which does
+everything (well, basically) "expect" does but you get it in the
+expressive Perl environment.  "chat2.pl" is delivered with the Perl
+source.
+
+Randal:  "interact()" still hasn't made it into Perl5alpha8
+"chat2.pl", so I've included a version which does.
+
+-Eric
+
+
+## chat.pl: chat with a server
+## V2.01.alpha.7 91/06/16
+## Randal L. Schwartz
+
+package chat;
+
+$sockaddr = 'S n a4 x8';
+chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4];
+$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+
+# *S = symbol for current I/O, gets assigned *chatsymbol....
+$next = "chatsymbol000000"; # next one
+$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
+
+
+## $handle = &chat'open_port("server.address",$port_number);
+## opens a named or numbered TCP server
+
+sub open_port { ## public
+	local($server, $port) = @_;
+
+	local($serveraddr,$serverproc);
+
+	*S = ++$next;
+	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+		$serveraddr = pack('C4', $1, $2, $3, $4);
+	} else {
+		local(@x) = gethostbyname($server);
+		return undef unless @x;
+		$serveraddr = $x[4];
+	}
+	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
+	unless (socket(S, 2, 1, 6)) {
+		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
+		# but who the heck would change these anyway? (:-)
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (bind(S, $thisproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (connect(S, $serverproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	select((select(S), $| = 1)[0]);
+	$next; # return symbol for switcharound
+}
+
+## ($host, $port, $handle) = &chat'open_listen([$port_number]);
+## opens a TCP port on the current machine, ready to be listened to
+## if $port_number is absent or zero, pick a default port number
+## process must be uid 0 to listen to a low port number
+
+sub open_listen { ## public
+
+	*S = ++$next;
+	local($thisport) = shift || 0;
+	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
+	local(*NS) = "__" . time;
+	unless (socket(NS, 2, 1, 6)) {
+		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
+		# but who the heck would change these anyway? (:-)
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (bind(NS, $thisproc_local)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (listen(NS, 1)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	select((select(NS), $| = 1)[0]);
+	local($family, $port, @myaddr) =
+		unpack("S n C C C C x8", getsockname(NS));
+	$S{"needs_accept"} = *NS; # so expect will open it
+	(@myaddr, $port, $next); # returning this
+}
+
+## $handle = &chat'open_proc("command","arg1","arg2",...);
+## opens a /bin/sh on a pseudo-tty
+
+sub open_proc { ## public
+	local(@cmd) = @_;
+
+	*S = ++$next;
+	local(*TTY) = "__TTY" . time;
+	local($pty,$tty,$pty_handle) = &_getpty(S,TTY);
+
+	#local($pty,$tty,$pty_handle) = &getpty(S,TTY);
+	#$Tty = $tty;
+
+	die "Cannot find a new pty" unless defined $pty;
+	local($pid) = fork;
+	die "Cannot fork: $!" unless defined $pid;
+	unless ($pid) {
+		close STDIN; close STDOUT; close STDERR;
+		#close($pty_handle);
+		setpgrp(0,$$);
+		if (open(DEVTTY, "/dev/tty")) {
+		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
+		    close DEVTTY;
+		}
+		open(STDIN,"<&TTY");
+		open(STDOUT,">&TTY");
+		open(STDERR,">&STDOUT");
+		die "Oops" unless fileno(STDERR) == 2;	# sanity
+		close(S);
+
+		exec @cmd;
+		die "Cannot exec @cmd: $!";
+	}
+	close(TTY);
+	$PID{$next} = $pid;
+	$next; # return symbol for switcharound
+
+}
+
+# $S is the read-ahead buffer
+
+## $return = &chat'expect([$handle,] $timeout_time,
+## 	$pat1, $body1, $pat2, $body2, ... )
+## $handle is from previous &chat'open_*().
+## $timeout_time is the time (either relative to the current time, or
+## absolute, ala time(2)) at which a timeout event occurs.
+## $pat1, $pat2, and so on are regexs which are matched against the input
+## stream.  If a match is found, the entire matched string is consumed,
+## and the corresponding body eval string is evaled.
+##
+## Each pat is a regular-expression (probably enclosed in single-quotes
+## in the invocation).  ^ and $ will work, respecting the current value of $*.
+## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
+## If pat is 'EOF', the body is executed if the process exits before
+## the other patterns are seen.
+##
+## Pats are scanned in the order given, so later pats can contain
+## general defaults that won't be examined unless the earlier pats
+## have failed.
+##
+## The result of eval'ing body is returned as the result of
+## the invocation.  Recursive invocations are not thought
+## through, and may work only accidentally. :-)
+##
+## undef is returned if either a timeout or an eof occurs and no
+## corresponding body has been defined.
+## I/O errors of any sort are treated as eof.
+
+$nextsubname = "expectloop000000"; # used for subroutines
+
+sub expect { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	local($endtime) = shift;
+
+	local($timeout,$eof) = (1,1);
+	local($caller) = caller;
+	local($rmask, $nfound, $timeleft, $thisbuf);
+	local($cases, $pattern, $action, $subname);
+	$endtime += time if $endtime < 600_000_000;
+
+	if (defined $S{"needs_accept"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_accept"};
+		delete $S{"needs_accept"};
+		$S{"needs_close"} = *NS;
+		unless(accept(S,NS)) {
+			($!) = ($!, close(S), close(NS));
+			return undef;
+		}
+		select((select(S), $| = 1)[0]);
+	}
+
+	# now see whether we need to create a new sub:
+
+	unless ($subname = $expect_subname{$caller,@_}) {
+		# nope.  make a new one:
+		$expect_subname{$caller,@_} = $subname = $nextsubname++;
+
+		$cases .= <<"EDQ"; # header is funny to make everything elsif's
+sub $subname {
+	LOOP: {
+		if (0) { ; }
+EDQ
+		while (@_) {
+			($pattern,$action) = splice(@_,0,2);
+			if ($pattern =~ /^eof$/i) {
+				$cases .= <<"EDQ";
+		elsif (\$eof) {
+	 		package $caller;
+			$action;
+		}
+EDQ
+				$eof = 0;
+			} elsif ($pattern =~ /^timeout$/i) {
+			$cases .= <<"EDQ";
+		elsif (\$timeout) {
+		 	package $caller;
+			$action;
+		}
+EDQ
+				$timeout = 0;
+			} else {
+				$pattern =~ s#/#\\/#g;
+			$cases .= <<"EDQ";
+		elsif (\$S =~ /$pattern/) {
+			\$S = \$';
+		 	package $caller;
+			$action;
+		}
+EDQ
+			}
+		}
+		$cases .= <<"EDQ" if $eof;
+		elsif (\$eof) {
+			undef;
+		}
+EDQ
+		$cases .= <<"EDQ" if $timeout;
+		elsif (\$timeout) {
+			undef;
+		}
+EDQ
+		$cases .= <<'ESQ';
+		else {
+			$rmask = "";
+			vec($rmask,fileno(S),1) = 1;
+			($nfound, $rmask) =
+		 		select($rmask, undef, undef, $endtime - time);
+			if ($nfound) {
+				$nread = sysread(S, $thisbuf, 1024);
+				if ($nread > 0) {
+					$S .= $thisbuf;
+				} else {
+					$eof++, redo LOOP; # any error is also eof
+				}
+			} else {
+				$timeout++, redo LOOP; # timeout
+			}
+			redo LOOP;
+		}
+	}
+}
+ESQ
+		eval $cases; die "$cases:\n$@" if $@;
+	}
+	$eof = $timeout = 0;
+	do $subname();
+}
+
+## &chat'print([$handle,] @data)
+## $handle is from previous &chat'open().
+## like print $handle @data
+
+sub print { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	print S @_;
+}
+
+## &chat'close([$handle,])
+## $handle is from previous &chat'open().
+## like close $handle
+
+sub close { ## public
+	local($pid);
+	if ($_[0] =~ /$nextpat/) {
+		$pid = $PID{$_[0]};
+	 	*S = shift;
+	} else {
+		$pid = $PID{$next};
+	}
+	close(S);
+	waitpid($pid,0);
+	if (defined $S{"needs_close"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_close"};
+		delete $S{"needs_close"};
+		close(NS);
+	}
+}
+
+## @ready_handles = &chat'select($timeout, @handles)
+## select()'s the handles with a timeout value of $timeout seconds.
+## Returns an array of handles that are ready for I/O.
+## Both user handles and chat handles are supported (but beware of
+## stdio's buffering for user handles).
+
+sub select { ## public
+	local($timeout) = shift;
+	local(@handles) = @_;
+	local(%handlename) = ();
+	local(%ready) = ();
+	local($caller) = caller;
+	local($rmask) = "";
+	for (@handles) {
+		if (/$nextpat/o) { # one of ours... see if ready
+			local(*SYM) = $_;
+			if (length($SYM)) {
+				$timeout = 0; # we have a winner
+				$ready{$_}++;
+			}
+			$handlename{fileno($_)} = $_;
+		} else {
+			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
+		}
+	}
+	for (sort keys %handlename) {
+		vec($rmask, $_, 1) = 1;
+	}
+	select($rmask, undef, undef, $timeout);
+	for (sort keys %handlename) {
+		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
+	}
+	sort keys %ready;
+}
+
+# ($pty,$tty) = $chat'_getpty(PTY,TTY):
+# internal procedure to get the next available pty.
+# opens pty on handle PTY, and matching tty on handle TTY.
+# returns undef if can't find a pty.
+
+sub _getpty { ## private
+	local($_PTY,$_TTY) = @_;
+	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	local($pty,$tty);
+	for $bank (112..127) {
+		next unless -e sprintf("/dev/pty%c0", $bank);
+		for $unit (48..57) {
+			$pty = sprintf("/dev/pty%c%c", $bank, $unit);
+			open($_PTY,"+>$pty") || next;
+			select((select($_PTY), $| = 1)[0]);
+			($tty = $pty) =~ s/pty/tty/;
+			open($_TTY,"+>$tty") || next;
+			select((select($_TTY), $| = 1)[0]);
+			system "stty nl>$tty";
+			return ($pty,$tty,$_PTY);
+		}
+	}
+	undef;
+}
+
+
+sub getpty {
+  local( $pty_handle, $tty_handle ) = @_;
+
+print "--------in getpty----------\n";
+  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+  $pty_handle =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+
+  #$pty_handle = ++$next_handle;
+  chop( @ptys = `ls /dev/pty*` );
+
+  for $pty ( @ptys )
+  {
+    open($pty_handle,"+>$pty") || next;
+    select((select($pty_handle), $| = 1)[0]);
+    ($tty = $pty) =~ s/pty/tty/;
+
+    open($tty_handle,"+>$tty") || next;
+    select((select($tty_handle), $| = 1)[0]);
+    ($tty = $pty) =~ s/pty/tty/;
+
+    return ($pty, $tty, $pty_handle );
+  }
+  return undef;
+}
+
+
+
+# from: Randal L. Schwartz
+
+# Usage:
+#
+# ($chathandle = &chat'open_proc("/bin/sh")) || die "cannot open shell";
+# system("stty cbreak raw -echo >/dev/tty\n");
+# &chat'interact($chathandle);
+# &chat'close($chathandle);
+# system("stty -cbreak -raw echo >/dev/tty\n");
+
+sub interact
+{
+  local( $chathandle ) = @_;
+
+  &chat'print($chathandle, "stty sane\n");
+  select(STDOUT) ; $| = 1; # unbuffer STDOUT
+
+  #print "tty=$Tty,whoami=",`whoami`,"\n";
+  #&change_utmp( "", $Tty, "eric", "", time() );
+
+  {
+    @ready = &chat'select(30, STDIN,$chathandle);
+    print "after select, ready=",join(",",@ready),"\n";
+    #(warn "[waiting]"), redo unless @ready;
+    if (grep($_ eq $chathandle, @ready)) {
+	    print "checking $chathandle\n";
+	    last unless $text = &chat'expect($chathandle,0,'[\s\S]+','$&');
+	    print "$chathandle OK\n";
+	    print "got=($text)";
+	    #print $text;
+    }
+    if (grep($_ eq STDIN, @ready)) {
+	    print "checking STDIN\n";
+	    last unless sysread(STDIN,$buf,1024) > 0;
+	    print "STDIN OK\n";
+	    &chat'print($chathandle,$buf);
+    }
+    redo;
+  }
+  #&change_utmp( $Tty, "$Tty", "", "", 0 );
+  print "leaving interact, \$!=$!\n";
+}
+
+## $handle = &chat'open_duphandle(handle);
+## duplicates an input file handle to conform to chat format
+
+sub open_duphandle { ## public
+    *S = ++$next;
+    open(S,"<&$_[0]");
+    $next; # return symbol for switcharound
+}
+
+#Here is an example which uses this routine.
+#
+#    # The following lines makes stdin unbuffered
+#    
+#    $BSD = -f '/vmunix';
+#    
+#    if ($BSD) {
+#        system "stty cbreak </dev/tty >/dev/tty 2>&1";
+#    }
+#    else {
+#        system "stty", '-icanon';
+#        system "stty", 'eol', '^A';
+#    }
+#
+#    require 'mychat2.pl';
+#    
+#    &chat'open_duphandle(STDIN);
+#    
+#    print 
+#    &chat'expect(3,
+#      '[A-Z]', '" :-)"',
+#      '.', '" :-("',
+#      TIMEOUT,  '"-o-"',
+#      EOF, '"\$\$"'),
+#    "\n";
+
+
+1;
+
+
diff --git a/gnu/usr.bin/perl/lib/chat2.pl b/gnu/usr.bin/perl/lib/chat2.pl
new file mode 100644
index 00000000000..0d9a7d3d503
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/chat2.pl
@@ -0,0 +1,368 @@
+# chat.pl: chat with a server
+# Based on: V2.01.alpha.7 91/06/16
+# Randal L. Schwartz (was <merlyn@stonehenge.com>)
+# multihome additions by A.Macpherson@bnr.co.uk
+# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
+
+package chat;
+
+require 'sys/socket.ph';
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+
+$sockaddr = 'S n a4 x8';
+chop($thishost = `hostname`);
+
+# *S = symbol for current I/O, gets assigned *chatsymbol....
+$next = "chatsymbol000000"; # next one
+$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
+
+
+## $handle = &chat'open_port("server.address",$port_number);
+## opens a named or numbered TCP server
+
+sub open_port { ## public
+	local($server, $port) = @_;
+
+	local($serveraddr,$serverproc);
+
+	# We may be multi-homed, start with 0, fixup once connexion is made
+	$thisaddr = "\0\0\0\0" ;
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+
+	*S = ++$next;
+	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
+		$serveraddr = pack('C4', $1, $2, $3, $4);
+	} else {
+		local(@x) = gethostbyname($server);
+		return undef unless @x;
+		$serveraddr = $x[4];
+	}
+	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
+	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (bind(S, $thisproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+	unless (connect(S, $serverproc)) {
+		($!) = ($!, close(S)); # close S while saving $!
+		return undef;
+	}
+# We opened with the local address set to ANY, at this stage we know
+# which interface we are using.  This is critical if our machine is
+# multi-homed, with IP forwarding off, so fix-up.
+	local($fam,$lport);
+	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+# end of post-connect fixup
+	select((select(S), $| = 1)[0]);
+	$next; # return symbol for switcharound
+}
+
+## ($host, $port, $handle) = &chat'open_listen([$port_number]);
+## opens a TCP port on the current machine, ready to be listened to
+## if $port_number is absent or zero, pick a default port number
+## process must be uid 0 to listen to a low port number
+
+sub open_listen { ## public
+
+	*S = ++$next;
+	local($thisport) = shift || 0;
+	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
+	local(*NS) = "__" . time;
+	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (bind(NS, $thisproc_local)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	unless (listen(NS, 1)) {
+		($!) = ($!, close(NS));
+		return undef;
+	}
+	select((select(NS), $| = 1)[0]);
+	local($family, $port, @myaddr) =
+		unpack("S n C C C C x8", getsockname(NS));
+	$S{"needs_accept"} = *NS; # so expect will open it
+	(@myaddr, $port, $next); # returning this
+}
+
+## $handle = &chat'open_proc("command","arg1","arg2",...);
+## opens a /bin/sh on a pseudo-tty
+
+sub open_proc { ## public
+	local(@cmd) = @_;
+
+	*S = ++$next;
+	local(*TTY) = "__TTY" . time;
+	local($pty,$tty) = &_getpty(S,TTY);
+	die "Cannot find a new pty" unless defined $pty;
+	$pid = fork;
+	die "Cannot fork: $!" unless defined $pid;
+	unless ($pid) {
+		close STDIN; close STDOUT; close STDERR;
+		setpgrp(0,$$);
+		if (open(DEVTTY, "/dev/tty")) {
+		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
+		    close DEVTTY;
+		}
+		open(STDIN,"<&TTY");
+		open(STDOUT,">&TTY");
+		open(STDERR,">&STDOUT");
+		die "Oops" unless fileno(STDERR) == 2;	# sanity
+		close(S);
+		exec @cmd;
+		die "Cannot exec @cmd: $!";
+	}
+	close(TTY);
+	$next; # return symbol for switcharound
+}
+
+# $S is the read-ahead buffer
+
+## $return = &chat'expect([$handle,] $timeout_time,
+## 	$pat1, $body1, $pat2, $body2, ... )
+## $handle is from previous &chat'open_*().
+## $timeout_time is the time (either relative to the current time, or
+## absolute, ala time(2)) at which a timeout event occurs.
+## $pat1, $pat2, and so on are regexs which are matched against the input
+## stream.  If a match is found, the entire matched string is consumed,
+## and the corresponding body eval string is evaled.
+##
+## Each pat is a regular-expression (probably enclosed in single-quotes
+## in the invocation).  ^ and $ will work, respecting the current value of $*.
+## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
+## If pat is 'EOF', the body is executed if the process exits before
+## the other patterns are seen.
+##
+## Pats are scanned in the order given, so later pats can contain
+## general defaults that won't be examined unless the earlier pats
+## have failed.
+##
+## The result of eval'ing body is returned as the result of
+## the invocation.  Recursive invocations are not thought
+## through, and may work only accidentally. :-)
+##
+## undef is returned if either a timeout or an eof occurs and no
+## corresponding body has been defined.
+## I/O errors of any sort are treated as eof.
+
+$nextsubname = "expectloop000000"; # used for subroutines
+
+sub expect { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	local($endtime) = shift;
+
+	local($timeout,$eof) = (1,1);
+	local($caller) = caller;
+	local($rmask, $nfound, $timeleft, $thisbuf);
+	local($cases, $pattern, $action, $subname);
+	$endtime += time if $endtime < 600_000_000;
+
+	if (defined $S{"needs_accept"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_accept"};
+		delete $S{"needs_accept"};
+		$S{"needs_close"} = *NS;
+		unless(accept(S,NS)) {
+			($!) = ($!, close(S), close(NS));
+			return undef;
+		}
+		select((select(S), $| = 1)[0]);
+	}
+
+	# now see whether we need to create a new sub:
+
+	unless ($subname = $expect_subname{$caller,@_}) {
+		# nope.  make a new one:
+		$expect_subname{$caller,@_} = $subname = $nextsubname++;
+
+		$cases .= <<"EDQ"; # header is funny to make everything elsif's
+sub $subname {
+	LOOP: {
+		if (0) { ; }
+EDQ
+		while (@_) {
+			($pattern,$action) = splice(@_,0,2);
+			if ($pattern =~ /^eof$/i) {
+				$cases .= <<"EDQ";
+		elsif (\$eof) {
+	 		package $caller;
+			$action;
+		}
+EDQ
+				$eof = 0;
+			} elsif ($pattern =~ /^timeout$/i) {
+			$cases .= <<"EDQ";
+		elsif (\$timeout) {
+		 	package $caller;
+			$action;
+		}
+EDQ
+				$timeout = 0;
+			} else {
+				$pattern =~ s#/#\\/#g;
+			$cases .= <<"EDQ";
+		elsif (\$S =~ /$pattern/) {
+			\$S = \$';
+		 	package $caller;
+			$action;
+		}
+EDQ
+			}
+		}
+		$cases .= <<"EDQ" if $eof;
+		elsif (\$eof) {
+			undef;
+		}
+EDQ
+		$cases .= <<"EDQ" if $timeout;
+		elsif (\$timeout) {
+			undef;
+		}
+EDQ
+		$cases .= <<'ESQ';
+		else {
+			$rmask = "";
+			vec($rmask,fileno(S),1) = 1;
+			($nfound, $rmask) =
+		 		select($rmask, undef, undef, $endtime - time);
+			if ($nfound) {
+				$nread = sysread(S, $thisbuf, 1024);
+				if ($nread > 0) {
+					$S .= $thisbuf;
+				} else {
+					$eof++, redo LOOP; # any error is also eof
+				}
+			} else {
+				$timeout++, redo LOOP; # timeout
+			}
+			redo LOOP;
+		}
+	}
+}
+ESQ
+		eval $cases; die "$cases:\n$@" if $@;
+	}
+	$eof = $timeout = 0;
+	do $subname();
+}
+
+## &chat'print([$handle,] @data)
+## $handle is from previous &chat'open().
+## like print $handle @data
+
+sub print { ## public
+	if ($_[0] =~ /$nextpat/) {
+		*S = shift;
+	}
+	print S @_;
+	if( $chat'debug ){
+		print STDERR "printed:";
+		print STDERR @_;
+	}
+}
+
+## &chat'close([$handle,])
+## $handle is from previous &chat'open().
+## like close $handle
+
+sub close { ## public
+	if ($_[0] =~ /$nextpat/) {
+	 	*S = shift;
+	}
+	close(S);
+	if (defined $S{"needs_close"}) { # is it a listen socket?
+		local(*NS) = $S{"needs_close"};
+		delete $S{"needs_close"};
+		close(NS);
+	}
+}
+
+## @ready_handles = &chat'select($timeout, @handles)
+## select()'s the handles with a timeout value of $timeout seconds.
+## Returns an array of handles that are ready for I/O.
+## Both user handles and chat handles are supported (but beware of
+## stdio's buffering for user handles).
+
+sub select { ## public
+	local($timeout) = shift;
+	local(@handles) = @_;
+	local(%handlename) = ();
+	local(%ready) = ();
+	local($caller) = caller;
+	local($rmask) = "";
+	for (@handles) {
+		if (/$nextpat/o) { # one of ours... see if ready
+			local(*SYM) = $_;
+			if (length($SYM)) {
+				$timeout = 0; # we have a winner
+				$ready{$_}++;
+			}
+			$handlename{fileno($_)} = $_;
+		} else {
+			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
+		}
+	}
+	for (sort keys %handlename) {
+		vec($rmask, $_, 1) = 1;
+	}
+	select($rmask, undef, undef, $timeout);
+	for (sort keys %handlename) {
+		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
+	}
+	sort keys %ready;
+}
+
+# ($pty,$tty) = $chat'_getpty(PTY,TTY):
+# internal procedure to get the next available pty.
+# opens pty on handle PTY, and matching tty on handle TTY.
+# returns undef if can't find a pty.
+# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
+
+sub _getpty { ## private
+	local($_PTY,$_TTY) = @_;
+	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
+	local($pty, $tty, $kind);
+	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
+		$kind = "pts";		## SVR4 Streams
+	} else {
+		$kind = "pty";		## BSD Clist stuff
+	}
+	for $bank (112..127) {
+		next unless -e sprintf("/dev/$kind%c0", $bank);
+		for $unit (48..57) {
+			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
+			open($_PTY,"+>$pty") || next;
+			select((select($_PTY), $| = 1)[0]);
+			($tty = $pty) =~ s/pty/tty/;
+			open($_TTY,"+>$tty") || next;
+			select((select($_TTY), $| = 1)[0]);
+			system "stty nl>$tty";
+			return ($pty,$tty);
+		}
+	}
+	undef;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/complete.pl b/gnu/usr.bin/perl/lib/complete.pl
new file mode 100644
index 00000000000..1e08f9145ae
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/complete.pl
@@ -0,0 +1,110 @@
+;#
+;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
+;#
+;# Author: Wayne Thompson
+;#
+;# Description:
+;#     This routine provides word completion.
+;#     (TAB) attempts word completion.
+;#     (^D)  prints completion list.
+;#      (These may be changed by setting $Complete'complete, etc.)
+;#
+;# Diagnostics:
+;#     Bell when word completion fails.
+;#
+;# Dependencies:
+;#     The tty driver is put into raw mode.
+;#
+;# Bugs:
+;#
+;# Usage:
+;#     $input = &Complete('prompt_string', *completion_list);
+;#         or
+;#     $input = &Complete('prompt_string', @completion_list);
+;#
+
+CONFIG: {
+    package Complete;
+
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
+}
+
+sub Complete {
+    package Complete;
+
+    local($[,$return) = 0;
+    if ($_[1] =~ /^StB\0/) {
+        ($prompt, *_) = @_;
+    }
+    else {
+        $prompt = shift(@_);
+    }
+    @cmp_lst = sort(@_);
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef($r, $return);
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
+    }
+    system('stty -raw echo');
+    print("\n");
+    $return;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ctime.pl b/gnu/usr.bin/perl/lib/ctime.pl
new file mode 100644
index 00000000000..14e122adda0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ctime.pl
@@ -0,0 +1,51 @@
+;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
+;#
+;# Waldemar Kebsch, Federal Republic of Germany, November 1988
+;# kebsch.pad@nixpbe.UUCP
+;# Modified March 1990, Feb 1991 to properly handle timezones
+;#  $RCSfile: ctime.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:47 $
+;#   Marion Hakanson (hakanson@cse.ogi.edu)
+;#   Oregon Graduate Institute of Science and Technology
+;#
+;# usage:
+;#
+;#     #include <ctime.pl>          # see the -P and -I option in perl.man
+;#     $Date = &ctime(time);
+
+CONFIG: {
+    package ctime;
+
+    @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+    @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
+	    'Jul','Aug','Sep','Oct','Nov','Dec');
+}
+
+sub ctime {
+    package ctime;
+
+    local($time) = @_;
+    local($[) = 0;
+    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
+
+    # Determine what time zone is in effect.
+    # Use GMT if TZ is defined as null, local time if TZ undefined.
+    # There's no portable way to find the system default timezone.
+
+    $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
+    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+        ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
+
+    # Hack to deal with 'PST8PDT' format of TZ
+    # Note that this can't deal with all the esoteric forms, but it
+    # does recognize the most common: [:]STDoff[DST[off][,rule]]
+
+    if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
+        $TZ = $isdst ? $4 : $1;
+    }
+    $TZ .= ' ' unless $TZ eq '';
+
+    $year += 1900;
+    sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
+      $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/diagnostics.pm b/gnu/usr.bin/perl/lib/diagnostics.pm
new file mode 100644
index 00000000000..3560f2d708d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/diagnostics.pm
@@ -0,0 +1,507 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if 0;
+
+use Config;
+if ($^O eq 'VMS') {
+   $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlib'}) .
+                           '/pod/perldiag.pod';
+}
+else { $diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod"; }
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    local($Carp::CarpLevel) = 1;
+    confess "Uncaught exception from user code:\n\t$exception";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
diff --git a/gnu/usr.bin/perl/lib/dotsh.pl b/gnu/usr.bin/perl/lib/dotsh.pl
new file mode 100644
index 00000000000..8e9d9620e59
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/dotsh.pl
@@ -0,0 +1,67 @@
+#
+#   @(#)dotsh.pl                                               03/19/94
+#
+#   Author: Charles Collins
+#
+#   Description:
+#      This routine takes a shell script and 'dots' it into the current perl
+#      environment. This makes it possible to use existing system scripts
+#      to alter environment variables on the fly.
+#
+#   Usage:
+#      &dotsh ('ShellScript', 'DependentVariable(s)');
+#
+#         where
+#
+#      'ShellScript' is the full name of the shell script to be dotted
+#
+#      'DependentVariable(s)' is an optional list of shell variables in the
+#         form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is
+#         dependent upon. These variables MUST be defined using shell syntax.
+#
+#   Example:
+#      &dotsh ('/tmp/foo', 'arg1');
+#      &dotsh ('/tmp/foo');
+#      &dotsh ('/tmp/foo arg1 ... argN');
+#
+sub dotsh {
+   local(@sh) = @_;
+   local($tmp,$key,$shell,*dotsh,$command,$args,$vars) = '';
+   $dotsh = shift(@sh);
+   @dotsh = split (/\s/, $dotsh);
+   $command = shift (@dotsh);
+   $args = join (" ", @dotsh);
+   $vars = join ("\n", @sh);
+   open (_SH_ENV, "$command") || die "Could not open $dotsh!\n";
+   chop($_ = <_SH_ENV>);
+   $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/);
+   close (_SH_ENV);
+   if (!$shell) {
+      if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/csh$/) {
+	 $shell = "$ENV{'SHELL'} -c";
+      } else {
+	 print "SHELL not recognized!\nUsing /bin/sh...\n";
+	 $shell = "/bin/sh -c";
+      }
+   }
+   if (length($vars) > 0) {
+      system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\"";
+   } else {
+      system "$shell \". $command $args; set > /tmp/_sh_env$$\"";
+   }
+
+   open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n";
+   while (<_SH_ENV>) {
+       chop;
+       /=/;
+       $ENV{$`} = $';
+   }
+   close (_SH_ENV);
+   system "rm -f /tmp/_sh_env$$";
+
+   foreach $key (keys(%ENV)) {
+       $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
+   }
+   eval $tmp;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/dumpvar.pl b/gnu/usr.bin/perl/lib/dumpvar.pl
new file mode 100644
index 00000000000..06c09305816
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/dumpvar.pl
@@ -0,0 +1,408 @@
+require 5.002;			# For (defined ref)
+package dumpvar;
+
+# Needed for PrettyPrinter only:
+
+# require 5.001;  # Well, it coredumps anyway undef DB in 5.000 (not now)
+
+# translate control chars to ^X - Randal Schwartz
+# Modifications to print types by Peter Gordon v1.0
+
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+# Won't dump symbol tables and contents of debugged files by default
+
+$winsize = 80 unless defined $winsize;
+
+
+# Defaults
+
+# $globPrint = 1;
+$printUndef = 1 unless defined $printUndef;
+$tick = "auto" unless defined $tick;
+$unctrl = 'quote' unless defined $unctrl;
+$subdump = 1;
+
+sub main::dumpValue {
+  local %address;
+  (print "undef\n"), return unless defined $_[0];
+  (print &stringify($_[0]), "\n"), return unless ref $_[0];
+  dumpvar::unwrap($_[0],0);
+}
+
+# This one is good for variable names:
+
+sub unctrl {
+	local($_) = @_;
+	local($v) ; 
+
+	return \$_ if ref \$_ eq "GLOB";
+	s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+	$_;
+}
+
+sub stringify {
+	local($_,$noticks) = @_;
+	local($v) ; 
+	my $tick = $tick;
+
+	return 'undef' unless defined $_ or not $printUndef;
+	return $_ . "" if ref \$_ eq 'GLOB';
+	if ($tick eq 'auto') {
+	  if (/[\000-\011\013-\037\177]/) {
+	    $tick = '"';
+	  }else {
+	    $tick = "'";
+	  }
+	}
+	if ($tick eq "'") {
+	  s/([\'\\])/\\$1/g;
+	} elsif ($unctrl eq 'unctrl') {
+	  s/([\"\\])/\\$1/g ;
+	  s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+	  s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg 
+	    if $quoteHighBit;
+	} elsif ($unctrl eq 'quote') {
+	  s/([\"\\\$\@])/\\$1/g if $tick eq '"';
+	  s/\033/\\e/g;
+	  s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
+	}
+	s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $quoteHighBit;
+	($noticks || /^\d+(\.\d*)?\Z/) 
+	  ? $_ 
+	  : $tick . $_ . $tick;
+}
+
+sub ShortArray {
+  my $tArrayDepth = $#{$_[0]} ; 
+  $tArrayDepth = $#{$_[0]} < $arrayDepth-1 ? $#{$_[0]} : $arrayDepth-1 
+    unless  $arrayDepth eq '' ; 
+  my $shortmore = "";
+  $shortmore = " ..." if $tArrayDepth < $#{$_[0]} ;
+  if (!grep(ref $_, @{$_[0]})) {
+    $short = "0..$#{$_[0]}  '" . 
+      join("' '", @{$_[0]}[0..$tArrayDepth]) . "'$shortmore";
+    return $short if length $short <= $compactDump;
+  }
+  undef;
+}
+
+sub DumpElem {
+  my $short = &stringify($_[0], ref $_[0]);
+  if ($veryCompact && ref $_[0]
+      && (ref $_[0] eq 'ARRAY' and !grep(ref $_, @{$_[0]}) )) {
+    my $end = "0..$#{$v}  '" . 
+      join("' '", @{$_[0]}[0..$tArrayDepth]) . "'$shortmore";
+  } elsif ($veryCompact && ref $_[0]
+      && (ref $_[0] eq 'HASH') and !grep(ref $_, values %{$_[0]})) {
+    my $end = 1;
+	  $short = $sp . "0..$#{$v}  '" . 
+	    join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
+  } else {
+    print "$short\n";
+    unwrap($_[0],$_[1]);
+  }
+}
+
+sub unwrap {
+    return if $DB::signal;
+    local($v) = shift ; 
+    local($s) = shift ; # extra no of spaces
+    local(%v,@v,$sp,$value,$key,$type,@sortKeys,$more,$shortmore,$short) ;
+    local($tHashDepth,$tArrayDepth) ;
+
+    $sp = " " x $s ;
+    $s += 3 ; 
+
+    # Check for reused addresses
+    if (ref $v) { 
+      ($address) = $v =~ /(0x[0-9a-f]+)/ ; 
+      if (defined $address) { 
+	($type) = $v =~ /=(.*?)\(/ ;
+	$address{$address}++ ;
+	if ( $address{$address} > 1 ) { 
+	  print "${sp}-> REUSED_ADDRESS\n" ; 
+	  return ; 
+	} 
+      }
+    } elsif (ref \$v eq 'GLOB') {
+      $address = "$v" . "";	# To avoid a bug with globs
+      $address{$address}++ ;
+      if ( $address{$address} > 1 ) { 
+	print "${sp}*DUMPED_GLOB*\n" ; 
+	return ; 
+      } 
+    }
+
+    if ( ref $v eq 'HASH' or $type eq 'HASH') { 
+	@sortKeys = sort keys(%$v) ;
+	undef $more ; 
+	$tHashDepth = $#sortKeys ; 
+	$tHashDepth = $#sortKeys < $hashDepth-1 ? $#sortKeys : $hashDepth-1
+	  unless $hashDepth eq '' ; 
+	$more = "....\n" if $tHashDepth < $#sortKeys ; 
+	$shortmore = "";
+	$shortmore = ", ..." if $tHashDepth < $#sortKeys ; 
+	$#sortKeys = $tHashDepth ; 
+	if ($compactDump && !grep(ref $_, values %{$v})) {
+	  #$short = $sp . 
+	  #  (join ', ', 
+# Next row core dumps during require from DB on 5.000, even with map {"_"}
+	  #   map {&stringify($_) . " => " . &stringify($v->{$_})} 
+	  #   @sortKeys) . "'$shortmore";
+	  $short = $sp;
+	  my @keys;
+	  for (@sortKeys) {
+	    push @keys, &stringify($_) . " => " . &stringify($v->{$_});
+	  }
+	  $short .= join ', ', @keys;
+	  $short .= $shortmore;
+	  (print "$short\n"), return if length $short <= $compactDump;
+	}
+	for $key (@sortKeys) {
+	    return if $DB::signal;
+	    $value = $ {$v}{$key} ;
+	    print "$sp", &stringify($key), " => ";
+	    DumpElem $value, $s;
+	}
+	print "$sp  empty hash\n" unless @sortKeys;
+	print "$sp$more" if defined $more ;
+    } elsif ( ref $v eq 'ARRAY' or $type eq 'ARRAY') { 
+	$tArrayDepth = $#{$v} ; 
+	undef $more ; 
+	$tArrayDepth = $#{$v} < $arrayDepth-1 ? $#{$v} : $arrayDepth-1 
+	  unless  $arrayDepth eq '' ; 
+	$more = "....\n" if $tArrayDepth < $#{$v} ; 
+	$shortmore = "";
+	$shortmore = " ..." if $tArrayDepth < $#{$v} ;
+	if ($compactDump && !grep(ref $_, @{$v})) {
+	  if ($#$v >= 0) {
+	    $short = $sp . "0..$#{$v}  " . 
+	      join(" ", 
+		   map {stringify $_} @{$v}[0..$tArrayDepth])
+		. "$shortmore";
+	  } else {
+	    $short = $sp . "empty array";
+	  }
+	  (print "$short\n"), return if length $short <= $compactDump;
+	}
+	#if ($compactDump && $short = ShortArray($v)) {
+	#  print "$short\n";
+	#  return;
+	#}
+	for $num ($[ .. $tArrayDepth) {
+	    return if $DB::signal;
+	    print "$sp$num  ";
+	    DumpElem $v->[$num], $s;
+	}
+	print "$sp  empty array\n" unless @$v;
+	print "$sp$more" if defined $more ;  
+    } elsif ( ref $v eq 'SCALAR' or ref $v eq 'REF' or $type eq 'SCALAR' ) { 
+	    print "$sp-> ";
+	    DumpElem $$v, $s;
+    } elsif ( ref $v eq 'CODE' or $type eq 'CODE' ) { 
+	    print "$sp-> ";
+	    dumpsub (0, $v);
+    } elsif (ref $v eq 'GLOB') {
+      print "$sp-> ",&stringify($$v,1),"\n";
+      if ($globPrint) {
+	$s += 3;
+	dumpglob($s, "{$$v}", $$v, 1);
+      } elsif (defined ($fileno = fileno($v))) {
+	print( (' ' x ($s+3)) .  "FileHandle({$$v}) => fileno($fileno)\n" );
+      }
+    } elsif (ref \$v eq 'GLOB') {
+      if ($globPrint) {
+	dumpglob($s, "{$v}", $v, 1) if $globPrint;
+      } elsif (defined ($fileno = fileno(\$v))) {
+	print( (' ' x $s) .  "FileHandle({$v}) => fileno($fileno)\n" );
+      }
+    }
+}
+
+sub matchvar {
+  $_[0] eq $_[1] or 
+    ($_[1] =~ /^([!~])(.)/) and 
+      ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$'/});
+}
+
+sub compactDump {
+  $compactDump = shift if @_;
+  $compactDump = 6*80-1 if $compactDump and $compactDump < 2;
+  $compactDump;
+}
+
+sub veryCompact {
+  $veryCompact = shift if @_;
+  compactDump(1) if !$compactDump and $veryCompact;
+  $veryCompact;
+}
+
+sub unctrlSet {
+  if (@_) {
+    my $in = shift;
+    if ($in eq 'unctrl' or $in eq 'quote') {
+      $unctrl = $in;
+    } else {
+      print "Unknown value for `unctrl'.\n";
+    }
+  }
+  $unctrl;
+}
+
+sub quote {
+  if (@_ and $_[0] eq '"') {
+    $tick = '"';
+    $unctrl = 'quote';
+  } elsif (@_ and $_[0] eq 'auto') {
+    $tick = 'auto';
+    $unctrl = 'quote';
+  } elsif (@_) {		# Need to set
+    $tick = "'";
+    $unctrl = 'unctrl';
+  }
+  $tick;
+}
+
+sub dumpglob {
+    return if $DB::signal;
+    my ($off,$key, $val, $all) = @_;
+    local(*entry) = $val;
+    my $fileno;
+    if (($key !~ /^_</ or $dumpDBFiles) and defined $entry) {
+      print( (' ' x $off) . "\$", &unctrl($key), " = " );
+      DumpElem $entry, 3+$off;
+    }
+    if (($key !~ /^_</ or $dumpDBFiles) and defined @entry) {
+      print( (' ' x $off) . "\@$key = (\n" );
+      unwrap(\@entry,3+$off) ;
+      print( (' ' x $off) .  ")\n" );
+    }
+    if ($key ne "main::" && $key ne "DB::" && defined %entry
+	&& ($dumpPackages or $key !~ /::$/)
+	&& ($key !~ /^_</ or $dumpDBFiles)
+	&& !($package eq "dumpvar" and $key eq "stab")) {
+      print( (' ' x $off) . "\%$key = (\n" );
+      unwrap(\%entry,3+$off) ;
+      print( (' ' x $off) .  ")\n" );
+    }
+    if (defined ($fileno = fileno(*entry))) {
+      print( (' ' x $off) .  "FileHandle($key) => fileno($fileno)\n" );
+    }
+    if ($all) {
+      if (defined &entry) {
+	dumpsub($off, $key);
+      }
+    }
+}
+
+sub dumpsub {
+    my ($off,$sub) = @_;
+    $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
+    my $subref = \&$sub;
+    my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub})
+      || ($subdump && ($sub = findsubs("$subref")) && $DB::sub{$sub});
+    $place = '???' unless defined $place;
+    print( (' ' x $off) .  "&$sub in $place\n" );
+}
+
+sub findsubs {
+  return undef unless defined %DB::sub;
+  my ($addr, $name, $loc);
+  while (($name, $loc) = each %DB::sub) {
+    $addr = \&$name;
+    $subs{"$addr"} = $name;
+  }
+  $subdump = 0;
+  $subs{ shift() };
+}
+
+sub main::dumpvar {
+    my ($package,@vars) = @_;
+    local(%address,$key,$val);
+    $package .= "::" unless $package =~ /::$/;
+    *stab = *{"main::"};
+    while ($package =~ /(\w+?::)/g){
+      *stab = $ {stab}{$1};
+    }
+    local $TotalStrings = 0;
+    local $Strings = 0;
+    local $CompleteTotal = 0;
+    while (($key,$val) = each(%stab)) {
+      return if $DB::signal;
+      next if @vars && !grep( matchvar($key, $_), @vars );
+      if ($usageOnly) {
+	globUsage(\$val, $key) unless $package eq 'dumpvar' and $key eq 'stab';
+      } else {
+	dumpglob(0,$key, $val);
+      }
+    }
+    if ($usageOnly) {
+      print "String space: $TotalStrings bytes in $Strings strings.\n";
+      $CompleteTotal += $TotalStrings;
+      print "Grand total = $CompleteTotal bytes (1 level deep) + overhead.\n";
+    }
+}
+
+sub scalarUsage {
+  my $size = length($_[0]);
+  $TotalStrings += $size;
+  $Strings++;
+  $size;
+}
+
+sub arrayUsage {		# array ref, name
+  my $size = 0;
+  map {$size += scalarUsage($_)} @{$_[0]};
+  my $len = @{$_[0]};
+  print "\@$_[1] = $len item", ($len > 1 ? "s" : ""),
+    " (data: $size bytes)\n"
+      if defined $_[1];
+  $CompleteTotal +=  $size;
+  $size;
+}
+
+sub hashUsage {		# hash ref, name
+  my @keys = keys %{$_[0]};
+  my @values = values %{$_[0]};
+  my $keys = arrayUsage \@keys;
+  my $values = arrayUsage \@values;
+  my $len = @keys;
+  my $total = $keys + $values;
+  print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
+    " (keys: $keys; values: $values; total: $total bytes)\n"
+      if defined $_[1];
+  $total;
+}
+
+sub globUsage {			# glob ref, name
+  local *name = *{$_[0]};
+  $total = 0;
+  $total += scalarUsage $name if defined $name;
+  $total += arrayUsage \@name, $_[1] if defined @name;
+  $total += hashUsage \%name, $_[1] if defined %name and $_[1] ne "main::" 
+    and $_[1] ne "DB::";   #and !($package eq "dumpvar" and $key eq "stab"));
+  $total;
+}
+
+sub packageUsage {
+  my ($package,@vars) = @_;
+  $package .= "::" unless $package =~ /::$/;
+  local *stab = *{"main::"};
+  while ($package =~ /(\w+?::)/g){
+    *stab = $ {stab}{$1};
+  }
+  local $TotalStrings = 0;
+  local $CompleteTotal = 0;
+  my ($key,$val);
+  while (($key,$val) = each(%stab)) {
+    next if @vars && !grep($key eq $_,@vars);
+    globUsage \$val, $key unless $package eq 'dumpvar' and $key eq 'stab';
+  }
+  print "String space: $TotalStrings.\n";
+  $CompleteTotal += $TotalStrings;
+  print "\nGrand total = $CompleteTotal bytes\n";
+}
+
+1;
+
diff --git a/gnu/usr.bin/perl/lib/exceptions.pl b/gnu/usr.bin/perl/lib/exceptions.pl
new file mode 100644
index 00000000000..02c4498d321
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/exceptions.pl
@@ -0,0 +1,54 @@
+# exceptions.pl
+# tchrist@convex.com
+# 
+# Here's a little code I use for exception handling.  It's really just
+# glorfied eval/die.  The way to use use it is when you might otherwise
+# exit, use &throw to raise an exception.  The first enclosing &catch
+# handler looks at the exception and decides whether it can catch this kind
+# (catch takes a list of regexps to catch), and if so, it returns the one it
+# caught.  If it *can't* catch it, then it will reraise the exception
+# for someone else to possibly see, or to die otherwise.
+# 
+# I use oddly named variables in order to make darn sure I don't conflict 
+# with my caller.  I also hide in my own package, and eval the code in his.
+# 
+# The EXCEPTION: prefix is so you can tell whether it's a user-raised
+# exception or a perl-raised one (eval error).
+# 
+# --tom
+#
+# examples:
+#	if (&catch('/$user_input/', 'regexp', 'syntax error') {
+#		warn "oops try again";
+#		redo;
+#	}
+#
+#	if ($error = &catch('&subroutine()')) { # catches anything
+#
+#	&throw('bad input') if /^$/;
+
+sub catch {
+    package exception;
+    local($__code__, @__exceptions__) = @_;
+    local($__package__) = caller;
+    local($__exception__);
+
+    eval "package $__package__; $__code__";
+    if ($__exception__ = &'thrown) {
+	for (@__exceptions__) {
+	    return $__exception__ if /$__exception__/;
+	} 
+	&'throw($__exception__);
+    } 
+} 
+
+sub throw {
+    local($exception) = @_;
+    die "EXCEPTION: $exception\n";
+} 
+
+sub thrown {
+    $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
+} 
+
+1;
diff --git a/gnu/usr.bin/perl/lib/fastcwd.pl b/gnu/usr.bin/perl/lib/fastcwd.pl
new file mode 100644
index 00000000000..6b452e8d788
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/fastcwd.pl
@@ -0,0 +1,35 @@
+# By John Bazik
+#
+# Usage: $cwd = &fastcwd;
+#
+# This is a faster version of getcwd.  It's also more dangerous because
+# you might chdir out of a directory that you can't chdir back into.
+
+sub fastcwd {
+	local($odev, $oino, $cdev, $cino, $tdev, $tino);
+	local(@path, $path);
+	local(*DIR);
+
+	($cdev, $cino) = stat('.');
+	for (;;) {
+		($odev, $oino) = ($cdev, $cino);
+		chdir('..');
+		($cdev, $cino) = stat('.');
+		last if $odev == $cdev && $oino == $cino;
+		opendir(DIR, '.');
+		for (;;) {
+			$_ = readdir(DIR);
+			next if $_ eq '.';
+			next if $_ eq '..';
+
+			last unless $_;
+			($tdev, $tino) = lstat($_);
+			last unless $tdev != $odev || $tino != $oino;
+		}
+		closedir(DIR);
+		unshift(@path, $_);
+	}
+	chdir($path = '/' . join('/', @path));
+	$path;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/find.pl b/gnu/usr.bin/perl/lib/find.pl
new file mode 100644
index 00000000000..40e613e97ee
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/find.pl
@@ -0,0 +1,108 @@
+# Usage:
+#	require "find.pl";
+#
+#	&find('/foo','/bar');
+#
+#	sub wanted { ... }
+#		where wanted does whatever you want.  $dir contains the
+#		current directory name, and $_ the current filename within
+#		that directory.  $name contains "$dir/$_".  You are cd'ed
+#		to $dir when the function is called.  The function may
+#		set $prune to prune the tree.
+#
+# This library is primarily for find2perl, which, when fed
+#
+#   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+#
+# spits out something like this
+#
+#	sub wanted {
+#	    /^\.nfs.*$/ &&
+#	    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+#	    int(-M _) > 7 &&
+#	    unlink($_)
+#	    ||
+#	    ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+#	    $dev < 0 &&
+#	    ($prune = 1);
+#	}
+#
+# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats.
+
+sub find {
+    chop($cwd = `pwd`);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($dir,$_) = ($topdir,'.');
+		$name = $topdir;
+		&wanted;
+		($fixtopdir = $topdir) =~ s,/$,, ;
+		&finddir($fixtopdir,$topnlink);
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    $name = $topdir;
+	    chdir $dir && &wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddir {
+    local($dir,$nlink) = @_;
+    local($dev,$ino,$mode,$subcount);
+    local($name);
+
+    # Get the list of files in the current directory.
+
+    opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
+    local(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2 && !$dont_use_nlink) {  # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    &wanted;
+	    if ($subcount > 0 || $dont_use_nlink) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			&finddir($name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	}
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/finddepth.pl b/gnu/usr.bin/perl/lib/finddepth.pl
new file mode 100644
index 00000000000..1fe6a375b6c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/finddepth.pl
@@ -0,0 +1,105 @@
+# Usage:
+#	require "finddepth.pl";
+#
+#	&finddepth('/foo','/bar');
+#
+#	sub wanted { ... }
+#		where wanted does whatever you want.  $dir contains the
+#		current directory name, and $_ the current filename within
+#		that directory.  $name contains "$dir/$_".  You are cd'ed
+#		to $dir when the function is called.  The function may
+#		set $prune to prune the tree.
+#
+# This library is primarily for find2perl, which, when fed
+#
+#   find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
+#
+# spits out something like this
+#
+#	sub wanted {
+#	    /^\.nfs.*$/ &&
+#	    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+#	    int(-M _) > 7 &&
+#	    unlink($_)
+#	    ||
+#	    ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+#	    $dev < 0 &&
+#	    ($prune = 1);
+#	}
+
+sub finddepth {
+    chop($cwd = `pwd`);
+    foreach $topdir (@_) {
+	(($topdev,$topino,$topmode,$topnlink) = stat($topdir))
+	  || (warn("Can't stat $topdir: $!\n"), next);
+	if (-d _) {
+	    if (chdir($topdir)) {
+		($fixtopdir = $topdir) =~ s,/$,, ;
+		&finddepthdir($fixtopdir,$topnlink);
+		($dir,$_) = ($fixtopdir,'.');
+		$name = $fixtopdir;
+		&wanted;
+	    }
+	    else {
+		warn "Can't cd to $topdir: $!\n";
+	    }
+	}
+	else {
+	    unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
+		($dir,$_) = ('.', $topdir);
+	    }
+	    chdir $dir && &wanted;
+	}
+	chdir $cwd;
+    }
+}
+
+sub finddepthdir {
+    local($dir,$nlink) = @_;
+    local($dev,$ino,$mode,$subcount);
+    local($name);
+
+    # Get the list of files in the current directory.
+
+    opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+    local(@filenames) = readdir(DIR);
+    closedir(DIR);
+
+    if ($nlink == 2) {        # This dir has no subdirectories.
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $name = "$dir/$_";
+	    $nlink = 0;
+	    &wanted;
+	}
+    }
+    else {                    # This dir has subdirectories.
+	$subcount = $nlink - 2;
+	for (@filenames) {
+	    next if $_ eq '.';
+	    next if $_ eq '..';
+	    $nlink = $prune = 0;
+	    $name = "$dir/$_";
+	    if ($subcount > 0) {    # Seen all the subdirs?
+
+		# Get link count and check for directoriness.
+
+		($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
+		
+		if (-d _) {
+
+		    # It really is a directory, so do it recursively.
+
+		    if (!$prune && chdir $_) {
+			&finddepthdir($name,$nlink);
+			chdir '..';
+		    }
+		    --$subcount;
+		}
+	    }
+	    &wanted;
+	}
+    }
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/flush.pl b/gnu/usr.bin/perl/lib/flush.pl
new file mode 100644
index 00000000000..55002b9919c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/flush.pl
@@ -0,0 +1,23 @@
+;# Usage: &flush(FILEHANDLE)
+;# flushes the named filehandle
+
+;# Usage: &printflush(FILEHANDLE, "prompt: ")
+;# prints arguments and flushes filehandle
+
+sub flush {
+    local($old) = select(shift);
+    $| = 1;
+    print "";
+    $| = 0;
+    select($old);
+}
+
+sub printflush {
+    local($old) = select(shift);
+    $| = 1;
+    print @_;
+    $| = 0;
+    select($old);
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/ftp.pl b/gnu/usr.bin/perl/lib/ftp.pl
new file mode 100644
index 00000000000..78995b505d4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/ftp.pl
@@ -0,0 +1,1080 @@
+#-*-perl-*-
+# This is a wrapper to the chat2.pl routines that make life easier
+# to do ftp type work.
+# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
+# based on original version by Alan R. Martello <al@ee.pitt.edu>
+# And by A.Macpherson@bnr.co.uk for multi-homed hosts
+#
+# $Header: /home/cvs/src/gnu/usr.bin/perl/lib/Attic/ftp.pl,v 1.1.1.1 1996/08/19 10:12:34 downsj Exp $
+# $Log: ftp.pl,v $
+# Revision 1.1.1.1  1996/08/19 10:12:34  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+# Revision 1.17  1993/04/21  10:06:54  lmjm
+# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
+# Allow target file to be '-' meaning STDOUT
+# Added ftp'quote
+#
+# Revision 1.16  1993/01/28  18:59:05  lmjm
+# Allow socket arguemtns to come from main.
+# Minor cleanups - removed old comments.
+#
+# Revision 1.15  1992/11/25  21:09:30  lmjm
+# Added another REST return code.
+#
+# Revision 1.14  1992/08/12  14:33:42  lmjm
+# Fail ftp'write if out of space.
+#
+# Revision 1.13  1992/03/20  21:01:03  lmjm
+# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
+# Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
+#
+# Revision 1.12  1992/02/06  23:25:56  lmjm
+# Moved code around so can use this as a lib for both mirror and ftpmail.
+# Time out opens.  In case Unix doesn't bother to.
+#
+# Revision 1.11  1991/11/27  22:05:57  lmjm
+# Match the response code number at the start of a line allowing
+# for any leading junk.
+#
+# Revision 1.10  1991/10/23  22:42:20  lmjm
+# Added better timeout code.
+# Tried to optimise file transfer
+# Moved open/close code to not leak file handles.
+# Cleaned up the alarm code.
+# Added $fatalerror to show wether the ftp link is really dead.
+#
+# Revision 1.9  1991/10/07  18:30:35  lmjm
+# Made the timeout-read code work.
+# Added restarting file gets.
+# Be more verbose if ever have to call die.
+#
+# Revision 1.8  1991/09/17  22:53:16  lmjm
+# Spot when open_data_socket fails and return a failure rather than dying.
+#
+# Revision 1.7  1991/09/12  22:40:25  lmjm
+# Added Andrew Macpherson's patches for hosts without ip forwarding.
+#
+# Revision 1.6  1991/09/06  19:53:52  lmjm
+# Relaid out the code the way I like it!
+# Changed the debuggin to produce more "appropriate" messages
+# Fixed bugs in the ordering of put and dir listing.
+# Allow for hash printing when getting files (a la ftp).
+# Added the new commands from Al.
+# Don't print passwords in debugging.
+#
+# Revision 1.5  1991/08/29  16:23:49  lmjm
+# Timeout reads from the remote ftp server.
+# No longer call die expect on fatal errors.  Just return fail codes.
+# Changed returns so higher up routines can tell whats happening.
+# Get expect/accept in correct order for dir listing.
+# When ftp_show is set then print hashes every 1k transfered (like ftp).
+# Allow for stripping returns out of incoming data.
+# Save last error in a global string.
+#
+# Revision 1.4  1991/08/14  21:04:58  lmjm
+# ftp'get now copes with ungetable files.
+# ftp'expect code changed such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+# Implemented patches from al.  Removed spuiours tracing statements.
+#
+# Revision 1.3  1991/08/09  21:32:18  lmjm
+# Allow for another ok code on cwd's
+# Rejigger the log levels
+# Send \r\n for some odd ftp daemons
+#
+# Revision 1.2  1991/08/09  18:07:37  lmjm
+# Don't print messages unless ftp_show says to.
+#
+# Revision 1.1  1991/08/08  20:31:00  lmjm
+# Initial revision
+#
+
+require 'chat2.pl';
+eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n";
+
+
+package ftp;
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+# If the remote ftp daemon doesn't respond within this time presume its dead
+# or something.
+$timeout = 30;
+
+# Timeout a read if I don't get data back within this many seconds
+$timeout_read = 20 * $timeout;
+
+# Timeout an open
+$timeout_open = $timeout;
+
+# This is a "global" it contains the last response from the remote ftp server
+# for use in error messages
+$ftp'response = "";
+# Also ftp'NS is the socket containing the data coming in from the remote ls
+# command.
+
+# The size of block to be read or written when talking to the remote
+# ftp server
+$ftp'ftpbufsize = 4096;
+
+# How often to print a hash out, when debugging
+$ftp'hashevery = 1024;
+# Output a newline after this many hashes to prevent outputing very long lines
+$ftp'hashnl = 70;
+
+# If a proxy connection then who am I really talking to?
+$real_site = "";
+
+# This is just a tracing aid.
+$ftp_show = 0;
+sub ftp'debug
+{
+	$ftp_show = @_[0];
+#	if( $ftp_show ){
+#		print STDERR "ftp debugging on\n";
+#	}
+}
+
+sub ftp'set_timeout
+{
+	$timeout = @_[0];
+	$timeout_open = $timeout;
+	$timeout_read = 20 * $timeout;
+	if( $ftp_show ){
+		print STDERR "ftp timeout set to $timeout\n";
+	}
+}
+
+
+sub ftp'open_alarm
+{
+	die "timeout: open";
+}
+
+sub ftp'timed_open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+	local( $connect_site, $connect_port );
+	local( $res );
+
+	alarm( $timeout_open );
+
+	while( $attempts-- ){
+		if( $ftp_show ){
+			print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
+			print STDERR "Connecting to $site";
+			if( $ftp_port != 21 ){
+				print STDERR " [port $ftp_port]";
+			}
+			print STDERR "\n";
+		}
+		
+		if( $proxy ) {
+			if( ! $proxy_gateway ) {
+				# if not otherwise set
+				$proxy_gateway = "internet-gateway";
+			}
+			if( $debug ) {
+				print STDERR "using proxy services of $proxy_gateway, ";
+				print STDERR "at $proxy_ftp_port\n";
+			}
+			$connect_site = $proxy_gateway;
+			$connect_port = $proxy_ftp_port;
+			$real_site = $site;
+		}
+		else {
+			$connect_site = $site;
+			$connect_port = $ftp_port;
+		}
+		if( ! &chat'open_port( $connect_site, $connect_port ) ){
+			if( $retry_call ){
+				print STDERR "Failed to connect\n" if $ftp_show;
+				next;
+			}
+			else {
+				print STDERR "proxy connection failed " if $proxy;
+				print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
+				return 0;
+			}
+		}
+		$res = &ftp'expect( $timeout,
+				    120, "service unavailable to $site", 0, 
+	                            220, "ready for login to $site", 1,
+				    421, "service unavailable to $site, closing connection", 0);
+		if( ! $res ){
+			&chat'close();
+			next;
+		}
+		return 1;
+	}
+	continue {
+		print STDERR "Pausing between retries\n";
+		sleep( $retry_pause );
+	}
+	return 0;
+}
+
+sub ftp'open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+
+	$SIG{ 'ALRM' } = "ftp\'open_alarm";
+
+	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+sub ftp'login
+{
+	local( $remote_user, $remote_password ) = @_;
+
+	if( $proxy ){
+		&ftp'send( "USER $remote_user@$site" );
+	}
+	else {
+		&ftp'send( "USER $remote_user" );
+	}
+        local( $val ) =
+               &ftp'expect($timeout,
+	           230, "$remote_user logged in", 1,
+		   331, "send password for $remote_user", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+		   332, "account for login not supported", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $val == 1 ){
+		return 1;
+	}
+	if( $val == 2 ){
+		# A password is needed
+		&ftp'send( "PASS $remote_password" );
+
+		$val = &ftp'expect( $timeout,
+		   230, "$remote_user logged in", 1,
+
+		   202, "command not implemented", 0,
+		   332, "account for login not supported", 0,
+
+		   530, "not logged in", 0,
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   503, "bad sequence of commands", 0, 
+
+		   421, "service unavailable, closing connection", 0);
+		if( $val == 1){
+			# Logged in
+			return 1;
+		}
+	}
+	# If I got here I failed to login
+	return 0;
+}
+
+sub ftp'close
+{
+	&ftp'quit();
+	&chat'close();
+}
+
+# Change directory
+# return 1 if successful
+# 0 on a failure
+sub ftp'cwd
+{
+	local( $dir ) = @_;
+
+	&ftp'send( "CWD $dir" );
+
+	return &ftp'expect( $timeout,
+		200, "working directory = $dir", 1,
+		250, "working directory = $dir", 1,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+                502, "command not implemented", 0,
+		530, "not logged in", 0,
+                550, "cannot change directory", 0,
+		421, "service unavailable, closing connection", 0 );
+}
+
+# Get a full directory listing:
+# &ftp'dir( remote LIST options )
+# Start a list goin with the given options.
+# Presuming that the remote deamon uses the ls command to generate the
+# data to send back then then you can send it some extra options (eg: -lRa)
+# return 1 if sucessful and 0 on a failure
+sub ftp'dir_open
+{
+	local( $options ) = @_;
+	local( $ret );
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	if( $options ){
+		&ftp'send( "LIST $options" );
+	}
+	else {
+		&ftp'send( "LIST" );
+	}
+	
+	$ret = &ftp'expect( $timeout,
+		150, "reading directory", 1,
+	
+		125, "data connection already open?", 0,
+	
+		450, "file unavailable", 0,
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		502, "command not implemented", 0,
+		530, "not logged in", 0,
+	
+		   421, "service unavailable, closing connection", 0 );
+	if( ! $ret ){
+		&ftp'close_data_socket;
+		return 0;
+	}
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed $!";
+	
+	return 1;
+}
+
+
+# Close down reading the result of a remote ls command
+# return 1 if successful and 0 on failure
+sub ftp'dir_close
+{
+	local( $ret );
+
+	# read the close
+	#
+	$ret = &ftp'expect($timeout,
+        	226, "", 1,     # transfer complete, closing connection
+        	250, "", 1,     # action completed
+
+	        425, "can't open data connection", 0,
+        	426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+	        421, "service unavailable, closing connection", 0);
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( ! $ret ){
+		return 0;
+	}
+
+	return 1;
+}
+
+# Quit from the remote ftp server
+# return 1 if successful and 0 on failure
+sub ftp'quit
+{
+	$site_command_check = 0;
+	@site_command_list = ();
+
+	&ftp'send("QUIT");
+
+	return &ftp'expect($timeout, 
+		221, "Goodbye", 1,     # transfer complete, closing connection
+	
+		500, "error quitting??", 0);
+}
+
+sub ftp'read_alarm
+{
+	die "timeout: read";
+}
+
+sub ftp'timed_read
+{
+	alarm( $timeout_read );
+	return sysread( NS, $buf, $ftpbufsize );
+}
+
+sub ftp'read
+{
+	$SIG{ 'ALRM' } = "ftp\'read_alarm";
+
+	local( $ret ) = eval '&timed_read()';
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+# Get a remote file back into a local file.
+# If no loc_fname passed then uses rem_fname.
+# returns 1 on success and 0 on failure
+sub ftp'get
+{
+	local($rem_fname, $loc_fname, $restart ) = @_;
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		print STDERR "Cannot open data socket\n";
+		return 0;
+	}
+
+	if( $loc_fname ne '-' ){
+		# Find the size of the target file
+		local( $restart_at ) = &ftp'filesize( $loc_fname );
+		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
+			$restart = 1;
+			# Make sure the file can be updated
+			chmod( 0644, $loc_fname );
+		}
+		else {
+			$restart = 0;
+			unlink( $loc_fname );
+		}
+	}
+
+	&ftp'send( "RETR $rem_fname" );
+	
+	local( $ret ) =
+		&ftp'expect($timeout, 
+                   150, "receiving $rem_fname", 1,
+
+                   125, "data connection already open?", 0,
+
+                   450, "file unavailable", 2,
+                   550, "file unavailable", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $ret != 1 ){
+		print STDERR "Failure on RETR command\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+	# 
+	# the data should be coming at us now
+	#
+
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+
+	#
+	#  open the local fname
+	#  concatenate on the end if restarting, else just overwrite
+	if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
+		print STDERR "Cannot create local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+#    while (<NS>) {
+#        print FH ;
+#    }
+
+	local( $start_time ) = time;
+	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
+	while( ($len = &ftp'read()) > 0 ){
+		$bytes += $len;
+		if( $strip_cr ){
+			$ftp'buf =~ s/\r//g;
+		}
+		if( $ftp_show ){
+			while( $bytes > ($lasthash + $ftp'hashevery) ){
+				print STDERR '#';
+				$lasthash += $ftp'hashevery;
+				$hashes++;
+				if( ($hashes % $ftp'hashnl) == 0 ){
+					print STDERR "\n";
+				}
+			}
+		}
+		if( ! print FH $ftp'buf ){
+			print STDERR "\nfailed to write data";
+			return 0;
+		}
+	}
+	close( FH );
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( $len < 0 ){
+		print STDERR "\ntimed out reading data!\n";
+
+		return 0;
+	}
+		
+	if( $ftp_show ){
+		if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
+			print STDERR "\n";
+		}
+		local( $secs ) = (time - $start_time);
+		if( $secs <= 0 ){
+			$secs = 1; # To avoid a divide by zero;
+		}
+
+		local( $rate ) = int( $bytes / $secs );
+		print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
+	}
+
+	#
+	# read the close
+	#
+
+	$ret = &ftp'expect($timeout, 
+		226, "Got file", 1,     # transfer complete, closing connection
+	        250, "Got file", 1,     # action completed
+	
+	        110, "restart not supported", 0,
+	        425, "can't open data connection", 0,
+	        426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+		421, "service unavailable, closing connection", 0);
+
+	return $ret;
+}
+
+sub ftp'delete
+{
+	local( $rem_fname, $val ) = @_;
+
+	&ftp'send("DELE $rem_fname" );
+	$val = &ftp'expect( $timeout, 
+			   250,"Deleted $rem_fname", 1,
+			   550,"Permission denied",0
+			   );
+	return $val == 1;
+}
+
+sub ftp'deldir
+{
+    local( $fname ) = @_;
+
+    # not yet implemented
+    # RMD
+}
+
+# UPDATE ME!!!!!!
+# Add in the hash printing and newline conversion
+sub ftp'put
+{
+	local( $loc_fname, $rem_fname ) = @_;
+	local( $strip_cr );
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	&ftp'send("STOR $rem_fname");
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	local( $ret ) =
+	&ftp'expect($timeout, 
+		150, "sending $loc_fname", 1,
+
+		125, "data connection already open?", 0,
+		450, "file unavailable", 0,
+
+		532, "need account for storing files", 0,
+		452, "insufficient storage on system", 0,
+		553, "file name not allowed", 0,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+
+	if( $ret != 1 ){
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+	
+	#
+	#  open the local fname
+	#
+	if( !open(FH, "<$loc_fname") ){
+		print STDERR "Cannot open local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+	
+	while (<FH>) {
+		print NS ;
+	}
+	close(FH);
+	
+	# shut down our end of the socket to signal EOF
+	&ftp'close_data_socket;
+	
+	#
+	# read the close
+	#
+	
+	$ret = &ftp'expect($timeout, 
+		226, "file put", 1,     # transfer complete, closing connection
+		250, "file put", 1,     # action completed
+	
+		110, "restart not supported", 0,
+		425, "can't open data connection", 0,
+		426, "connection closed, transfer aborted", 0,
+		451, "action aborted, local error", 0,
+		551, "page type unknown", 0,
+		552, "storage allocation exceeded", 0,
+	
+		421, "service unavailable, closing connection", 0);
+	if( ! $ret ){
+		print STDERR "error putting $loc_fname\n";
+	}
+	return $ret;
+}
+
+sub ftp'restart
+{
+	local( $restart_point, $ret ) = @_;
+
+	&ftp'send("REST $restart_point");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   350, "restarting at $restart_point", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "REST not implemented", 2,
+			   530, "not logged in", 0,
+			   554, "REST not implemented", 2,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+# Set the file transfer type
+sub ftp'type
+{
+	local( $type ) = @_;
+
+	&ftp'send("TYPE $type");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   200, "file type set to $type", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   504, "Invalid form or byte size for type $type", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+$site_command_check = 0;
+@site_command_list = ();
+
+# routine to query the remote server for 'SITE' commands supported
+sub ftp'site_commands
+{
+	local( $ret );
+	
+	# if we havent sent a 'HELP SITE', send it now
+	if( !$site_command_check ){
+	
+		$site_command_check = 1;
+	
+		&ftp'send( "HELP SITE" );
+	
+		# assume the line in the HELP SITE response with the 'HELP'
+		# command is the one for us
+		$ret = &ftp'expect( $timeout,
+			".*HELP.*", "", "\$1",
+			214, "", "0",
+			202, "", "0" );
+	
+		if( $ret eq "0" ){
+			print STDERR "No response from HELP SITE\n" if( $ftp_show );
+		}
+	
+		@site_command_list = split(/\s+/, $ret);
+	}
+	
+	return @site_command_list;
+}
+
+# return the pwd, or null if we can't get the pwd
+sub ftp'pwd
+{
+	local( $ret, $cwd );
+
+	&ftp'send( "PWD" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "working dir is", 1,
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "PWD not implemented", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	if( $ret ){
+		if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
+			$cwd = $1;
+		}
+	}
+	return $cwd;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'mkdir
+{
+	local( $path ) = @_;
+	local( $ret );
+
+	&ftp'send( "MKD $path" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "made directory $path", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "MKD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'chmod
+{
+	local( $path, $mode ) = @_;
+	local( $ret );
+
+	&ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   200, "chmod $mode $path succeeded", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "CHMOD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# rename a file
+sub ftp'rename
+{
+	local( $old_name, $new_name ) = @_;
+	local( $ret );
+
+	&ftp'send( "RNFR $old_name" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   350, "", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "RNFR not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+	                   450, "file unavailable", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+
+
+	# check if the "rename from" occurred ok
+	if( $ret ) {
+		&ftp'send( "RNTO $new_name" );
+	
+		# 
+		# see what they say
+	
+		$ret = &ftp'expect( $timeout, 
+			           250, "rename $old_name to $new_name", 1, 
+
+				   500, "syntax error", 0,
+				   501, "syntax error", 0,
+				   502, "RNTO not implemented", 0,
+				   503, "bad sequence of commands", 0,
+				   530, "not logged in", 0,
+		                   532, "need account for storing files", 0,
+		                   553, "file name not allowed", 0,
+				   
+				   421, "service unavailable, closing connection", 0);
+	}
+
+	return $ret;
+}
+
+
+sub ftp'quote
+{
+      local( $cmd ) = @_;
+
+      &ftp'send( $cmd );
+
+      return &ftp'expect( $timeout, 
+              200, "Remote '$cmd' OK", 1,
+              500, "error in remote '$cmd'", 0 );
+}
+
+# ------------------------------------------------------------------------------
+# These are the lower level support routines
+
+sub ftp'expectgot
+{
+	($ftp'response, $ftp'fatalerror) = @_;
+	if( $ftp_show ){
+		print STDERR "$ftp'response\n";
+	}
+}
+
+#
+#  create the list of parameters for chat'expect
+#
+#  ftp'expect(time_out, {value, string_to_print, return value});
+#     if the string_to_print is "" then nothing is printed
+#  the last response is stored in $ftp'response
+#
+# NOTE: lmjm has changed this code such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+#
+sub ftp'expect {
+	local( $ret );
+	local( $time_out );
+	local( $expect_args );
+	
+	$ftp'response = '';
+	$ftp'fatalerror = 0;
+
+	@expect_args = ();
+	
+	$time_out = shift(@_);
+	
+	while( @_ ){
+		local( $code ) = shift( @_ );
+		local( $pre ) = '^';
+		if( $code =~ /^\d/ ){
+			$pre =~ "[.|\n]*^";
+		}
+		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
+		shift( @_ );
+		push( @expect_args, 
+			"&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
+	}
+	
+	# Treat all unrecognised lines as continuations
+	push( @expect_args, "^(.*)\\015\\n" );
+	push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
+	
+	# add patterns TIMEOUT and EOF
+	
+	push( @expect_args, 'TIMEOUT' );
+	push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
+	
+	push( @expect_args, 'EOF' );
+	push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
+	
+	if( $ftp_show > 9 ){
+		&printargs( $time_out, @expect_args );
+	}
+	
+	$ret = &chat'expect( $time_out, @expect_args );
+	if( $ret == 100 ){
+		# we saw a continuation line, wait for the end
+		push( @expect_args, "^.*\n" );
+		push( @expect_args, "100" );
+	
+		while( $ret == 100 ){
+			$ret = &chat'expect( $time_out, @expect_args );
+		}
+	}
+	
+	return $ret;
+}
+
+#
+#  opens NS for io
+#
+sub ftp'open_data_socket
+{
+	local( $ret );
+	local( $hostname );
+	local( $sockaddr, $name, $aliases, $proto, $port );
+	local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
+	local( $mysockaddr, $family, $hi, $lo );
+	
+	
+	$sockaddr = 'S n a4 x8';
+	chop( $hostname = `hostname` );
+	
+	$port = "ftp";
+	
+	($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	($name, $aliases, $port) = getservbyname( $port, 'tcp' );
+	
+#	($name, $aliases, $type, $len, $thisaddr) =
+#	gethostbyname( $hostname );
+	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
+	
+#	$this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
+	$this = $chat'thisproc;
+	
+	socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
+	bind(S, $this) || die "bind: $!";
+	
+	# get the port number
+	$mysockaddr = getsockname(S);
+	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
+	
+	$hi = ($port >> 8) & 0x00ff;
+	$lo = $port & 0x00ff;
+	
+	#
+	# we MUST do a listen before sending the port otherwise
+	# the PORT may fail
+	#
+	listen( S, 5 ) || die "listen";
+	
+	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
+	
+	return &ftp'expect($timeout,
+		200, "PORT command successful", 1,
+		250, "PORT command successful", 1 ,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+}
+	
+sub ftp'close_data_socket
+{
+	close(NS);
+}
+
+sub ftp'send
+{
+	local($send_cmd) = @_;
+	if( $send_cmd =~ /\n/ ){
+		print STDERR "ERROR, \\n in send string for $send_cmd\n";
+	}
+	
+	if( $ftp_show ){
+		local( $sc ) = $send_cmd;
+
+		if( $send_cmd =~ /^PASS/){
+			$sc = "PASS <somestring>";
+		}
+		print STDERR "---> $sc\n";
+	}
+	
+	&chat'print( "$send_cmd\r\n" );
+}
+
+sub ftp'printargs
+{
+	while( @_ ){
+		print STDERR shift( @_ ) . "\n";
+	}
+}
+
+sub ftp'filesize
+{
+	local( $fname ) = @_;
+
+	if( ! -f $fname ){
+		return -1;
+	}
+
+	return (stat( _ ))[ 7 ];
+	
+}
+
+# make this package return true
+1;
diff --git a/gnu/usr.bin/perl/lib/getcwd.pl b/gnu/usr.bin/perl/lib/getcwd.pl
new file mode 100644
index 00000000000..8db8e20c069
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getcwd.pl
@@ -0,0 +1,62 @@
+# By Brandon S. Allbery
+#
+# Usage: $cwd = &getcwd;
+
+sub getcwd
+{
+    local($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat('.'))
+    {
+	warn "stat(.): $!";
+	return '';
+    }
+    $cwd = '';
+    do
+    {
+	$dotdots .= '/' if $dotdots;
+	$dotdots .= '..';
+	@pst = @cst;
+	unless (opendir(getcwd'PARENT, $dotdots))			#'))
+	{
+	    warn "opendir($dotdots): $!";
+	    return '';
+	}
+	unless (@cst = stat($dotdots))
+	{
+	    warn "stat($dotdots): $!";
+	    closedir(getcwd'PARENT);					#');
+	    return '';
+	}
+	if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
+	{
+	    $dir = '';
+	}
+	else
+	{
+	    do
+	    {
+		unless (defined ($dir = readdir(getcwd'PARENT)))        #'))
+		{
+		    warn "readdir($dotdots): $!";
+		    closedir(getcwd'PARENT);				#');
+		    return '';
+		}
+		unless (@tst = lstat("$dotdots/$dir"))
+		{
+		    warn "lstat($dotdots/$dir): $!";
+		    closedir(getcwd'PARENT);				#');
+		    return '';
+		}
+	    }
+	    while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
+		   $tst[$[ + 1] != $pst[$[ + 1]);
+	}
+	$cwd = "$dir/$cwd";
+	closedir(getcwd'PARENT);					#');
+    } while ($dir);
+    chop($cwd);
+    $cwd;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/getopt.pl b/gnu/usr.bin/perl/lib/getopt.pl
new file mode 100644
index 00000000000..a6023c80bc9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getopt.pl
@@ -0,0 +1,41 @@
+;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+
+;# Process single-character switches with switch clustering.  Pass one argument
+;# which is a string containing all switches that take an argument.  For each
+;# switch found, sets $opt_x (where x is the switch name) to the value of the
+;# argument, or 1 if no argument.  Switches which take an argument don't care
+;# whether there is a space between the switch and the argument.
+
+;# Usage:
+;#	do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
+
+sub Getopt {
+    local($argumentative) = @_;
+    local($_,$first,$rest);
+    local($[) = 0;
+
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	if (index($argumentative,$first) >= $[) {
+	    if ($rest ne '') {
+		shift(@ARGV);
+	    }
+	    else {
+		shift(@ARGV);
+		$rest = shift(@ARGV);
+	    }
+	    eval "\$opt_$first = \$rest;";
+	}
+	else {
+	    eval "\$opt_$first = 1;";
+	    if ($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/getopts.pl b/gnu/usr.bin/perl/lib/getopts.pl
new file mode 100644
index 00000000000..a0818d1e3a0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/getopts.pl
@@ -0,0 +1,50 @@
+;# getopts.pl - a better getopt.pl
+
+;# Usage:
+;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
+;#                           #  side effect.
+
+sub Getopts {
+    local($argumentative) = @_;
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local($[) = 0;
+
+    @args = split( / */, $argumentative );
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+	($first,$rest) = ($1,$2);
+	$pos = index($argumentative,$first);
+	if($pos >= $[) {
+	    if($args[$pos+1] eq ':') {
+		shift(@ARGV);
+		if($rest eq '') {
+		    ++$errs unless @ARGV;
+		    $rest = shift(@ARGV);
+		}
+		eval "\$opt_$first = \$rest;";
+	    }
+	    else {
+		eval "\$opt_$first = 1";
+		if($rest eq '') {
+		    shift(@ARGV);
+		}
+		else {
+		    $ARGV[0] = "-$rest";
+		}
+	    }
+	}
+	else {
+	    print STDERR "Unknown option: $first\n";
+	    ++$errs;
+	    if($rest ne '') {
+		$ARGV[0] = "-$rest";
+	    }
+	    else {
+		shift(@ARGV);
+	    }
+	}
+    }
+    $errs == 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/hostname.pl b/gnu/usr.bin/perl/lib/hostname.pl
new file mode 100644
index 00000000000..5394c6ec693
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/hostname.pl
@@ -0,0 +1,23 @@
+# From: asherman@fmrco.com (Aaron Sherman)
+
+sub hostname
+{
+	local(*P,@tmp,$hostname,$_);
+	if (open(P,"hostname 2>&1 |") && (@tmp = <P>) && close(P))
+	{
+		chop($hostname = $tmp[$#tmp]);
+	}
+	elsif (open(P,"uname -n 2>&1 |") && (@tmp = <P>) && close(P))
+	{
+		chop($hostname = $tmp[$#tmp]);
+	}
+	else
+	{
+		die "$0: Cannot get hostname from 'hostname' or 'uname -n'\n";
+	}
+	@tmp = ();
+	close P; # Just in case we failed in an odd spot....
+	$hostname;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/importenv.pl b/gnu/usr.bin/perl/lib/importenv.pl
new file mode 100644
index 00000000000..d56f32633b8
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/importenv.pl
@@ -0,0 +1,16 @@
+;# $RCSfile: importenv.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:02 $
+
+;# This file, when interpreted, pulls the environment into normal variables.
+;# Usage:
+;#	require 'importenv.pl';
+;# or
+;#	#include <importenv.pl>
+
+local($tmp,$key) = '';
+
+foreach $key (keys(ENV)) {
+    $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
+}
+eval $tmp;
+
+1;
diff --git a/gnu/usr.bin/perl/lib/integer.pm b/gnu/usr.bin/perl/lib/integer.pm
new file mode 100644
index 00000000000..a88ce6a77c8
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/integer.pm
@@ -0,0 +1,32 @@
+package integer;
+
+=head1 NAME
+
+integer - Perl pragma to compute arithmetic in integer instead of double
+
+=head1 SYNOPSIS
+
+    use integer;
+    $x = 10/3;
+    # $x is now 3, not 3.33333333333333333
+
+=head1 DESCRIPTION
+
+This tells the compiler that it's okay to use integer operations
+from here to the end of the enclosing BLOCK.  On many machines, 
+this doesn't matter a great deal for most computations, but on those 
+without floating point hardware, it can make a big difference.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+sub import {
+    $^H |= 1;
+}
+
+sub unimport {
+    $^H &= ~1;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/less.pm b/gnu/usr.bin/perl/lib/less.pm
new file mode 100644
index 00000000000..b3afef0fcdc
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/less.pm
@@ -0,0 +1,23 @@
+package less;
+
+=head1 NAME
+
+less - perl pragma to request less of something from the compiler
+
+=head1 SYNOPSIS
+
+    use less;  # unimplemented
+
+=head1 DESCRIPTION
+
+Currently unimplemented, this may someday be a compiler directive
+to make certain trade-offs, such as perhaps
+
+    use less 'memory';
+    use less 'CPU';
+    use less 'fat';
+
+
+=cut
+
+1;
diff --git a/gnu/usr.bin/perl/lib/lib.pm b/gnu/usr.bin/perl/lib/lib.pm
new file mode 100644
index 00000000000..546ae87b891
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/lib.pm
@@ -0,0 +1,128 @@
+package lib;
+
+use Config;
+
+my $archname = $Config{'archname'};
+
+@ORIG_INC = ();		# (avoid typo warning)
+@ORIG_INC = @INC;	# take a handy copy of 'original' value
+
+
+sub import {
+    shift;
+    foreach (reverse @_) {
+	unshift(@INC, $_);
+	# Put a corresponding archlib directory infront of $_ if it
+	# looks like $_ has an archlib directory below it.
+	unshift(@INC, "$_/$archname") if -d "$_/$archname/auto";
+    }
+}
+
+
+sub unimport {
+    shift;
+    my $mode = shift if $_[0] =~ m/^:[A-Z]+/;
+
+    my %names;
+    foreach(@_) {
+	++$names{$_};
+	++$names{"$_/$archname"} if -d "$_/$archname/auto";
+    }
+
+    if ($mode and $mode eq ':ALL') {
+	# Remove ALL instances of each named directory.
+	@INC = grep { !exists $names{$_} } @INC;
+    } else {
+	# Remove INITIAL instance(s) of each named directory.
+	@INC = grep { --$names{$_} < 0   } @INC;
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+lib - manipulate @INC at compile time
+
+=head1 SYNOPSIS
+
+    use lib LIST;
+
+    no lib LIST;
+
+=head1 DESCRIPTION
+
+This is a small simple module which simplifies the manipulation of @INC
+at compile time.
+
+It is typically used to add extra directories to perl's search path so
+that later C<use> or C<require> statements will find modules which are
+not located on perl's default search path.
+
+
+=head2 ADDING DIRECTORIES TO @INC
+
+The parameters to C<use lib> are added to the start of the perl search
+path. Saying
+
+    use lib LIST;
+
+is I<almost> the same as saying
+
+    BEGIN { unshift(@INC, LIST) }
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is added to @INC in front of $dir.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be added to @INC twice (if $dir/$archname/auto exists).
+
+
+=head2 DELETING DIRECTORIES FROM @INC
+
+You should normally only add directories to @INC.  If you need to
+delete directories from @INC take care to only delete those which you
+added yourself or which you are certain are not needed by other modules
+in your script.  Other modules may have added directories which they
+need for correct operation.
+
+By default the C<no lib> statement deletes the I<first> instance of
+each named directory from @INC.  To delete multiple instances of the
+same name from @INC you can specify the name multiple times.
+
+To delete I<all> instances of I<all> the specified names from @INC you can
+specify ':ALL' as the first parameter of C<no lib>. For example:
+
+    no lib qw(:ALL .);
+
+For each directory in LIST (called $dir here) the lib module also
+checks to see if a directory called $dir/$archname/auto exists.
+If so the $dir/$archname directory is assumed to be a corresponding
+architecture specific directory and is also deleted from @INC.
+
+If LIST includes both $dir and $dir/$archname then $dir/$archname will
+be deleted from @INC twice (if $dir/$archname/auto exists).
+
+
+=head2 RESTORING ORIGINAL @INC
+
+When the lib module is first loaded it records the current value of @INC
+in an array C<@lib::ORIG_INC>. To restore @INC to that value you
+can say
+
+    @INC = @lib::ORIG_INC;
+
+
+=head1 SEE ALSO
+
+AddINC - optional module which deals with paths relative to the source file.
+
+=head1 AUTHOR
+
+Tim Bunce, 2nd June 1995.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/look.pl b/gnu/usr.bin/perl/lib/look.pl
new file mode 100644
index 00000000000..4c14e64727a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/look.pl
@@ -0,0 +1,44 @@
+;# Usage: &look(*FILEHANDLE,$key,$dict,$fold)
+
+;# Sets file position in FILEHANDLE to be first line greater than or equal
+;# (stringwise) to $key.  Pass flags for dictionary order and case folding.
+
+sub look {
+    local(*FH,$key,$dict,$fold) = @_;
+    local($max,$min,$mid,$_);
+    local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+       $blksize,$blocks) = stat(FH);
+    $blksize = 8192 unless $blksize;
+    $key =~ s/[^\w\s]//g if $dict;
+    $key =~ y/A-Z/a-z/ if $fold;
+    $max = int($size / $blksize);
+    while ($max - $min > 1) {
+	$mid = int(($max + $min) / 2);
+	seek(FH,$mid * $blksize,0);
+	$_ = <FH> if $mid;		# probably a partial line
+	$_ = <FH>;
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	if ($_ lt $key) {
+	    $min = $mid;
+	}
+	else {
+	    $max = $mid;
+	}
+    }
+    $min *= $blksize;
+    seek(FH,$min,0);
+    <FH> if $min;
+    while (<FH>) {
+	chop;
+	s/[^\w\s]//g if $dict;
+	y/A-Z/a-z/ if $fold;
+	last if $_ ge $key;
+	$min = tell(FH);
+    }
+    seek(FH,$min,0);
+    $min;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/newgetopt.pl b/gnu/usr.bin/perl/lib/newgetopt.pl
new file mode 100644
index 00000000000..38cad59c73e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/newgetopt.pl
@@ -0,0 +1,58 @@
+# newgetopt.pl -- new options parsing.
+# Now just a wrapper around the Getopt::Long module.
+# $Id: newgetopt.pl,v 1.15 1995/12/26 14:57:33 jv Exp $
+
+{   package newgetopt;
+
+    # Values for $order. See GNU getopt.c for details.
+    $REQUIRE_ORDER = 0;
+    $PERMUTE = 1;
+    $RETURN_IN_ORDER = 2;
+
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$autoabbrev = 0;	# no automatic abbrev of options (???)
+	$getopt_compat = 0;	# disallow '+' to start options
+	$option_start = "(--|-)";
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$autoabbrev = 1;	# automatic abbrev of options
+	$getopt_compat = 1;	# allow '+' to start options
+	$option_start = "(--|-|\\+)";
+	$order = $PERMUTE;
+    }
+
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $ignorecase = 1;		# ignore case when matching options
+    $argv_end = "--";		# don't change this!
+}
+
+use Getopt::Long;
+
+################ Subroutines ################
+
+sub NGetOpt {
+
+    $Getopt::Long::debug = $newgetopt::debug 
+	if defined $newgetopt::debug;
+    $Getopt::Long::autoabbrev = $newgetopt::autoabbrev 
+	if defined $newgetopt::autoabbrev;
+    $Getopt::Long::getopt_compat = $newgetopt::getopt_compat 
+	if defined $newgetopt::getopt_compat;
+    $Getopt::Long::option_start = $newgetopt::option_start 
+	if defined $newgetopt::option_start;
+    $Getopt::Long::order = $newgetopt::order 
+	if defined $newgetopt::order;
+    $Getopt::Long::ignorecase = $newgetopt::ignorecase 
+	if defined $newgetopt::ignorecase;
+
+    &GetOptions;
+}
+
+################ Package return ################
+
+1;
+
+################ End of newgetopt.pl ################
diff --git a/gnu/usr.bin/perl/lib/open2.pl b/gnu/usr.bin/perl/lib/open2.pl
new file mode 100644
index 00000000000..dcd68a8cd3a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/open2.pl
@@ -0,0 +1,54 @@
+# &open2: tom christiansen, <tchrist@convex.com>
+#
+# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
+#    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#
+# spawn the given $cmd and connect $rdr for
+# reading and $wtr for writing.  return pid
+# of child, or 0 on failure.  
+# 
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.  
+# 
+# $wtr is left unbuffered.
+# 
+# abort program if
+#	rdr or wtr are null
+# 	pipe or fork or exec fails
+
+package open2;
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub main'open2 {
+    local($kidpid);
+    local($dad_rdr, $dad_wtr, @cmd) = @_;
+
+    $dad_rdr ne '' 		|| die "open2: rdr should not be null";
+    $dad_wtr ne '' 		|| die "open2: wtr should not be null";
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_rdr =~ s/^[^']+$/$package'$&/;
+    $dad_wtr =~ s/^[^']+$/$package'$&/;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+
+    pipe($dad_rdr, $kid_wtr) 	|| die "open2: pipe 1 failed: $!";
+    pipe($kid_rdr, $dad_wtr) 	|| die "open2: pipe 2 failed: $!";
+
+    if (($kidpid = fork) < 0) {
+	die "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	close $dad_rdr; close $dad_wtr;
+	open(STDIN,  "<&$kid_rdr");
+	open(STDOUT, ">&$kid_wtr");
+	warn "execing @cmd\n" if $debug;
+	exec @cmd;
+	die "open2: exec of @cmd failed";   
+    } 
+    close $kid_rdr; close $kid_wtr;
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
diff --git a/gnu/usr.bin/perl/lib/open3.pl b/gnu/usr.bin/perl/lib/open3.pl
new file mode 100644
index 00000000000..7c8b6ae2884
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/open3.pl
@@ -0,0 +1,106 @@
+# &open3: Marc Horowitz <marc@mit.edu>
+# derived mostly from &open2 by tom christiansen, <tchrist@convex.com>
+#
+# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $
+#
+# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...);
+#
+# spawn the given $cmd and connect rdr for
+# reading, wtr for writing, and err for errors.
+# if err is '', or the same as rdr, then stdout and
+# stderr of the child are on the same fh.  returns pid
+# of child, or 0 on failure.
+
+
+# if wtr begins with '>&', then wtr will be closed in the parent, and
+# the child will read from it directly.  if rdr or err begins with
+# '>&', then the child will send output directly to that fd.  In both
+# cases, there will be a dup() instead of a pipe() made.
+
+
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.
+#
+# $wtr is left unbuffered.
+#
+# abort program if
+#   rdr or wtr are null
+#   pipe or fork or exec fails
+
+package open3;
+
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub main'open3 {
+    local($kidpid);
+    local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_;
+    local($dup_wtr, $dup_rdr, $dup_err);
+
+    $dad_wtr			|| die "open3: wtr should not be null";
+    $dad_rdr			|| die "open3: rdr should not be null";
+    $dad_err = $dad_rdr if ($dad_err eq '');
+
+    $dup_wtr = ($dad_wtr =~ s/^\>\&//);
+    $dup_rdr = ($dad_rdr =~ s/^\>\&//);
+    $dup_err = ($dad_err =~ s/^\>\&//);
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_wtr =~ s/^[^']+$/$package'$&/;
+    $dad_rdr =~ s/^[^']+$/$package'$&/;
+    $dad_err =~ s/^[^']+$/$package'$&/;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+    local($kid_err) = ++$fh;
+
+    if (!$dup_wtr) {
+	pipe($kid_rdr, $dad_wtr)    || die "open3: pipe 1 (stdin) failed: $!";
+    }
+    if (!$dup_rdr) {
+	pipe($dad_rdr, $kid_wtr)    || die "open3: pipe 2 (stdout) failed: $!";
+    }
+    if ($dad_err ne $dad_rdr && !$dup_err) {
+	pipe($dad_err, $kid_err)    || die "open3: pipe 3 (stderr) failed: $!";
+    }
+
+    if (($kidpid = fork) < 0) {
+        die "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+	if ($dup_wtr) {
+	    open(STDIN,  ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr));
+	} else {
+	    close($dad_wtr);
+	    open(STDIN,  ">&$kid_rdr");
+	}
+	if ($dup_rdr) {
+	    open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr));
+	} else {
+	    close($dad_rdr);
+	    open(STDOUT, ">&$kid_wtr");
+	}
+	if ($dad_rdr ne $dad_err) {
+	    if ($dup_err) {
+		open(STDERR, ">&$dad_err")
+		    if (fileno(STDERR) != fileno($dad_err));
+	    } else {
+		close($dad_err);
+		open(STDERR, ">&$kid_err");
+	    }
+	} else {
+	    open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT));
+	}
+	local($")=(" ");
+	exec @cmd;
+        die "open2: exec of @cmd failed";
+    }
+
+    close $kid_rdr; close $kid_wtr; close $kid_err;
+    if ($dup_wtr) {
+	close($dad_wtr);
+    }
+
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
diff --git a/gnu/usr.bin/perl/lib/overload.pm b/gnu/usr.bin/perl/lib/overload.pm
new file mode 100644
index 00000000000..54d2cbb4411
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/overload.pm
@@ -0,0 +1,489 @@
+package overload;
+
+sub OVERLOAD {
+  $package = shift;
+  my %arg = @_;
+  my $hash = \%{$package . "::OVERLOAD"};
+  for (keys %arg) {
+    $hash->{$_} = $arg{$_};
+  }
+}
+
+sub import {
+  $package = (caller())[0];
+  # *{$package . "::OVERLOAD"} = \&OVERLOAD;
+  shift;
+  $package->overload::OVERLOAD(@_);
+}
+
+sub unimport {
+  $package = (caller())[0];
+  my $hash = \%{$package . "::OVERLOAD"};
+  shift;
+  for (@_) {
+    delete $hash->{$_};
+  }
+}
+
+sub Overloaded {
+  defined ($package = ref $_[0]) and defined %{$package . "::OVERLOAD"};
+}
+
+sub OverloadedStringify {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      exists $ {$package . "::OVERLOAD"}{'""'} and
+	defined &{$ {$package . "::OVERLOAD"}{'""'}};
+}
+
+sub Method {
+  defined ($package = ref $_[0]) and 
+    defined %{$package . "::OVERLOAD"} and 
+      $ {$package . "::OVERLOAD"}{$_[1]};
+}
+
+sub AddrRef {
+  $package = ref $_[0];
+  bless $_[0], Overload::Fake;	# Non-overloaded package
+  my $str = "$_[0]";
+  bless $_[0], $package;	# Back
+  $str;
+}
+
+sub StrVal {
+  (OverloadedStringify) ?
+    (AddrRef) :
+    "$_[0]";
+}
+
+1;
+
+__END__
+
+=head1 NAME 
+
+overload - Package for overloading perl operations
+
+=head1 SYNOPSIS
+
+    package SomeThing;
+
+    use overload 
+	'+' => \&myadd,
+	'-' => \&mysub;
+	# etc
+    ...
+
+    package main;
+    $a = new SomeThing 57;
+    $b=5+$a;
+    ...
+    if (overload::Overloaded $b) {...}
+    ...
+    $strval = overload::StrVal $b;
+
+=head1 CAVEAT SCRIPTOR
+
+Overloading of operators is a subject not to be taken lightly.
+Neither its precise implementation, syntax, nor semantics are
+100% endorsed by Larry Wall.  So any of these may be changed 
+at some point in the future.
+
+=head1 DESCRIPTION
+
+=head2 Declaration of overloaded functions
+
+The compilation directive
+
+    package Number;
+    use overload
+	"+" => \&add, 
+	"*=" => "muas";
+
+declares function Number::add() for addition, and method muas() in
+the "class" C<Number> (or one of its base classes)
+for the assignment form C<*=> of multiplication.  
+
+Arguments of this directive come in (key, value) pairs.  Legal values
+are values legal inside a C<&{ ... }> call, so the name of a subroutine,
+a reference to a subroutine, or an anonymous subroutine will all work.
+Legal keys are listed below.
+
+The subroutine C<add> will be called to execute C<$a+$b> if $a
+is a reference to an object blessed into the package C<Number>, or if $a is
+not an object from a package with defined mathemagic addition, but $b is a
+reference to a C<Number>.  It can also be called in other situations, like
+C<$a+=7>, or C<$a++>.  See L<MAGIC AUTOGENERATION>.  (Mathemagical
+methods refer to methods triggered by an overloaded mathematical
+operator.)
+
+=head2 Calling Conventions for Binary Operations
+
+The functions specified in the C<use overload ...> directive are called
+with three (in one particular case with four, see L<Last Resort>)
+arguments.  If the corresponding operation is binary, then the first
+two arguments are the two arguments of the operation.  However, due to
+general object calling conventions, the first argument should always be
+an object in the package, so in the situation of C<7+$a>, the
+order of the arguments is interchanged.  It probably does not matter
+when implementing the addition method, but whether the arguments
+are reversed is vital to the subtraction method.  The method can
+query this information by examining the third argument, which can take
+three different values:
+
+=over 7
+
+=item FALSE
+
+the order of arguments is as in the current operation.
+
+=item TRUE
+
+the arguments are reversed.
+
+=item C<undef>
+
+the current operation is an assignment variant (as in
+C<$a+=7>), but the usual function is called instead.  This additional
+information can be used to generate some optimizations.
+
+=back
+
+=head2 Calling Conventions for Unary Operations
+
+Unary operation are considered binary operations with the second
+argument being C<undef>.  Thus the functions that overloads C<{"++"}>
+is called with arguments C<($a,undef,'')> when $a++ is executed.
+
+=head2 Overloadable Operations
+
+The following symbols can be specified in C<use overload>:
+
+=over 5
+
+=item * I<Arithmetic operations>
+
+    "+", "+=", "-", "-=", "*", "*=", "/", "/=", "%", "%=",
+    "**", "**=", "<<", "<<=", ">>", ">>=", "x", "x=", ".", ".=",
+
+For these operations a substituted non-assignment variant can be called if
+the assignment variant is not available.  Methods for operations "C<+>",
+"C<->", "C<+=>", and "C<-=>" can be called to automatically generate
+increment and decrement methods.  The operation "C<->" can be used to
+autogenerate missing methods for unary minus or C<abs>.
+
+=item * I<Comparison operations>
+
+    "<",  "<=", ">",  ">=", "==", "!=", "<=>",
+    "lt", "le", "gt", "ge", "eq", "ne", "cmp",
+
+If the corresponding "spaceship" variant is available, it can be
+used to substitute for the missing operation.  During C<sort>ing
+arrays, C<cmp> is used to compare values subject to C<use overload>.
+
+=item * I<Bit operations>
+
+    "&", "^", "|", "neg", "!", "~",
+
+"C<neg>" stands for unary minus.  If the method for C<neg> is not
+specified, it can be autogenerated using the method for subtraction.
+
+=item * I<Increment and decrement>
+
+    "++", "--",
+
+If undefined, addition and subtraction methods can be
+used instead.  These operations are called both in prefix and
+postfix form.
+
+=item * I<Transcendental functions>
+
+    "atan2", "cos", "sin", "exp", "abs", "log", "sqrt",
+
+If C<abs> is unavailable, it can be autogenerated using methods
+for "<" or "<=>" combined with either unary minus or subtraction.
+
+=item * I<Boolean, string and numeric conversion>
+
+    "bool", "\"\"", "0+",
+
+If one or two of these operations are unavailable, the remaining ones can
+be used instead.  C<bool> is used in the flow control operators
+(like C<while>) and for the ternary "C<?:>" operation.  These functions can
+return any arbitrary Perl value.  If the corresponding operation for this value
+is overloaded too, that operation will be called again with this value.
+
+=item * I<Special>
+
+    "nomethod", "fallback", "=",
+
+see L<SPECIAL SYMBOLS FOR C<use overload>>.
+
+=back
+
+See L<"Fallback"> for an explanation of when a missing method can be autogenerated.
+
+=head1 SPECIAL SYMBOLS FOR C<use overload>
+
+Three keys are recognized by Perl that are not covered by the above
+description.
+
+=head2  Last Resort
+
+C<"nomethod"> should be followed by a reference to a function of four
+parameters.  If defined, it is called when the overloading mechanism
+cannot find a method for some operation.  The first three arguments of
+this function coincide with the arguments for the corresponding method if
+it were found, the fourth argument is the symbol
+corresponding to the missing method.  If several methods are tried,
+the last one is used.  Say, C<1-$a> can be equivalent to
+
+	&nomethodMethod($a,1,1,"-")
+
+if the pair C<"nomethod" =E<gt> "nomethodMethod"> was specified in the
+C<use overload> directive.
+
+If some operation cannot be resolved, and there is no function
+assigned to C<"nomethod">, then an exception will be raised via die()--
+unless C<"fallback"> was specified as a key in C<use overload> directive.
+
+=head2 Fallback 
+
+The key C<"fallback"> governs what to do if a method for a particular
+operation is not found.  Three different cases are possible depending on
+the value of C<"fallback">:
+
+=over 16
+
+=item * C<undef>
+
+Perl tries to use a
+substituted method (see L<MAGIC AUTOGENERATION>).  If this fails, it
+then tries to calls C<"nomethod"> value; if missing, an exception
+will be raised.
+
+=item * TRUE
+
+The same as for the C<undef> value, but no exception is raised.  Instead,
+it silently reverts to what it would have done were there no C<use overload>
+present.
+
+=item * defined, but FALSE
+
+No autogeneration is tried.  Perl tries to call
+C<"nomethod"> value, and if this is missing, raises an exception. 
+
+=back
+
+=head2 Copy Constructor
+
+The value for C<"="> is a reference to a function with three
+arguments, i.e., it looks like the other values in C<use
+overload>. However, it does not overload the Perl assignment
+operator. This would go against Camel hair.
+
+This operation is called in the situations when a mutator is applied
+to a reference that shares its object with some other reference, such
+as
+
+	$a=$b; 
+	$a++;
+
+To make this change $a and not change $b, a copy of C<$$a> is made,
+and $a is assigned a reference to this new object.  This operation is
+done during execution of the C<$a++>, and not during the assignment,
+(so before the increment C<$$a> coincides with C<$$b>).  This is only
+done if C<++> is expressed via a method for C<'++'> or C<'+='>.  Note
+that if this operation is expressed via C<'+'> a nonmutator, i.e., as
+in
+
+	$a=$b; 
+	$a=$a+1;
+
+then C<$a> does not reference a new copy of C<$$a>, since $$a does not
+appear as lvalue when the above code is executed.
+
+If the copy constructor is required during the execution of some mutator,
+but a method for C<'='> was not specified, it can be autogenerated as a
+string copy if the object is a plain scalar.
+
+=over 5
+
+=item B<Example>
+
+The actually executed code for 
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	++$a;
+
+may be
+
+	$a=$b; 
+        Something else which does not modify $a or $b....
+	$a = $a->clone(undef,"");
+        $a->incr(undef,"");
+
+if $b was mathemagical, and C<'++'> was overloaded with C<\&incr>,
+C<'='> was overloaded with C<\&clone>.
+
+=back
+
+=head1 MAGIC AUTOGENERATION
+
+If a method for an operation is not found, and the value for  C<"fallback"> is
+TRUE or undefined, Perl tries to autogenerate a substitute method for
+the missing operation based on the defined operations.  Autogenerated method
+substitutions are possible for the following operations:
+
+=over 16
+
+=item I<Assignment forms of arithmetic operations>
+
+C<$a+=$b> can use the method for C<"+"> if the method for C<"+=">
+is not defined.
+
+=item I<Conversion operations> 
+
+String, numeric, and boolean conversion are calculated in terms of one
+another if not all of them are defined.
+
+=item I<Increment and decrement>
+
+The C<++$a> operation can be expressed in terms of C<$a+=1> or C<$a+1>,
+and C<$a--> in terms of C<$a-=1> and C<$a-1>.
+
+=item C<abs($a)>
+
+can be expressed in terms of C<$aE<lt>0> and C<-$a> (or C<0-$a>).
+
+=item I<Unary minus>
+
+can be expressed in terms of subtraction.
+
+=item I<Concatenation>
+
+can be expressed in terms of string conversion.
+
+=item I<Comparison operations> 
+
+can be expressed in terms of its "spaceship" counterpart: either
+C<E<lt>=E<gt>> or C<cmp>:
+ 
+    <, >, <=, >=, ==, != 	in terms of <=>
+    lt, gt, le, ge, eq, ne 	in terms of cmp
+
+=item I<Copy operator>
+
+can be expressed in terms of an assignment to the dereferenced value, if this
+value is a scalar and not a reference.
+
+=back
+
+=head1 WARNING
+
+The restriction for the comparison operation is that even if, for example,
+`C<cmp>' should return a blessed reference, the autogenerated `C<lt>'
+function will produce only a standard logical value based on the
+numerical value of the result of `C<cmp>'.  In particular, a working
+numeric conversion is needed in this case (possibly expressed in terms of
+other conversions).
+
+Similarly, C<.=>  and C<x=> operators lose their mathemagical properties
+if the string conversion substitution is applied.
+
+When you chop() a mathemagical object it is promoted to a string and its
+mathemagical properties are lost.  The same can happen with other
+operations as well.
+
+=head1 Run-time Overloading
+
+Since all C<use> directives are executed at compile-time, the only way to
+change overloading during run-time is to
+
+    eval 'use overload "+" => \&addmethod';
+
+You can also use
+
+    eval 'no overload "+", "--", "<="';
+
+though the use of these constructs during run-time is questionable.
+
+=head1 Public functions
+
+Package C<overload.pm> provides the following public functions:
+
+=over 5
+
+=item overload::StrVal(arg)
+
+Gives string value of C<arg> as in absence of stringify overloading.
+
+=item overload::Overloaded(arg)
+
+Returns true if C<arg> is subject to overloading of some operations.
+
+=item overload::Method(obj,op)
+
+Returns C<undef> or a reference to the method that implements C<op>.
+
+=back
+
+=head1 IMPLEMENTATION
+
+What follows is subject to change RSN.
+
+The table of methods for all operations is cached as magic in the
+symbol table hash for the package.  The table is rechecked for changes due to
+C<use overload>, C<no overload>, and @ISA only during
+C<bless>ing; so if they are changed dynamically, you'll need an
+additional fake C<bless>ing to update the table.
+
+(Every SVish thing has a magic queue, and magic is an entry in that queue.
+This is how a single variable may participate in multiple forms of magic
+simultaneously.  For instance, environment variables regularly have two
+forms at once: their %ENV magic and their taint magic.)
+
+If an object belongs to a package using overload, it carries a special
+flag.  Thus the only speed penalty during arithmetic operations without
+overloading is the checking of this flag.
+
+In fact, if C<use overload> is not present, there is almost no overhead for
+overloadable operations, so most programs should not suffer measurable
+performance penalties.  A considerable effort was made to minimize the overhead
+when overload is used and the current operation is overloadable but
+the arguments in question do not belong to packages using overload.  When
+in doubt, test your speed with C<use overload> and without it.  So far there
+have been no reports of substantial speed degradation if Perl is compiled
+with optimization turned on.
+
+There is no size penalty for data if overload is not used. 
+
+Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is 
+carried out before any operation that can imply an assignment to the
+object $a (or $b) refers to, like C<$a++>.  You can override this
+behavior by defining your own copy constructor (see L<"Copy Constructor">).
+
+It is expected that arguments to methods that are not explicitly supposed
+to be changed are constant (but this is not enforced).
+
+=head1 AUTHOR
+
+Ilya Zakharevich <F<ilya@math.mps.ohio-state.edu>>.
+
+=head1 DIAGNOSTICS
+
+When Perl is run with the B<-Do> switch or its equivalent, overloading
+induces diagnostic messages.
+
+=head1 BUGS
+
+Because it is used for overloading, the per-package associative array
+%OVERLOAD now has a special meaning in Perl.
+
+As shipped, mathemagical properties are not inherited via the @ISA tree.
+
+This document is confusing.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/lib/perl5db.pl b/gnu/usr.bin/perl/lib/perl5db.pl
new file mode 100644
index 00000000000..5c8d2727b72
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/perl5db.pl
@@ -0,0 +1,1446 @@
+package DB;
+
+# Debugger for Perl 5.00x; perl5db.pl patch level:
+
+$header = 'perl5db.pl patch level 0.94';
+
+# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
+# Latest version available: ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
+
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+# Johan Vromans -- upgrade to 4.0 pl 10
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+#
+# This file is automatically included if you do perl -d.
+# It's probably not useful to include this yourself.
+#
+# Perl supplies the values for @line and %sub.  It effectively inserts
+# a &DB'DB(<linenum>); in front of every place that can have a
+# breakpoint. Instead of a subroutine call it calls &DB::sub with
+# $DB::sub being the called subroutine. It also inserts a BEGIN
+# {require 'perl5db.pl'} before the first line.
+#
+# Note that no subroutine call is possible until &DB::sub is defined
+# (for subroutines defined outside this file). In fact the same is
+# true if $deep is not defined.
+#
+# $Log:	perldb.pl,v $
+
+#
+# At start reads $rcfile that may set important options.  This file
+# may define a subroutine &afterinit that will be executed after the
+# debugger is initialized.
+#
+# After $rcfile is read reads environment variable PERLDB_OPTS and parses
+# it as a rest of `O ...' line in debugger prompt.
+#
+# The options that can be specified only at startup:
+# [To set in $rcfile, call &parse_options("optionName=new_value").]
+#
+# TTY  - the TTY to use for debugging i/o.
+#
+# noTTY - if set, goes in NonStop mode.  On interrupt if TTY is not set
+# uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
+# Term::Rendezvous.  Current variant is to have the name of TTY in this
+# file.
+#
+# ReadLine - If false, dummy ReadLine is used, so you can debug
+# ReadLine applications.
+#
+# NonStop - if true, no i/o is performed until interrupt.
+#
+# LineInfo - file or pipe to print line number info to.  If it is a
+# pipe, a short "emacs like" message is used.
+#
+# Example $rcfile: (delete leading hashes!)
+#
+# &parse_options("NonStop=1 LineInfo=db.out");
+# sub afterinit { $trace = 1; }
+#
+# The script will run without human intervention, putting trace
+# information into db.out.  (If you interrupt it, you would better
+# reset LineInfo to something "interactive"!)
+#
+
+# Needed for the statement after exec():
+
+BEGIN { $ini_warn = $^W; $^W = 0 } # Switch compilation warnings off until another BEGIN.
+local($^W) = 0;			# Switch run-time warnings off during init.
+warn (			# Do not ;-)
+      $dumpvar::hashDepth,     
+      $dumpvar::arrayDepth,    
+      $dumpvar::dumpDBFiles,   
+      $dumpvar::dumpPackages,  
+      $dumpvar::quoteHighBit,  
+      $dumpvar::printUndef,    
+      $dumpvar::globPrint,     
+      $readline::Tk_toloop,    
+      $dumpvar::usageOnly,
+      @ARGS,
+      $Carp::CarpLevel,
+      $panic,
+      $first_time,
+     ) if 0;
+
+# Command-line + PERLLIB:
+@ini_INC = @INC;
+
+# $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!
+
+$trace = $signal = $single = 0;	# Uninitialized warning suppression
+                                # (local $^W cannot help - other packages!).
+@stack = (0);
+
+$option{PrintRet} = 1;
+
+@options     = qw(hashDepth arrayDepth DumpDBFiles DumpPackages 
+		  compactDump veryCompact quote HighBit undefPrint
+		  globPrint PrintRet UsageOnly frame
+		  TTY noTTY ReadLine NonStop LineInfo
+		  recallCommand ShellBang pager tkRunning
+		  signalLevel warnLevel dieLevel);
+
+%optionVars    = (
+		 hashDepth	=> \$dumpvar::hashDepth,
+		 arrayDepth	=> \$dumpvar::arrayDepth,
+		 DumpDBFiles	=> \$dumpvar::dumpDBFiles,
+		 DumpPackages	=> \$dumpvar::dumpPackages,
+		 HighBit	=> \$dumpvar::quoteHighBit,
+		 undefPrint	=> \$dumpvar::printUndef,
+		 globPrint	=> \$dumpvar::globPrint,
+		 tkRunning	=> \$readline::Tk_toloop,
+		 UsageOnly	=> \$dumpvar::usageOnly,     
+		  frame           => \$frame,
+);
+
+%optionAction  = (
+		  compactDump	=> \&dumpvar::compactDump,
+		  veryCompact	=> \&dumpvar::veryCompact,
+		  quote		=> \&dumpvar::quote,
+		  TTY		=> \&TTY,
+		  noTTY		=> \&noTTY,
+		  ReadLine	=> \&ReadLine,
+		  NonStop	=> \&NonStop,
+		  LineInfo	=> \&LineInfo,
+		  recallCommand	=> \&recallCommand,
+		  ShellBang	=> \&shellBang,
+		  pager		=> \&pager,
+		  signalLevel	=> \&signalLevel,
+		  warnLevel	=> \&warnLevel,
+		  dieLevel	=> \&dieLevel,
+		 );
+
+%optionRequire = (
+		  compactDump	=> 'dumpvar.pl',
+		  veryCompact	=> 'dumpvar.pl',
+		  quote		=> 'dumpvar.pl',
+		 );
+
+# These guys may be defined in $ENV{PERL5DB} :
+$rl = 1 unless defined $rl;
+warnLevel($warnLevel);
+dieLevel($dieLevel);
+signalLevel($signalLevel);
+&pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
+&recallCommand("!") unless defined $prc;
+&shellBang("!") unless defined $psh;
+
+if (-e "/dev/tty") {
+  $rcfile=".perldb";
+} else {
+  $rcfile="perldb.ini";
+}
+
+if (-f $rcfile) {
+    do "./$rcfile";
+} elsif (defined $ENV{LOGDIR} and -f "$ENV{LOGDIR}/$rcfile") {
+    do "$ENV{LOGDIR}/$rcfile";
+} elsif (defined $ENV{HOME} and -f "$ENV{HOME}/$rcfile") {
+    do "$ENV{HOME}/$rcfile";
+}
+
+if (defined $ENV{PERLDB_OPTS}) {
+  parse_options($ENV{PERLDB_OPTS});
+}
+
+if (exists $ENV{PERLDB_RESTART}) {
+  delete $ENV{PERLDB_RESTART};
+  # $restart = 1;
+  @hist = get_list('PERLDB_HIST');
+  my @visited = get_list("PERLDB_VISITED");
+  for (0 .. $#visited) {
+    %{$postponed{$visited[$_]}} = get_list("PERLDB_FILE_$_");
+  }
+  my %opt = get_list("PERLDB_OPT");
+  my ($opt,$val);
+  while (($opt,$val) = each %opt) {
+    $val =~ s/[\\\']/\\$1/g;
+    parse_options("$opt'$val'");
+  }
+  @INC = get_list("PERLDB_INC");
+  @ini_INC = @INC;
+}
+
+if ($notty) {
+  $runnonstop = 1;
+} else {
+  # Is Perl being run from Emacs?
+  $emacs = ((defined $main::ARGV[0]) and ($main::ARGV[0] eq '-emacs'));
+  $rl = 0, shift(@main::ARGV) if $emacs;
+
+  #require Term::ReadLine;
+
+  if (-e "/dev/tty") {
+    $console = "/dev/tty";
+  } elsif (-e "con") {
+    $console = "con";
+  } else {
+    $console = "sys\$command";
+  }
+
+  # Around a bug:
+  if (defined $ENV{OS2_SHELL} and $emacs) { # In OS/2
+    $console = undef;
+  }
+
+  $console = $tty if defined $tty;
+
+  if (defined $console) {
+    open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN");
+    open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR")
+      || open(OUT,">&STDOUT");	# so we don't dongle stdout
+  } else {
+    open(IN,"<&STDIN");
+    open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout
+    $console = 'STDIN/OUT';
+  }
+  # so open("|more") can read from STDOUT and so we don't dingle stdin
+  $IN = \*IN;
+
+  $OUT = \*OUT;
+  select($OUT);
+  $| = 1;			# for DB::OUT
+  select(STDOUT);
+
+  $LINEINFO = $OUT unless defined $LINEINFO;
+  $lineinfo = $console unless defined $lineinfo;
+
+  $| = 1;			# for real STDOUT
+
+  $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+  unless ($runnonstop) {
+    print $OUT "\nLoading DB routines from $header\n";
+    print $OUT ("Emacs support ",
+		$emacs ? "enabled" : "available",
+		".\n");
+    print $OUT "\nEnter h or `h h' for help.\n\n";
+  }
+}
+
+@ARGS = @ARGV;
+for (@args) {
+    s/\'/\\\'/g;
+    s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+}
+
+if (defined &afterinit) {	# May be defined in $rcfile
+  &afterinit();
+}
+
+############################################################ Subroutines
+
+sub DB {
+    unless ($first_time++) {	# Do when-running init
+      if ($runnonstop) {		# Disable until signal
+	for ($i=0; $i <= $#stack; ) {
+	    $stack[$i++] &= ~1;
+	}
+	$single = 0;
+	return;
+      }
+      # Define a subroutine in which we will stop
+#       eval <<'EOE';
+# sub at_end::db {"Debuggee terminating";}
+# END {
+#   $DB::step = 1; 
+#   print $OUT "Debuggee terminating.\n"; 
+#   &at_end::db;}
+# EOE
+    }
+    &save;
+    if ($doret) {
+	$doret = 0;
+	if ($option{PrintRet}) {
+	    print $OUT "$retctx context return from $lastsub:", 
+	      ($retctx eq 'list') ? "\n" : " " ;
+	    dumpit( ($retctx eq 'list') ? \@ret : $ret );
+	}
+    }
+    ($package, $filename, $line) = caller;
+    $filename_ini = $filename;
+    $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
+      "package $package;";	# this won't let them modify, alas
+    local(*dbline) = "::_<$filename";
+    install_breakpoints($filename) unless $visited{$filename}++;
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
+	if ($stop eq '1') {
+	    $signal |= 1;
+	} elsif ($stop) {
+	    $evalarg = "\$DB::signal |= do {$stop;}"; &eval;
+	    $dbline{$line} =~ s/;9($|\0)/$1/;
+	}
+    }
+    if ($single || $trace || $signal) {
+	$term || &setterm;
+	if ($emacs) {
+	    $position = "\032\032$filename:$line:0\n";
+	    print $LINEINFO $position;
+	} else {
+	    $sub =~ s/\'/::/;
+	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
+	    $prefix .= "$sub($filename:";
+	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
+	    if (length($prefix) > 30) {
+	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+		print $LINEINFO $position;
+		$prefix = "";
+		$infix = ":\t";
+	    } else {
+		$infix = "):\t";
+		$position = "$prefix$line$infix$dbline[$line]$after";
+		print $LINEINFO $position;
+	    }
+	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
+		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
+		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
+		print $LINEINFO $incr_pos;
+		$position .= $incr_pos;
+	    }
+	}
+    }
+    $evalarg = $action, &eval if $action;
+    if ($single || $signal) {
+	local $level = $level + 1;
+	$evalarg = $pre, &eval if $pre;
+	print $OUT $#stack . " levels deep in subroutine calls!\n"
+	  if $single & 4;
+	$start = $line;
+      CMD:
+	while (($term || &setterm),
+	       defined ($cmd=&readline("  DB" . ('<' x $level) .
+				       ($#hist+1) . ('>' x $level) .
+				       " "))) {
+	    #{			# <-- Do we know what this brace is for?
+		$single = 0;
+		$signal = 0;
+		$cmd =~ s/\\$/\n/ && do {
+		    $cmd .= &readline("  cont: ");
+		    redo CMD;
+		};
+		$cmd =~ /^q$/ && exit 0;
+		$cmd =~ /^$/ && ($cmd = $laststep);
+		push(@hist,$cmd) if length($cmd) > 1;
+	      PIPE: {
+		    ($i) = split(/\s+/,$cmd);
+		    eval "\$cmd =~ $alias{$i}", print $OUT $@ if $alias{$i};
+		    $cmd =~ /^h$/ && do {
+			print $OUT $help;
+			next CMD; };
+		    $cmd =~ /^h\s+h$/ && do {
+			print $OUT $summary;
+			next CMD; };
+		    $cmd =~ /^h\s+(\S)$/ && do {
+			my $asked = "\Q$1";
+			if ($help =~ /^($asked([\s\S]*?)\n)(\Z|[^\s$asked])/m) {
+			    print $OUT $1;
+			} else {
+			    print $OUT "`$asked' is not a debugger command.\n";
+			}
+			next CMD; };
+		    $cmd =~ /^t$/ && do {
+			$trace = !$trace;
+			print $OUT "Trace = ".($trace?"on":"off")."\n";
+			next CMD; };
+		    $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
+			$Srev = defined $2; $Spatt = $3; $Snocheck = ! defined $1;
+			foreach $subname (sort(keys %sub)) {
+			    if ($Snocheck or $Srev^($subname =~ /$Spatt/)) {
+				print $OUT $subname,"\n";
+			    }
+			}
+			next CMD; };
+		    $cmd =~ s/^X\b/V $package/;
+		    $cmd =~ /^V$/ && do {
+			$cmd = "V $package"; };
+		    $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+			local ($savout) = select($OUT);
+			$packname = $1;
+			@vars = split(' ',$2);
+			do 'dumpvar.pl' unless defined &main::dumpvar;
+			if (defined &main::dumpvar) {
+			    local $frame = 0;
+			    &main::dumpvar($packname,@vars);
+			} else {
+			    print $OUT "dumpvar.pl not available.\n";
+			}
+			select ($savout);
+			next CMD; };
+		    $cmd =~ s/^x\b/ / && do { # So that will be evaled
+			$onetimeDump = 1; };
+		    $cmd =~ /^f\b\s*(.*)/ && do {
+			$file = $1;
+			if (!$file) {
+			    print $OUT "The old f command is now the r command.\n";
+			    print $OUT "The new f command switches filenames.\n";
+			    next CMD;
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    if (($try) = grep(m#^_<.*$file#, keys %main::)) {{
+					      $file = substr($try,2);
+					      print "\n$file:\n";
+					  }}
+			}
+			if (!defined $main::{'_<' . $file}) {
+			    print $OUT "There's no code here matching $file.\n";
+			    next CMD;
+			} elsif ($file ne $filename) {
+			    *dbline = "::_<$file";
+			    $visited{$file}++;
+			    $max = $#dbline;
+			    $filename = $file;
+			    $start = 1;
+			    $cmd = "l";
+			} };
+		    $cmd =~ /^l\b\s*([\':A-Za-z_][\':\w]*)/ && do {
+			$subname = $1;
+			$subname =~ s/\'/::/;
+			$subname = "main::".$subname unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			@pieces = split(/:/,$sub{$subname});
+			$subrange = pop @pieces;
+			$file = join(':', @pieces);
+			if ($file ne $filename) {
+			    *dbline = "::_<$file";
+			    $visited{$file}++;
+			    $max = $#dbline;
+			    $filename = $file;
+			}
+			if ($subrange) {
+			    if (eval($subrange) < -$window) {
+				$subrange =~ s/-.*/+/;
+			    }
+			    $cmd = "l $subrange";
+			} else {
+			    print $OUT "Subroutine $subname not found.\n";
+			    next CMD;
+			} };
+		    $cmd =~ /^\.$/ && do {
+			$start = $line;
+			$filename = $filename_ini;
+			*dbline = "::_<$filename";
+			$max = $#dbline;
+			print $LINEINFO $position;
+			next CMD };
+		    $cmd =~ /^w\b\s*(\d*)$/ && do {
+			$incr = $window - 1;
+			$start = $1 if $1;
+			$start -= $preview;
+			#print $OUT 'l ' . $start . '-' . ($start + $incr);
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^-$/ && do {
+			$incr = $window - 1;
+			$cmd = 'l ' . ($start-$window*2) . '+'; };
+		    $cmd =~ /^l$/ && do {
+			$incr = $window - 1;
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do {
+			$start = $1 if $1;
+			$incr = $2;
+			$incr = $window - 1 unless $incr;
+			$cmd = 'l ' . $start . '-' . ($start + $incr); };
+		    $cmd =~ /^l\b\s*((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+			$end = (!defined $2) ? $max : ($4 ? $4 : $2);
+			$end = $max if $end > $max;
+			$i = $2;
+			$i = $line if $i eq '.';
+			$i = 1 if $i < 1;
+			if ($emacs) {
+			    print $OUT "\032\032$filename:$i:0\n";
+			    $i = $end;
+			} else {
+			    for (; $i <= $end; $i++) {
+			        ($stop,$action) = split(/\0/, $dbline{$i});
+			        $arrow = ($i==$line 
+					  and $filename eq $filename_ini) 
+				  ?  '==>' 
+				    : ':' ;
+				$arrow .= 'b' if $stop;
+				$arrow .= 'a' if $action;
+				print $OUT "$i$arrow\t", $dbline[$i];
+				last if $signal;
+			    }
+			}
+			$start = $i; # remember in case they want more
+			$start = $max if $start > $max;
+			next CMD; };
+		    $cmd =~ /^D$/ && do {
+			print $OUT "Deleting all breakpoints...\n";
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/^[^\0]+//;
+				if ($dbline{$i} =~ s/^\0?$//) {
+				    delete $dbline{$i};
+				}
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^L$/ && do {
+			for ($i = 1; $i <= $max; $i++) {
+			    if (defined $dbline{$i}) {
+				print $OUT "$i:\t", $dbline[$i];
+				($stop,$action) = split(/\0/, $dbline{$i});
+				print $OUT "  break if (", $stop, ")\n"
+				  if $stop;
+				print $OUT "  action:  ", $action, "\n"
+				  if $action;
+				last if $signal;
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
+			$subname = $1;
+			$cond = $2 || '1';
+			$subname =~ s/\'/::/;
+			$subname = "${'package'}::" . $subname
+			  unless $subname =~ /::/;
+			$subname = "main".$subname if substr($subname,0,2) eq "::";
+			# Filename below can contain ':'
+			($file,$i) = ($sub{$subname} =~ /^(.*):(.*)$/);
+			$i += 0;
+			if ($i) {
+			    $filename = $file;
+			    *dbline = "::_<$filename";
+			    $visited{$filename}++;
+			    $max = $#dbline;
+			    ++$i while $dbline[$i] == 0 && $i < $max;
+			    $dbline{$i} =~ s/^[^\0]*/$cond/;
+			} else {
+			    print $OUT "Subroutine $subname not found.\n";
+			}
+			next CMD; };
+		    $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
+			$i = ($1?$1:$line);
+			$cond = $2 || '1';
+			if ($dbline[$i] == 0) {
+			    print $OUT "Line $i not breakable.\n";
+			} else {
+			    $dbline{$i} =~ s/^[^\0]*/$cond/;
+			}
+			next CMD; };
+		    $cmd =~ /^d\b\s*(\d+)?/ && do {
+			$i = ($1?$1:$line);
+			$dbline{$i} =~ s/^[^\0]*//;
+			delete $dbline{$i} if $dbline{$i} eq '';
+			next CMD; };
+		    $cmd =~ /^A$/ && do {
+			for ($i = 1; $i <= $max ; $i++) {
+			    if (defined $dbline{$i}) {
+				$dbline{$i} =~ s/\0[^\0]*//;
+				delete $dbline{$i} if $dbline{$i} eq '';
+			    }
+			}
+			next CMD; };
+		    $cmd =~ /^O\s*$/ && do {
+			for (@options) {
+			    &dump_option($_);
+			}
+			next CMD; };
+		    $cmd =~ /^O\s*(\S.*)/ && do {
+			parse_options($1);
+			next CMD; };
+		    $cmd =~ /^<\s*(.*)/ && do {
+			$pre = action($1);
+			next CMD; };
+		    $cmd =~ /^>\s*(.*)/ && do {
+			$post = action($1);
+			next CMD; };
+		    $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
+			$i = $1; $j = $3;
+			if ($dbline[$i] == 0) {
+			    print $OUT "Line $i may not have an action.\n";
+			} else {
+			    $dbline{$i} =~ s/\0[^\0]*//;
+			    $dbline{$i} .= "\0" . action($j);
+			}
+			next CMD; };
+		    $cmd =~ /^n$/ && do {
+			$single = 2;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^s$/ && do {
+			$single = 1;
+			$laststep = $cmd;
+			last CMD; };
+		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+			$i = $1;
+			if ($i =~ /\D/) { # subroutine name
+			    ($file,$i) = ($sub{$i} =~ /^(.*):(.*)$/);
+			    $i += 0;
+			    if ($i) {
+			        $filename = $file;
+				*dbline = "::_<$filename";
+				$visited{$filename}++;
+				$max = $#dbline;
+				++$i while $dbline[$i] == 0 && $i < $max;
+			    } else {
+				print $OUT "Subroutine $subname not found.\n";
+				next CMD; 
+			    }
+			}
+			if ($i) {
+			    if ($dbline[$i] == 0) {
+				print $OUT "Line $i not breakable.\n";
+				next CMD;
+			    }
+			    $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
+			}
+			for ($i=0; $i <= $#stack; ) {
+			    $stack[$i++] &= ~1;
+			}
+			last CMD; };
+		    $cmd =~ /^r$/ && do {
+			$stack[$#stack] |= 1;
+			$doret = 1;
+			last CMD; };
+		    $cmd =~ /^R$/ && do {
+		        print $OUT "Warning: a lot of settings and command-line options may be lost!\n";
+			my (@script, @flags, $cl);
+			push @flags, '-w' if $ini_warn;
+			# Put all the old includes at the start to get
+			# the same debugger.
+			for (@ini_INC) {
+			  push @flags, '-I', $_;
+			}
+			# Arrange for setting the old INC:
+			set_list("PERLDB_INC", @ini_INC);
+			if ($0 eq '-e') {
+			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
+			    chomp ($cl =  $ {'::_<-e'}[$_]);
+			    push @script, '-e', $cl;
+			  }
+			} else {
+			  @script = $0;
+			}
+			set_list("PERLDB_HIST", 
+				 $term->Features->{getHistory} 
+				 ? $term->GetHistory : @hist);
+			my @visited = keys %visited;
+			set_list("PERLDB_VISITED", @visited);
+			set_list("PERLDB_OPT", %option);
+			for (0 .. $#visited) {
+			  *dbline = "::_<$visited[$_]";
+			  set_list("PERLDB_FILE_$_", %dbline);
+			}
+			$ENV{PERLDB_RESTART} = 1;
+			#print "$^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS";
+			exec $^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS;
+			print $OUT "exec failed: $!\n";
+			last CMD; };
+		    $cmd =~ /^T$/ && do {
+			local($p,$f,$l,$s,$h,$a,$e,$r,@a,@sub);
+			for ($i = 1; 
+			     ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); 
+			     $i++) {
+			    @a = ();
+			    for $arg (@args) {
+				$_ = "$arg";
+				s/([\'\\])/\\$1/g;
+				s/([^\0]*)/'$1'/
+				  unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+				s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+				s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+				push(@a, $_);
+			    }
+			    $w = $w ? '@ = ' : '$ = ';
+			    $a = $h ? '(' . join(', ', @a) . ')' : '';
+			    $e =~ s/\n\s*\;\s*\Z// if $e;
+			    $e =~ s/[\\\']/\\$1/g if $e;
+			    if ($r) {
+			      $s = "require '$e'";
+			    } elsif (defined $r) {
+			      $s = "eval '$e'";
+			    } elsif ($s eq '(eval)') {
+			      $s = "eval {...}";
+			    }
+			    $f = "file `$f'" unless $f eq '-e';
+			    push(@sub, "$w$s$a called from $f line $l\n");
+			    last if $signal;
+			}
+			for ($i=0; $i <= $#sub; $i++) {
+			    last if $signal;
+			    print $OUT $sub[$i];
+			}
+			next CMD; };
+		    $cmd =~ /^\/(.*)$/ && do {
+			$inpat = $1;
+			$inpat =~ s:([^\\])/$:$1:;
+			if ($inpat ne "") {
+			    eval '$inpat =~ m'."\a$inpat\a";	
+			    if ($@ ne "") {
+				print $OUT "$@";
+				next CMD;
+			    }
+			    $pat = $inpat;
+			}
+			$end = $start;
+			eval '
+			    for (;;) {
+				++$start;
+				$start = 1 if ($start > $max);
+				last if ($start == $end);
+				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+				    if ($emacs) {
+					print $OUT "\032\032$filename:$start:0\n";
+				    } else {
+					print $OUT "$start:\t", $dbline[$start], "\n";
+				    }
+				    last;
+				}
+			    } ';
+			print $OUT "/$pat/: not found\n" if ($start == $end);
+			next CMD; };
+		    $cmd =~ /^\?(.*)$/ && do {
+			$inpat = $1;
+			$inpat =~ s:([^\\])\?$:$1:;
+			if ($inpat ne "") {
+			    eval '$inpat =~ m'."\a$inpat\a";	
+			    if ($@ ne "") {
+				print $OUT "$@";
+				next CMD;
+			    }
+			    $pat = $inpat;
+			}
+			$end = $start;
+			eval '
+			    for (;;) {
+				--$start;
+				$start = $max if ($start <= 0);
+				last if ($start == $end);
+				if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+				    if ($emacs) {
+					print $OUT "\032\032$filename:$start:0\n";
+				    } else {
+					print $OUT "$start:\t", $dbline[$start], "\n";
+				    }
+				    last;
+				}
+			    } ';
+			print $OUT "?$pat?: not found\n" if ($start == $end);
+			next CMD; };
+		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
+			pop(@hist) if length($cmd) > 1;
+			$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
+			$cmd = $hist[$i] . "\n";
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$sh\s*/ && do {
+			&system($');
+			next CMD; };
+		    $cmd =~ /^$rc([^$rc].*)$/ && do {
+			$pat = "^$1";
+			pop(@hist) if length($cmd) > 1;
+			for ($i = $#hist; $i; --$i) {
+			    last if $hist[$i] =~ /$pat/;
+			}
+			if (!$i) {
+			    print $OUT "No such command!\n\n";
+			    next CMD;
+			}
+			$cmd = $hist[$i] . "\n";
+			print $OUT $cmd;
+			redo CMD; };
+		    $cmd =~ /^$sh$/ && do {
+			&system($ENV{SHELL}||"/bin/sh");
+			next CMD; };
+		    $cmd =~ /^$sh\s*/ && do {
+			&system($ENV{SHELL}||"/bin/sh","-c",$');
+			next CMD; };
+		    $cmd =~ /^H\b\s*(-(\d+))?/ && do {
+			$end = $2?($#hist-$2):0;
+			$hist = 0 if $hist < 0;
+			for ($i=$#hist; $i>$end; $i--) {
+			    print $OUT "$i: ",$hist[$i],"\n"
+			      unless $hist[$i] =~ /^.?$/;
+			};
+			next CMD; };
+		    $cmd =~ s/^p$/print \$DB::OUT \$_/;
+		    $cmd =~ s/^p\b/print \$DB::OUT /;
+		    $cmd =~ /^=/ && do {
+			if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) {
+			    $alias{$k}="s~$k~$v~";
+			    print $OUT "$k = $v\n";
+			} elsif ($cmd =~ /^=\s*$/) {
+			    foreach $k (sort keys(%alias)) {
+				if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) {
+				    print $OUT "$k = $v\n";
+				} else {
+				    print $OUT "$k\t$alias{$k}\n";
+				};
+			    };
+			};
+			next CMD; };
+		    $cmd =~ /^\|\|?\s*[^|]/ && do {
+			if ($pager =~ /^\|/) {
+			    open(SAVEOUT,">&STDOUT") || &warn("Can't save STDOUT");
+			    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
+			} else {
+			    open(SAVEOUT,">&OUT") || &warn("Can't save DB::OUT");
+			}
+			unless ($piped=open(OUT,$pager)) {
+			    &warn("Can't pipe output to `$pager'");
+			    if ($pager =~ /^\|/) {
+				open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+				open(STDOUT,">&SAVEOUT")
+				  || &warn("Can't restore STDOUT");
+				close(SAVEOUT);
+			    } else {
+				open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+			    }
+			    next CMD;
+			}
+			$SIG{PIPE}= "DB::catch" if $pager =~ /^\|/
+			  && "" eq $SIG{PIPE}  ||  "DEFAULT" eq $SIG{PIPE};
+			$selected= select(OUT);
+			$|= 1;
+			select( $selected ), $selected= "" unless $cmd =~ /^\|\|/;
+			$cmd =~ s/^\|+\s*//;
+			redo PIPE; };
+		    # XXX Local variants do not work!
+		    $cmd =~ s/^t\s/\$DB::trace = 1;\n/;
+		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
+		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
+		}		# PIPE:
+	    #}			# <-- Do we know what this brace is for?
+	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
+	    if ($onetimeDump) {
+		$onetimeDump = undef;
+	    } else {
+		print $OUT "\n";
+	    }
+	} continue {		# CMD:
+	    if ($piped) {
+		if ($pager =~ /^\|/) {
+		    $?= 0;  close(OUT) || &warn("Can't close DB::OUT");
+		    &warn( "Pager `$pager' failed: ",
+			  ($?>>8) > 128 ? ($?>>8)-256 : ($?>>8),
+			  ( $? & 128 ) ? " (core dumped)" : "",
+			  ( $? & 127 ) ? " (SIG ".($?&127).")" : "", "\n" ) if $?;
+		    open(OUT,">&STDOUT") || &warn("Can't restore DB::OUT");
+		    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
+		    $SIG{PIPE}= "DEFAULT" if $SIG{PIPE} eq "DB::catch";
+		    # Will stop ignoring SIGPIPE if done like nohup(1)
+		    # does SIGINT but Perl doesn't give us a choice.
+		} else {
+		    open(OUT,">&SAVEOUT") || &warn("Can't restore DB::OUT");
+		}
+		close(SAVEOUT);
+		select($selected), $selected= "" unless $selected eq "";
+		$piped= "";
+	    }
+	}			# CMD:
+	if ($post) {
+	    $evalarg = $post; &eval;
+	}
+    }				# if ($single || $signal)
+    ($@, $!, $,, $/, $\, $^W) = @saved;
+    ();
+}
+
+# The following code may be executed now:
+# BEGIN {warn 4}
+
+sub sub {
+    print $LINEINFO ' ' x $#stack, "entering $sub\n" if $frame;
+    push(@stack, $single);
+    $single &= 1;
+    $single |= 4 if $#stack == $deep;
+    if (wantarray) {
+	@ret = &$sub;
+	$single |= pop(@stack);
+	$retctx = "list";
+	$lastsub = $sub;
+print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	@ret;
+    } else {
+	$ret = &$sub;
+	$single |= pop(@stack);
+	$retctx = "scalar";
+	$lastsub = $sub;
+print $LINEINFO ' ' x $#stack, "exited $sub\n" if $frame;
+	$ret;
+    }
+}
+
+sub save {
+    @saved = ($@, $!, $,, $/, $\, $^W);
+    $, = ""; $/ = "\n"; $\ = ""; $^W = 0;
+}
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub eval {
+    my @res;
+    {
+	local (@stack) = @stack; # guard against recursive debugging
+	my $otrace = $trace;
+	my $osingle = $single;
+	my $od = $^D;
+	@res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
+	$trace = $otrace;
+	$single = $osingle;
+	$^D = $od;
+    }
+    my $at = $@;
+    eval "&DB::save";
+    if ($at) {
+	print $OUT $at;
+    } elsif ($onetimeDump) {
+	dumpit(\@res);
+    }
+}
+
+sub install_breakpoints {
+  my $filename = shift;
+  return unless exists $postponed{$filename};
+  my %break = %{$postponed{$filename}};
+  for (keys %break) {
+    my $i = $_;
+    #if (/\D/) {			# Subroutine name
+    #} 
+    $dbline{$i} = $break{$_};	# Cannot be done before the file is around
+  }
+}
+
+sub dumpit {
+    local ($savout) = select($OUT);
+    do 'dumpvar.pl' unless defined &main::dumpValue;
+    if (defined &main::dumpValue) {
+        local $frame = 0;
+	&main::dumpValue(shift);
+    } else {
+	print $OUT "dumpvar.pl not available.\n";
+    }
+    select ($savout);    
+}
+
+sub action {
+    my $action = shift;
+    while ($action =~ s/\\$//) {
+	#print $OUT "+ ";
+	#$action .= "\n";
+	$action .= &gets;
+    }
+    $action;
+}
+
+sub gets {
+    local($.);
+    #<IN>;
+    &readline("cont: ");
+}
+
+sub system {
+    # We save, change, then restore STDIN and STDOUT to avoid fork() since
+    # many non-Unix systems can do system() but have problems with fork().
+    open(SAVEIN,"<&STDIN") || &warn("Can't save STDIN");
+    open(SAVEOUT,">&OUT") || &warn("Can't save STDOUT");
+    open(STDIN,"<&IN") || &warn("Can't redirect STDIN");
+    open(STDOUT,">&OUT") || &warn("Can't redirect STDOUT");
+    system(@_);
+    open(STDIN,"<&SAVEIN") || &warn("Can't restore STDIN");
+    open(STDOUT,">&SAVEOUT") || &warn("Can't restore STDOUT");
+    close(SAVEIN); close(SAVEOUT);
+    &warn( "(Command returned ", ($?>>8) > 128 ? ($?>>8)-256 : ($?>>8), ")",
+	  ( $? & 128 ) ? " (core dumped)" : "",
+	  ( $? & 127 ) ? " (SIG ".($?&127).")" : "", "\n" ) if $?;
+    $?;
+}
+
+sub setterm {
+    local $frame = 0;
+    eval "require Term::ReadLine;" or die $@;
+    if ($notty) {
+	if ($tty) {
+	    open(IN,"<$tty") or die "Cannot open TTY `$TTY' for read: $!";
+	    open(OUT,">$tty") or die "Cannot open TTY `$TTY' for write: $!";
+	    $IN = \*IN;
+	    $OUT = \*OUT;
+	    my $sel = select($OUT);
+	    $| = 1;
+	    select($sel);
+	} else {
+	    eval "require Term::Rendezvous;" or die $@;
+	    my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
+	    my $term_rv = new Term::Rendezvous $rv;
+	    $IN = $term_rv->IN;
+	    $OUT = $term_rv->OUT;
+	}
+    }
+    if (!$rl) {
+	$term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+    } else {
+	$term = new Term::ReadLine 'perldb', $IN, $OUT;
+
+	$readline::rl_basic_word_break_characters .= "[:" 
+	  if defined $readline::rl_basic_word_break_characters 
+	    and index($readline::rl_basic_word_break_characters, ":") == -1;
+    }
+    $LINEINFO = $OUT unless defined $LINEINFO;
+    $lineinfo = $console unless defined $lineinfo;
+    $term->MinLine(2);
+    if ($term->Features->{setHistory} and "@hist" ne "?") {
+      $term->SetHistory(@hist);
+    }
+}
+
+sub readline {
+  if (@typeahead) {
+    my $left = @typeahead;
+    my $got = shift @typeahead;
+    print $OUT "auto(-$left)", shift, $got, "\n";
+    $term->AddHistory($got) 
+      if length($got) > 1 and defined $term->Features->{addHistory};
+    return $got;
+  }
+  local $frame = 0;
+  $term->readline(@_);
+}
+
+sub dump_option {
+    my ($opt, $val)= @_;
+    if (defined $optionVars{$opt}
+	and defined $ {$optionVars{$opt}}) {
+	$val = $ {$optionVars{$opt}};
+    } elsif (defined $optionAction{$opt}
+	and defined &{$optionAction{$opt}}) {
+	$val = &{$optionAction{$opt}}();
+    } elsif (defined $optionAction{$opt}
+	     and not defined $option{$opt}
+	     or defined $optionVars{$opt}
+	     and not defined $ {$optionVars{$opt}}) {
+	$val = 'N/A';
+    } else {
+	$val = $option{$opt};
+    }
+    $val =~ s/[\\\']/\\$&/g;
+    printf $OUT "%20s = '%s'\n", $opt, $val;
+}
+
+sub parse_options {
+    local($_)= @_;
+    while ($_ ne "") {
+	s/^(\w+)(\s*$|\W)// or print($OUT "Invalid option `$_'\n"), last;
+	my ($opt,$sep) = ($1,$2);
+	my $val;
+	if ("?" eq $sep) {
+	    print($OUT "Option query `$opt?' followed by non-space `$_'\n"), last
+	      if /^\S/;
+	    #&dump_option($opt);
+	} elsif ($sep !~ /\S/) {
+	    $val = "1";
+	} elsif ($sep eq "=") {
+	    s/^(\S*)($|\s+)//;
+	    $val = $1;
+	} else { #{ to "let some poor schmuck bounce on the % key in B<vi>."
+	    my ($end) = "\\" . substr( ")]>}$sep", index("([<{",$sep), 1 ); #}
+	    s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)// or
+	      print($OUT "Unclosed option value `$opt$sep$_'\n"), last;
+	    $val = $1;
+	    $val =~ s/\\([\\$end])/$1/g;
+	}
+	my ($option);
+	my $matches =
+	  grep(  /^\Q$opt/ && ($option = $_),  @options  );
+	$matches =  grep(  /^\Q$opt/i && ($option = $_),  @options  )
+	  unless $matches;
+	print $OUT "Unknown option `$opt'\n" unless $matches;
+	print $OUT "Ambiguous option `$opt'\n" if $matches > 1;
+	$option{$option} = $val if $matches == 1 and defined $val;
+	eval "local \$frame = 0; require '$optionRequire{$option}'"
+	  if $matches == 1 and defined $optionRequire{$option} and defined $val;
+	$ {$optionVars{$option}} = $val 
+	  if $matches == 1
+	    and defined $optionVars{$option} and defined $val;
+	& {$optionAction{$option}} ($val) 
+	  if $matches == 1
+	    and defined $optionAction{$option}
+	      and defined &{$optionAction{$option}} and defined $val;
+	&dump_option($option) if $matches == 1 && $OUT ne \*STDERR; # Not $rcfile
+        s/^\s+//;
+    }
+}
+
+sub set_list {
+  my ($stem,@list) = @_;
+  my $val;
+  $ENV{"$ {stem}_n"} = @list;
+  for $i (0 .. $#list) {
+    $val = $list[$i];
+    $val =~ s/\\/\\\\/g;
+    $val =~ s/[\0-\37\177\200-\377]/"\\0x" . unpack('H2',$&)/eg;
+    $ENV{"$ {stem}_$i"} = $val;
+  }
+}
+
+sub get_list {
+  my $stem = shift;
+  my @list;
+  my $n = delete $ENV{"$ {stem}_n"};
+  my $val;
+  for $i (0 .. $n - 1) {
+    $val = delete $ENV{"$ {stem}_$i"};
+    $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
+    push @list, $val;
+  }
+  @list;
+}
+
+sub catch {
+    $signal = 1;
+}
+
+sub warn {
+    my($msg)= join("",@_);
+    $msg .= ": $!\n" unless $msg =~ /\n$/;
+    print $OUT $msg;
+}
+
+sub TTY {
+    if ($term) {
+	&warn("Too late to set TTY!\n") if @_;
+    } else {
+	$tty = shift if @_;
+    }
+    $tty or $console;
+}
+
+sub noTTY {
+    if ($term) {
+	&warn("Too late to set noTTY!\n") if @_;
+    } else {
+	$notty = shift if @_;
+    }
+    $notty;
+}
+
+sub ReadLine {
+    if ($term) {
+	&warn("Too late to set ReadLine!\n") if @_;
+    } else {
+	$rl = shift if @_;
+    }
+    $rl;
+}
+
+sub NonStop {
+    if ($term) {
+	&warn("Too late to set up NonStop mode!\n") if @_;
+    } else {
+	$runnonstop = shift if @_;
+    }
+    $runnonstop;
+}
+
+sub pager {
+    if (@_) {
+	$pager = shift;
+	$pager="|".$pager unless $pager =~ /^(\+?\>|\|)/;
+    }
+    $pager;
+}
+
+sub shellBang {
+    if (@_) {
+	$sh = quotemeta shift;
+	$sh .= "\\b" if $sh =~ /\w$/;
+    }
+    $psh = $sh;
+    $psh =~ s/\\b$//;
+    $psh =~ s/\\(.)/$1/g;
+    &sethelp;
+    $psh;
+}
+
+sub recallCommand {
+    if (@_) {
+	$rc = quotemeta shift;
+	$rc .= "\\b" if $rc =~ /\w$/;
+    }
+    $prc = $rc;
+    $prc =~ s/\\b$//;
+    $prc =~ s/\\(.)/$1/g;
+    &sethelp;
+    $prc;
+}
+
+sub LineInfo {
+    return $lineinfo unless @_;
+    $lineinfo = shift;
+    my $stream = ($lineinfo =~ /^(\+?\>|\|)/) ? $lineinfo : ">$lineinfo";
+    $emacs = ($stream =~ /^\|/);
+    open(LINEINFO, "$stream") || &warn("Cannot open `$stream' for write");
+    $LINEINFO = \*LINEINFO;
+    my $save = select($LINEINFO);
+    $| = 1;
+    select($save);
+    $lineinfo;
+}
+
+sub sethelp {
+    $help = "
+T		Stack trace.
+s [expr]	Single step [in expr].
+n [expr]	Next, steps over subroutine calls [in expr].
+<CR>		Repeat last n or s command.
+r		Return from current subroutine.
+c [line]	Continue; optionally inserts a one-time-only breakpoint
+		at the specified line.
+l min+incr	List incr+1 lines starting at min.
+l min-max	List lines min through max.
+l line		List single line.
+l subname	List first window of lines from subroutine.
+l		List next window of lines.
+-		List previous window of lines.
+w [line]	List window around line.
+.		Return to the executed line.
+f filename	Switch to viewing filename.
+/pattern/	Search forwards for pattern; final / is optional.
+?pattern?	Search backwards for pattern; final ? is optional.
+L		List all breakpoints and actions for the current file.
+S [[!]pattern]	List subroutine names [not] matching pattern.
+t		Toggle trace mode.
+t expr		Trace through execution of expr.
+b [line] [condition]
+		Set breakpoint; line defaults to the current execution line;
+		condition breaks if it evaluates to true, defaults to '1'.
+b subname [condition]
+		Set breakpoint at first line of subroutine.
+d [line]	Delete the breakpoint for line.
+D		Delete all breakpoints.
+a [line] command
+		Set an action to be done before the line is executed.
+		Sequence is: check for breakpoint, print line if necessary,
+		do action, prompt user if breakpoint or step, evaluate line.
+A		Delete all actions.
+V [pkg [vars]]	List some (default all) variables in package (default current).
+		Use ~pattern and !pattern for positive and negative regexps.
+X [vars]	Same as \"V currentpackage [vars]\".
+x expr		Evals expression in array context, dumps the result.
+O [opt[=val]] [opt\"val\"] [opt?]...
+		Set or query values of options.  val defaults to 1.  opt can
+		be abbreviated.  Several options can be listed.
+    recallCommand, ShellBang:	chars used to recall command or spawn shell;
+    pager:			program for output of \"|cmd\";
+  The following options affect what happens with V, X, and x commands:
+    arrayDepth, hashDepth:	print only first N elements ('' for all);
+    compactDump, veryCompact:	change style of array and hash dump;
+    globPrint:			whether to print contents of globs;
+    DumpDBFiles:		dump arrays holding debugged files;
+    DumpPackages:		dump symbol tables of packages;
+    quote, HighBit, undefPrint:	change style of string dump;
+    tkRunning:			run Tk while prompting (with ReadLine);
+    signalLevel warnLevel dieLevel:	level of verbosity;
+  Option PrintRet affects printing of return value after r command,
+         frame    affects printing messages on entry and exit from subroutines.
+		During startup options are initialized from \$ENV{PERLDB_OPTS}.
+		You can put additional initialization options TTY, noTTY,
+		ReadLine, and NonStop there.
+< command	Define command to run before each prompt.
+> command	Define command to run after each prompt.
+$prc number	Redo a previous command (default previous command).
+$prc -number	Redo number'th-to-last command.
+$prc pattern	Redo last command that started with pattern.
+		See 'O recallCommand' too.
+$psh$psh cmd  	Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+  . ( $rc eq $sh ? "" : "
+$psh [cmd] 	Run cmd in subshell (forces \"\$SHELL -c 'cmd'\")." ) . "
+		See 'O shellBang' too.
+H -number	Display last number commands (default all).
+p expr		Same as \"print DB::OUT expr\" in current package.
+|dbcmd		Run debugger command, piping DB::OUT to current pager.
+||dbcmd		Same as |dbcmd but DB::OUT is temporarilly select()ed as well.
+\= [alias value]	Define a command alias, or list current aliases.
+command		Execute as a perl statement in current package.
+R		Pure-man-restart of debugger, debugger state and command-line
+		options are lost.
+h [db_command]	Get help [on a specific debugger command], enter |h to page.
+h h		Summary of debugger commands.
+q or ^D		Quit.
+
+";
+    $summary = <<"END_SUM";
+List/search source lines:               Control script execution:
+  l [ln|sub]  List source code            T           Stack trace
+  - or .      List previous/current line  s [expr]    Single step [in expr]
+  w [line]    List around line            n [expr]    Next, steps over subs
+  f filename  View source in file         <CR>        Repeat last n or s
+  /pattern/   Search forward              r           Return from subroutine
+  ?pattern?   Search backward             c [line]    Continue until line
+Debugger controls:                        L           List break pts & actions
+  O [...]     Set debugger options        t [expr]    Toggle trace [trace expr]
+  < command   Command for before prompt   b [ln] [c]  Set breakpoint
+  > command   Command for after prompt    b sub [c]   Set breakpoint for sub
+  $prc [N|pat]   Redo a previous command     d [line]    Delete a breakpoint
+  H [-num]    Display last num commands   D           Delete all breakpoints
+  = [a val]   Define/list an alias        a [ln] cmd  Do cmd before line
+  h [db_cmd]  Get help on command         A           Delete all actions
+  |[|]dbcmd   Send output to pager        $psh\[$psh\] syscmd Run cmd in a subprocess
+  q or ^D     Quit			  R	      Attempt a restart
+Data Examination:	      expr     Execute perl code, also see: s,n,t expr
+  S [[!]pat]	List subroutine names [not] matching pattern
+  V [Pk [Vars]]	List Variables in Package.  Vars can be ~pattern or !pattern.
+  X [Vars]	Same as \"V current_package [Vars]\".
+  x expr	Evals expression in array context, dumps the result.
+  p expr	Print expression (uses script's current package).
+END_SUM
+				# '); # Fix balance of Emacs parsing
+}
+
+sub diesignal {
+    local $frame = 0;
+    $SIG{'ABRT'} = DEFAULT;
+    kill 'ABRT', $$ if $panic++;
+    print $DB::OUT "Got $_[0]!\n";	# in the case cannot continue
+    local $SIG{__WARN__} = '';
+    require Carp; 
+    local $Carp::CarpLevel = 2;		# mydie + confess
+    &warn(Carp::longmess("Signal @_"));
+    kill 'ABRT', $$;
+}
+
+sub dbwarn { 
+  local $frame = 0;
+  local $SIG{__WARN__} = '';
+  require Carp; 
+  #&warn("Entering dbwarn\n");
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  #&warn("Warning in dbwarn\n");
+  &warn($mess); 
+  #&warn("Exiting dbwarn\n");
+}
+
+sub dbdie {
+  local $frame = 0;
+  local $SIG{__DIE__} = '';
+  local $SIG{__WARN__} = '';
+  my $i = 0; my $ineval = 0; my $sub;
+  #&warn("Entering dbdie\n");
+  if ($dieLevel != 2) {
+    while ((undef,undef,undef,$sub) = caller(++$i)) {
+      $ineval = 1, last if $sub eq '(eval)';
+    }
+    {
+      local $SIG{__WARN__} = \&dbwarn;
+      &warn(@_) if $dieLevel > 2; # Ineval is false during destruction?
+    }
+    #&warn("dieing quietly in dbdie\n") if $ineval and $dieLevel < 2;
+    die @_ if $ineval and $dieLevel < 2;
+  }
+  require Carp; 
+  # We do not want to debug this chunk (automatic disabling works
+  # inside DB::DB, but not in Carp).
+  my ($mysingle,$mytrace) = ($single,$trace);
+  $single = 0; $trace = 0;
+  my $mess = Carp::longmess(@_);
+  ($single,$trace) = ($mysingle,$mytrace);
+  #&warn("dieing loudly in dbdie\n");
+  die $mess;
+}
+
+sub warnLevel {
+  if (@_) {
+    $prevwarn = $SIG{__WARN__} unless $warnLevel;
+    $warnLevel = shift;
+    if ($warnLevel) {
+      $SIG{__WARN__} = 'DB::dbwarn';
+    } else {
+      $SIG{__WARN__} = $prevwarn;
+    }
+  }
+  $warnLevel;
+}
+
+sub dieLevel {
+  if (@_) {
+    $prevdie = $SIG{__DIE__} unless $dieLevel;
+    $dieLevel = shift;
+    if ($dieLevel) {
+      $SIG{__DIE__} = 'DB::dbdie'; # if $dieLevel < 2;
+      #$SIG{__DIE__} = 'DB::diehard' if $dieLevel >= 2;
+      print $OUT "Stack dump during die enabled", 
+        ( $dieLevel == 1 ? " outside of evals" : ""), ".\n";
+      print $OUT "Dump printed too.\n" if $dieLevel > 2;
+    } else {
+      $SIG{__DIE__} = $prevdie;
+      print $OUT "Default die handler restored.\n";
+    }
+  }
+  $dieLevel;
+}
+
+sub signalLevel {
+  if (@_) {
+    $prevsegv = $SIG{SEGV} unless $signalLevel;
+    $prevbus = $SIG{BUS} unless $signalLevel;
+    $signalLevel = shift;
+    if ($signalLevel) {
+      $SIG{SEGV} = 'DB::diesignal';
+      $SIG{BUS} = 'DB::diesignal';
+    } else {
+      $SIG{SEGV} = $prevsegv;
+      $SIG{BUS} = $prevbus;
+    }
+  }
+  $signalLevel;
+}
+
+# The following BEGIN is very handy if debugger goes havoc, debugging debugger?
+
+BEGIN {			# This does not compile, alas.
+  $IN = \*STDIN;		# For bugs before DB::OUT has been opened
+  $OUT = \*STDERR;		# For errors before DB::OUT has been opened
+  $sh = '!';
+  $rc = ',';
+  @hist = ('?');
+  $deep = 100;			# warning if stack gets this deep
+  $window = 10;
+  $preview = 3;
+  $sub = '';
+  #$SIG{__WARN__} = "DB::dbwarn";
+  #$SIG{__DIE__} = 'DB::dbdie';
+  #$SIG{SEGV} = "DB::diesignal";
+  #$SIG{BUS} = "DB::diesignal";
+  $SIG{INT} = "DB::catch";
+  #$SIG{FPE} = "DB::catch";
+  #warn "SIGFPE installed";
+  $warnLevel = 1 unless defined $warnLevel;
+  $dieLevel = 1 unless defined $dieLevel;
+  $signalLevel = 1 unless defined $signalLevel;
+
+  $db_stop = 0;			# Compiler warning
+  $db_stop = 1 << 30;
+  $level = 0;			# Level of recursive debugging
+}
+
+BEGIN {$^W = $ini_warn;}	# Switch warnings back
+
+#use Carp;			# This did break, left for debuggin
+
+1;
diff --git a/gnu/usr.bin/perl/lib/pwd.pl b/gnu/usr.bin/perl/lib/pwd.pl
new file mode 100644
index 00000000000..beb591679e2
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/pwd.pl
@@ -0,0 +1,58 @@
+;# pwd.pl - keeps track of current working directory in PWD environment var
+;#
+;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
+;#
+;# $Log:	pwd.pl,v $
+;#
+;# Usage:
+;#	require "pwd.pl";
+;#	&initpwd;
+;#	...
+;#	&chdir($newdir);
+
+package pwd;
+
+sub main'initpwd {
+    if ($ENV{'PWD'}) {
+	local($dd,$di) = stat('.');
+	local($pd,$pi) = stat($ENV{'PWD'});
+	if ($di != $pi || $dd != $pd) {
+	    chop($ENV{'PWD'} = `pwd`);
+	}
+    }
+    else {
+	chop($ENV{'PWD'} = `pwd`);
+    }
+    if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
+	local($pd,$pi) = stat($2);
+	local($dd,$di) = stat($1);
+	if ($di == $pi && $dd == $pd) {
+	    $ENV{'PWD'}="$2$3";
+	}
+    }
+}
+
+sub main'chdir {
+    local($newdir) = shift;
+    $newdir =~ s|/{2,}|/|g;
+    if (chdir $newdir) {
+	if ($newdir =~ m#^/#) {
+	    $ENV{'PWD'} = $newdir;
+	}
+	else {
+	    local(@curdir) = split(m#/#,$ENV{'PWD'});
+	    @curdir = '' unless @curdir;
+	    foreach $component (split(m#/#, $newdir)) {
+		next if $component eq '.';
+		pop(@curdir),next if $component eq '..';
+		push(@curdir,$component);
+	    }
+	    $ENV{'PWD'} = join('/',@curdir) || '/';
+	}
+    }
+    else {
+	0;
+    }
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/shellwords.pl b/gnu/usr.bin/perl/lib/shellwords.pl
new file mode 100644
index 00000000000..1c45a5a0903
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/shellwords.pl
@@ -0,0 +1,48 @@
+;# shellwords.pl
+;#
+;# Usage:
+;#	require 'shellwords.pl';
+;#	@words = &shellwords($line);
+;#	or
+;#	@words = &shellwords(@lines);
+;#	or
+;#	@words = &shellwords;		# defaults to $_ (and clobbers it)
+
+sub shellwords {
+    package shellwords;
+    local($_) = join('', @_) if @_;
+    local(@words,$snippet,$field);
+
+    s/^\s+//;
+    while ($_ ne '') {
+	$field = '';
+	for (;;) {
+	    if (s/^"(([^"\\]|\\.)*)"//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^"/) {
+		die "Unmatched double quote: $_\n";
+	    }
+	    elsif (s/^'(([^'\\]|\\.)*)'//) {
+		($snippet = $1) =~ s#\\(.)#$1#g;
+	    }
+	    elsif (/^'/) {
+		die "Unmatched single quote: $_\n";
+	    }
+	    elsif (s/^\\(.)//) {
+		$snippet = $1;
+	    }
+	    elsif (s/^([^\s\\'"]+)//) {
+		$snippet = $1;
+	    }
+	    else {
+		s/^\s+//;
+		last;
+	    }
+	    $field .= $snippet;
+	}
+	push(@words, $field);
+    }
+    @words;
+}
+1;
diff --git a/gnu/usr.bin/perl/lib/sigtrap.pm b/gnu/usr.bin/perl/lib/sigtrap.pm
new file mode 100644
index 00000000000..e099ac46581
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/sigtrap.pm
@@ -0,0 +1,79 @@
+package sigtrap;
+
+=head1 NAME
+
+sigtrap - Perl pragma to enable stack backtrace on unexpected signals
+
+=head1 SYNOPSIS
+
+    use sigtrap;
+    use sigtrap qw(BUS SEGV PIPE SYS ABRT TRAP);
+
+=head1 DESCRIPTION
+
+The C<sigtrap> pragma initializes some default signal handlers that print
+a stack dump of your Perl program, then sends itself a SIGABRT.  This
+provides a nice starting point if something horrible goes wrong.
+
+By default, handlers are installed for the ABRT, BUS, EMT, FPE, ILL, PIPE,
+QUIT, SEGV, SYS, TERM, and TRAP signals.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+
+require Carp;
+
+sub import {
+    my $pack = shift;
+    my @sigs = @_;
+    @sigs or @sigs = qw(QUIT ILL TRAP ABRT EMT FPE BUS SEGV SYS PIPE TERM);
+    foreach $sig (@sigs) {
+	$SIG{$sig} = 'sigtrap::trap';
+    }
+}
+
+sub trap {
+    package DB;		# To get subroutine args.
+    $SIG{'ABRT'} = DEFAULT;
+    kill 'ABRT', $$ if $panic++;
+    syswrite(STDERR, 'Caught a SIG', 12);
+    syswrite(STDERR, $_[0], length($_[0]));
+    syswrite(STDERR, ' at ', 4);
+    ($pack,$file,$line) = caller;
+    syswrite(STDERR, $file, length($file));
+    syswrite(STDERR, ' line ', 6);
+    syswrite(STDERR, $line, length($line));
+    syswrite(STDERR, "\n", 1);
+
+    # Now go for broke.
+    for ($i = 1; ($p,$f,$l,$s,$h,$w,$e,$r) = caller($i); $i++) {
+        @a = ();
+	for $arg (@args) {
+	    $_ = "$arg";
+	    s/([\'\\])/\\$1/g;
+	    s/([^\0]*)/'$1'/
+	      unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+	    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+	    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    push(@a, $_);
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	$e =~ s/\n\s*\;\s*\Z// if $e;
+	$e =~ s/[\\\']/\\$1/g if $e;
+	if ($r) {
+	    $s = "require '$e'";
+	} elsif (defined $r) {
+	    $s = "eval '$e'";
+	} elsif ($s eq '(eval)') {
+	    $s = "eval {...}";
+	}
+	$f = "file `$f'" unless $f eq '-e';
+	$mess = "$w$s$a called from $f line $l\n";
+	syswrite(STDERR, $mess, length($mess));
+    }
+    kill 'ABRT', $$;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/splain b/gnu/usr.bin/perl/lib/splain
new file mode 100644
index 00000000000..f40c51e0308
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/splain
@@ -0,0 +1,503 @@
+#!/usr/local/bin/perl
+eval 'exec perl -S $0  ${1+"$@"}'
+    if 0;
+
+use Config;
+$diagnostics::PODFILE= $Config{privlib} . "/pod/perldiag.pod";
+
+package diagnostics;
+require 5.001;
+use English;
+use Carp;
+
+=head1 NAME
+
+diagnostics - Perl compiler pragma to force verbose warning diagnostics
+
+splain - standalone program to do the same thing
+
+=head1 SYNOPSIS
+
+As a pragma:
+
+    use diagnostics;
+    use diagnostics -verbose;
+
+    enable  diagnostics;
+    disable diagnostics;
+
+Aa a program:
+
+    perl program 2>diag.out
+    splain [-v] [-p] diag.out
+
+
+=head1 DESCRIPTION
+
+=head2 The C<diagnostics> Pragma
+
+This module extends the terse diagnostics normally emitted by both the
+perl compiler and the perl interpeter, augmenting them wtih the more
+explicative and endearing descriptions found in L<perldiag>.  Like the
+other pragmata, it affects to compilation phase of your program rather
+than merely the execution phase.
+
+To use in your program as a pragma, merely invoke
+
+    use diagnostics;
+
+at the start (or near the start) of your program.  (Note 
+that this I<does> enable perl's B<-w> flag.)  Your whole
+compilation will then be subject(ed :-) to the enhanced diagnostics.
+These still go out B<STDERR>.
+
+Due to the interaction between runtime and compiletime issues,
+and because it's probably not a very good idea anyway,
+you may not use C<no diagnostics> to turn them off at compiletime.
+However, you may control there behaviour at runtime using the 
+disable() and enable() methods to turn them off and on respectively.
+
+The B<-verbose> flag first prints out the L<perldiag> introduction before
+any other diagnostics.  The $diagnostics::PRETTY can generate nicer escape
+sequences for pgers.
+
+=head2 The I<splain> Program
+
+While apparently a whole nuther program, I<splain> is actually nothing
+more than a link to the (executable) F<diagnostics.pm> module, as well as
+a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
+the C<use diagnostics -verbose> directive.
+The B<-p> flag is like the
+$diagnostics::PRETTY variable.  Since you're post-processing with 
+I<splain>, there's no sense in being able to enable() or disable() processing.
+
+Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
+
+=head1 EXAMPLES
+
+The following file is certain to trigger a few errors at both
+runtime and compiletime:
+
+    use diagnostics;
+    print NOWHERE "nothing\n";
+    print STDERR "\n\tThis message should be unadorned.\n";
+    warn "\tThis is a user warning";
+    print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
+    my $a, $b = scalar <STDIN>;
+    print "\n";
+    print $x/$y;
+
+If you prefer to run your program first and look at its problem
+afterwards, do this:
+
+    perl -w test.pl 2>test.out
+    ./splain < test.out
+
+Note that this is not in general possible in shells of more dubious heritage, 
+as the theorectical 
+
+    (perl -w test.pl >/dev/tty) >& test.out
+    ./splain < test.out
+
+Because you just moved the existing B<stdout> to somewhere else.
+
+If you don't want to modify your source code, but still have on-the-fly
+warnings, do this:
+
+    exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&- 
+
+Nifty, eh?
+
+If you want to control warnings on the fly, do something like this.
+Make sure you do the C<use> first, or you won't be able to get
+at the enable() or disable() methods.
+
+    use diagnostics; # checks entire compilation phase 
+	print "\ntime for 1st bogus diags: SQUAWKINGS\n";
+	print BOGUS1 'nada';
+	print "done with 1st bogus\n";
+
+    disable diagnostics; # only turns off runtime warnings
+	print "\ntime for 2nd bogus: (squelched)\n";
+	print BOGUS2 'nada';
+	print "done with 2nd bogus\n";
+
+    enable diagnostics; # turns back on runtime warnings
+	print "\ntime for 3rd bogus: SQUAWKINGS\n";
+	print BOGUS3 'nada';
+	print "done with 3rd bogus\n";
+
+    disable diagnostics;
+	print "\ntime for 4th bogus: (squelched)\n";
+	print BOGUS4 'nada';
+	print "done with 4th bogus\n";
+
+=head1 INTERNALS
+
+Diagnostic messages derive from the F<perldiag.pod> file when available at
+runtime.  Otherwise, they may be embedded in the file itself when the
+splain package is built.   See the F<Makefile> for details.
+
+If an extant $SIG{__WARN__} handler is discovered, it will continue
+to be honored, but only after the diagnostic::splainthis() function 
+(the module's $SIG{__WARN__} interceptor) has had its way with your
+warnings.
+
+There is a $diagnostics::DEBUG variable you may set if you're desperately
+curious what sorts of things are being intercepted.
+
+    BEGIN { $diagnostics::DEBUG = 1 } 
+
+
+=head1 BUGS
+
+Not being able to say "no diagnostics" is annoying, but may not be
+insurmountable.
+
+The C<-pretty> directive is called too late to affect matters.
+You have to to this instead, and I<before> you load the module.
+
+    BEGIN { $diagnostics::PRETTY = 1 } 
+
+I could start up faster by delaying compilation until it should be
+needed, but this gets a "panic: top_level"
+when using the pragma form in 5.001e.  
+
+While it's true that this documentation is somewhat subserious, if you use
+a program named I<splain>, you should expect a bit of whimsy.
+
+=head1 AUTHOR
+
+Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+
+=cut
+
+$DEBUG ||= 0;
+my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
+
+$OUTPUT_AUTOFLUSH = 1;
+
+local $_;
+
+CONFIG: {
+    $opt_p = $opt_d = $opt_v = $opt_f = '';
+    %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();  
+    %exact_duplicate = ();
+
+    unless (caller) { 
+	$standalone++;
+	require Getopt::Std;
+	Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+	$PODFILE = $opt_f if $opt_f;
+	$DEBUG = 2 if $opt_d;
+	$VERBOSE = $opt_v;
+	$PRETTY = $opt_p;
+    } 
+
+    if (open(POD_DIAG, $PODFILE)) {
+	warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
+	last CONFIG;
+    } 
+
+    if (caller) {
+	INCPATH: {
+	    for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+		warn "Checking $file\n" if $DEBUG;
+		if (open(POD_DIAG, $file)) {
+		    while (<POD_DIAG>) {
+			next unless /^__END__\s*# wish diag dbase were more accessible/;
+			print STDERR "podfile is $file\n" if $DEBUG;
+			last INCPATH;
+		    }
+		}
+	    } 
+	}
+    } else { 
+	print STDERR "podfile is <DATA>\n" if $DEBUG;
+	*POD_DIAG = *main::DATA;
+    }
+}
+if (eof(POD_DIAG)) { 
+    die "couldn't find diagnostic data in $PODFILE @INC $0";
+}
+
+
+%HTML_2_Troff = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    # etc
+
+);
+
+%HTML_2_Latin_1 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\xC1"	#   capital A, acute accent
+
+    # etc
+);
+
+%HTML_2_ASCII_7 = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A"	#   capital A, acute accent
+    # etc
+);
+
+*HTML_Escapes = do {
+    if ($standalone) {
+	$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
+    } else {
+	\%HTML_2_Latin_1; 
+    }
+}; 
+
+*THITHER = $standalone ? *STDOUT : *STDERR;
+
+$transmo = <<EOFUNC;
+sub transmo {
+    local \$^W = 0;  # recursive warnings we do NOT need!
+    study;
+EOFUNC
+
+### sub finish_compilation {  # 5.001e panic: top_level for embedded version
+    print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
+    ### local 
+    $RS = '';
+    local $_;
+    while (<POD_DIAG>) {
+	#s/(.*)\n//;
+	#$header = $1;
+
+	unescape();
+	if ($PRETTY) {
+	    sub noop   { return $_[0] }  # spensive for a noop
+	    sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; } 
+	    sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; } 
+	    s/[BC]<(.*?)>/bold($1)/ges;
+	    s/[LIF]<(.*?)>/italic($1)/ges;
+	} else {
+	    s/[BC]<(.*?)>/$1/gs;
+	    s/[LIF]<(.*?)>/$1/gs;
+	} 
+	unless (/^=/) {
+	    if (defined $header) { 
+		if ( $header eq 'DESCRIPTION' && 
+		    (   /Optional warnings are enabled/ 
+		     || /Some of these messages are generic./
+		    ) )
+		{
+		    next;
+		} 
+		s/^/    /gm;
+		$msg{$header} .= $_;
+	    }
+	    next;
+	} 
+	unless ( s/=item (.*)\s*\Z//) {
+
+	    if ( s/=head1\sDESCRIPTION//) {
+		$msg{$header = 'DESCRIPTION'} = '';
+	    }
+	    next;
+	}
+	$header = $1;
+
+	if ($header =~ /%[sd]/) {
+	    $rhs = $lhs = $header;
+	    #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g)  {
+	    if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g)  {
+		$lhs =~ s/\\%s/.*?/g;
+	    } else {
+		# if i had lookbehind negations, i wouldn't have to do this \377 noise
+		$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
+		#$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
+		$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
+		$lhs =~ s/\377//g;
+	    } 
+	    $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+	} else {
+	    $transmo .= "    m{^\Q$header\E} && return 1;\n";
+	} 
+
+	print STDERR "Already saw $header" if $msg{$header};
+
+	$msg{$header} = '';
+    } 
+
+
+    close POD_DIAG unless *main::DATA eq *POD_DIAG;
+
+    die "No diagnostics?" unless %msg;
+
+    $transmo .= "    return 0;\n}\n";
+    print STDERR $transmo if $DEBUG;
+    eval $transmo;
+    die $@ if $@;
+    $RS = "\n";
+### }
+
+if ($standalone) {
+    if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
+    while ($error = <>) {
+	splainthis($error) || print THITHER $error;
+    } 
+    exit;
+} else { 
+    $old_w = 0; $oldwarn = ''; $olddie = '';
+}
+
+sub import {
+    shift;
+    $old_w = $^W;
+    $^W = 1; # yup, clobbered the global variable; tough, if you
+	     # want diags, you want diags.
+    return if $SIG{__WARN__} eq \&warn_trap;
+
+    for (@_) {
+
+	/^-d(ebug)?$/ 	   	&& do {
+				    $DEBUG++;
+				    next;
+				   };
+
+	/^-v(erbose)?$/ 	&& do {
+				    $VERBOSE++;
+				    next;
+				   };
+
+	/^-p(retty)?$/ 		&& do {
+				    print STDERR "$0: I'm afraid it's too late for prettiness.\n";
+				    $PRETTY++;
+				    next;
+			       };
+
+	warn "Unknown flag: $_";
+    } 
+
+    $oldwarn = $SIG{__WARN__};
+    $olddie = $SIG{__DIE__};
+    $SIG{__WARN__} = \&warn_trap;
+    $SIG{__DIE__} = \&death_trap;
+} 
+
+sub enable { &import }
+
+sub disable {
+    shift;
+    $^W = $old_w;
+    return unless $SIG{__WARN__} eq \&warn_trap;
+    $SIG{__WARN__} = $oldwarn;
+    $SIG{__DIE__} = $olddie;
+} 
+
+sub warn_trap {
+    my $warning = $_[0];
+    if (caller eq $WHOAMI or !splainthis($warning)) {
+	print STDERR $warning;
+    } 
+    &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+};
+
+sub death_trap {
+    my $exception = $_[0];
+    splainthis($exception);
+    if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; } 
+    &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
+    $SIG{__DIE__} = $SIG{__WARN__} = '';
+    local($Carp::CarpLevel) = 1;
+    confess "Uncaught exception from user code:\n\t$exception";
+	# up we go; where we stop, nobody knows, but i think we die now
+	# but i'm deeply afraid of the &$olddie guy reraising and us getting
+	# into an indirect recursion loop
+};
+
+sub splainthis {
+    local $_ = shift;
+    ### &finish_compilation unless %msg;
+    s/\.?\n+$//;
+    my $orig = $_;
+    # return unless defined;
+    if ($exact_duplicate{$_}++) {
+	return 1;
+    } 
+    s/, <.*?> (?:line|chunk).*$//;
+    $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+    s/^\((.*)\)$/$1/;
+    return 0 unless &transmo;
+    $orig = shorten($orig);
+    if ($old_diag{$_}) {
+	autodescribe();
+	print THITHER "$orig (#$old_diag{$_})\n";
+	$wantspace = 1;
+    } else {
+	autodescribe();
+	$old_diag{$_} = ++$count;
+	print THITHER "\n" if $wantspace;
+	$wantspace = 0;
+	print THITHER "$orig (#$old_diag{$_})\n";
+	if ($msg{$_}) {
+	    print THITHER $msg{$_};
+	} else {
+	    if (0 and $standalone) { 
+		print THITHER "    **** Error #$old_diag{$_} ",
+			($real ? "is" : "appears to be"),
+			" an unknown diagnostic message.\n\n";
+	    }
+	    return 0;
+	} 
+    }
+    return 1;
+} 
+
+sub autodescribe {
+    if ($VERBOSE and not $count) {
+	print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
+		"\n$msg{DESCRIPTION}\n";
+    } 
+} 
+
+sub unescape { 
+    s {
+            E<  
+            ( [A-Za-z]+ )       
+            >   
+    } { 
+         do {   
+             exists $HTML_Escapes{$1}
+                ? do { $HTML_Escapes{$1} }
+                : do {
+                    warn "Unknown escape: $& in $_";
+                    "E<$1>";
+                } 
+         } 
+    }egx;
+}
+
+sub shorten {
+    my $line = $_[0];
+    if (length $line > 79) {
+	my $space_place = rindex($line, ' ', 79);
+	if ($space_place != -1) {
+	    substr($line, $space_place, 1) = "\n\t";
+	} 
+    } 
+    return $line;
+} 
+
+
+# have to do this: RS isn't set until run time, but we're executing at compile time
+$RS = "\n";
+
+1 unless $standalone;  # or it'll complain about itself
+__END__ # wish diag dbase were more accessible
diff --git a/gnu/usr.bin/perl/lib/stat.pl b/gnu/usr.bin/perl/lib/stat.pl
new file mode 100644
index 00000000000..f7c240a4b3e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/stat.pl
@@ -0,0 +1,31 @@
+;# $RCSfile: stat.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:13 $
+
+;# Usage:
+;#	require 'stat.pl';
+;#	@ary = stat(foo);
+;#	$st_dev = @ary[$ST_DEV];
+;#
+$ST_DEV =	0 + $[;
+$ST_INO =	1 + $[;
+$ST_MODE =	2 + $[;
+$ST_NLINK =	3 + $[;
+$ST_UID =	4 + $[;
+$ST_GID =	5 + $[;
+$ST_RDEV =	6 + $[;
+$ST_SIZE =	7 + $[;
+$ST_ATIME =	8 + $[;
+$ST_MTIME =	9 + $[;
+$ST_CTIME =	10 + $[;
+$ST_BLKSIZE =	11 + $[;
+$ST_BLOCKS =	12 + $[;
+
+;# Usage:
+;#	require 'stat.pl';
+;#	do Stat('foo');		# sets st_* as a side effect
+;#
+sub Stat {
+    ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
+	$st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(shift(@_));
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/strict.pm b/gnu/usr.bin/perl/lib/strict.pm
new file mode 100644
index 00000000000..6f6028cad4e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/strict.pm
@@ -0,0 +1,95 @@
+package strict;
+
+=head1 NAME
+
+strict - Perl pragma to restrict unsafe constructs
+
+=head1 SYNOPSIS
+
+    use strict;
+
+    use strict "vars";
+    use strict "refs";
+    use strict "subs";
+
+    use strict;
+    no strict "vars";
+
+=head1 DESCRIPTION
+
+If no import list is supplied, all possible restrictions are assumed.
+(This is the safest mode to operate in, but is sometimes too strict for
+casual programming.)  Currently, there are three possible things to be
+strict about:  "subs", "vars", and "refs".
+
+=over 6
+
+=item C<strict refs>
+
+This generates a runtime error if you 
+use symbolic references (see L<perlref>).
+
+    use strict 'refs';
+    $ref = \$foo;
+    print $$ref;	# ok
+    $ref = "foo";
+    print $$ref;	# runtime error; normally ok
+
+=item C<strict vars>
+
+This generates a compile-time error if you access a variable that wasn't
+localized via C<my()> or wasn't fully qualified.  Because this is to avoid
+variable suicide problems and subtle dynamic scoping issues, a merely
+local() variable isn't good enough.  See L<perlfunc/my> and
+L<perlfunc/local>.
+
+    use strict 'vars';
+    $X::foo = 1;	 # ok, fully qualified
+    my $foo = 10;	 # ok, my() var
+    local $foo = 9;	 # blows up
+
+The local() generated a compile-time error because you just touched a global
+name without fully qualifying it.
+
+=item C<strict subs>
+
+This disables the poetry optimization, generating a compile-time error if
+you try to use a bareword identifier that's not a subroutine, unless it
+appears in curly braces or on the left hand side of the "=>" symbol.
+
+
+    use strict 'subs';
+    $SIG{PIPE} = Plumber;   	# blows up
+    $SIG{PIPE} = "Plumber"; 	# just fine: bareword in curlies always ok
+    $SIG{PIPE} = \&Plumber; 	# preferred form
+
+
+
+=back
+
+See L<perlmod/Pragmatic Modules>.
+
+
+=cut
+
+sub bits {
+    my $bits = 0;
+    foreach $sememe (@_) {
+	$bits |= 0x00000002 if $sememe eq 'refs';
+	$bits |= 0x00000200 if $sememe eq 'subs';
+	$bits |= 0x00000400 if $sememe eq 'vars';
+    }
+    $bits;
+}
+
+sub import {
+    shift;
+    $^H |= bits(@_ ? @_ : qw(refs subs vars));
+}
+
+sub unimport {
+    shift;
+    $^H &= ~ bits(@_ ? @_ : qw(refs subs vars));
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/subs.pm b/gnu/usr.bin/perl/lib/subs.pm
new file mode 100644
index 00000000000..84c913a346a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/subs.pm
@@ -0,0 +1,32 @@
+package subs;
+
+=head1 NAME
+
+subs - Perl pragma to predeclare sub names
+
+=head1 SYNOPSIS
+
+    use subs qw(frob);
+    frob 3..10;
+
+=head1 DESCRIPTION
+
+This will predeclare all the subroutine whose names are 
+in the list, allowing you to use them without parentheses
+even before they're declared.
+
+See L<perlmod/Pragmatic Modules> and L<strict/subs>.
+
+=cut
+require 5.000;
+
+sub import {
+    my $callpack = caller;
+    my $pack = shift;
+    my @imports = @_;
+    foreach $sym (@imports) {
+	*{"${callpack}::$sym"} = \&{"${callpack}::$sym"};
+    }
+};
+
+1;
diff --git a/gnu/usr.bin/perl/lib/syslog.pl b/gnu/usr.bin/perl/lib/syslog.pl
new file mode 100644
index 00000000000..29c3a1cc9af
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/syslog.pl
@@ -0,0 +1,197 @@
+#
+# syslog.pl
+#
+# $Log:	syslog.pl,v $
+# 
+# tom christiansen <tchrist@convex.com>
+# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
+# NOTE: openlog now takes three arguments, just like openlog(3)
+#
+# call syslog() with a string priority and a list of printf() args
+# like syslog(3)
+#
+#  usage: require 'syslog.pl';
+#
+#  then (put these all in a script to test function)
+#		
+#
+#	do openlog($program,'cons,pid','user');
+#	do syslog('info','this is another test');
+#	do syslog('mail|warning','this is a better test: %d', time);
+#	do closelog();
+#	
+#	do syslog('debug','this is the last test');
+#	do openlog("$program $$",'ndelay','user');
+#	do syslog('notice','fooprogram: this is really done');
+#
+#	$! = 55;
+#	do syslog('info','problem was %m'); # %m == $! in syslog(3)
+
+package syslog;
+
+$host = 'localhost' unless $host;	# set $syslog'host to change
+
+if ($] >= 5) {
+    warn "You should 'use Sys::Syslog' instead; continuing" # if $^W
+} 
+
+require 'syslog.ph';
+
+ eval 'use Socket' 			||
+     eval { require "socket.ph" } 	||
+     require "sys/socket.ph";
+
+$maskpri = &LOG_UPTO(&LOG_DEBUG);
+
+sub main'openlog {
+    ($ident, $logopt, $facility) = @_;  # package vars
+    $lo_pid = $logopt =~ /\bpid\b/;
+    $lo_ndelay = $logopt =~ /\bndelay\b/;
+    $lo_cons = $logopt =~ /\bcons\b/;
+    $lo_nowait = $logopt =~ /\bnowait\b/;
+    &connect if $lo_ndelay;
+} 
+
+sub main'closelog {
+    $facility = $ident = '';
+    &disconnect;
+} 
+
+sub main'setlogmask {
+    local($oldmask) = $maskpri;
+    $maskpri = shift;
+    $oldmask;
+}
+ 
+sub main'syslog {
+    local($priority) = shift;
+    local($mask) = shift;
+    local($message, $whoami);
+    local(@words, $num, $numpri, $numfac, $sum);
+    local($facility) = $facility;	# may need to change temporarily.
+
+    die "syslog: expected both priority and mask" unless $mask && $priority;
+
+    @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
+    undef $numpri;
+    undef $numfac;
+    foreach (@words) {
+	$num = &xlate($_);		# Translate word to number.
+	if (/^kern$/ || $num < 0) {
+	    die "syslog: invalid level/facility: $_\n";
+	}
+	elsif ($num <= &LOG_PRIMASK) {
+	    die "syslog: too many levels given: $_\n" if defined($numpri);
+	    $numpri = $num;
+	    return 0 unless &LOG_MASK($numpri) & $maskpri;
+	}
+	else {
+	    die "syslog: too many facilities given: $_\n" if defined($numfac);
+	    $facility = $_;
+	    $numfac = $num;
+	}
+    }
+
+    die "syslog: level must be given\n" unless defined($numpri);
+
+    if (!defined($numfac)) {	# Facility not specified in this call.
+	$facility = 'user' unless $facility;
+	$numfac = &xlate($facility);
+    }
+
+    &connect unless $connected;
+
+    $whoami = $ident;
+
+    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+	$whoami = $1;
+	$mask = $2;
+    } 
+
+    unless ($whoami) {
+	($whoami = getlogin) ||
+	    ($whoami = getpwuid($<)) ||
+		($whoami = 'syslog');
+    }
+
+    $whoami .= "[$$]" if $lo_pid;
+
+    $mask =~ s/%m/$!/g;
+    $mask .= "\n" unless $mask =~ /\n$/;
+    $message = sprintf ($mask, @_);
+
+    $sum = $numpri + $numfac;
+    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+	if ($lo_cons) {
+	    if ($pid = fork) {
+		unless ($lo_nowait) {
+		    do {$died = wait;} until $died == $pid || $died < 0;
+		}
+	    }
+	    else {
+		open(CONS,">/dev/console");
+		print CONS "<$facility.$priority>$whoami: $message\r";
+		exit if defined $pid;		# if fork failed, we're parent
+		close CONS;
+	    }
+	}
+    }
+}
+
+sub xlate {
+    local($name) = @_;
+    $name =~ y/a-z/A-Z/;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "syslog'$name";
+    eval(&$name) || -1;
+}
+
+sub connect {
+    $pat = 'S n C4 x8';
+
+    $af_unix = &AF_UNIX;
+    $af_inet = &AF_INET;
+
+    $stream = &SOCK_STREAM;
+    $datagram = &SOCK_DGRAM;
+
+    ($name,$aliases,$proto) = getprotobyname('udp');
+    $udp = $proto;
+
+    ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
+    $syslog = $port;
+
+    if (chop($myname = `hostname`)) {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
+	die "Can't lookup $myname\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    else {
+	@bytes = (0,0,0,0);
+    }
+    $this = pack($pat, $af_inet, 0, @bytes);
+
+    if ($host =~ /^\d+\./) {
+	@bytes = split(/\./,$host);
+    }
+    else {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
+	die "Can't lookup $host\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    $that = pack($pat,$af_inet,$syslog,@bytes);
+
+    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
+    bind(SYSLOG,$this) || die "bind: $!\n";
+    connect(SYSLOG,$that) || die "connect: $!\n";
+
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/tainted.pl b/gnu/usr.bin/perl/lib/tainted.pl
new file mode 100644
index 00000000000..6e24867a83d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/tainted.pl
@@ -0,0 +1,9 @@
+# This subroutine returns true if its argument is tainted, false otherwise.
+
+sub tainted {
+    local($@);
+    eval { kill 0 * $_[0] };
+    $@ =~ /^Insecure/;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/termcap.pl b/gnu/usr.bin/perl/lib/termcap.pl
new file mode 100644
index 00000000000..e8f108df067
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/termcap.pl
@@ -0,0 +1,166 @@
+;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
+;#
+;# Usage:
+;#	require 'ioctl.pl';
+;#	ioctl(TTY,$TIOCGETP,$foo);
+;#	($ispeed,$ospeed) = unpack('cc',$foo);
+;#	require 'termcap.pl';
+;#	&Tgetent('vt100');	# sets $TC{'cm'}, etc.
+;#	&Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
+;#	&Tputs($TC{'dl'},$affcnt,'FILEHANDLE');
+;#
+sub Tgetent {
+    local($TERM) = @_;
+    local($TERMCAP,$_,$entry,$loop,$field);
+
+    warn "Tgetent: no ospeed set" unless $ospeed;
+    foreach $key (keys(TC)) {
+	delete $TC{$key};
+    }
+    $TERM = $ENV{'TERM'} unless $TERM;
+    $TERM =~ s/(\W)/\\$1/g;
+    $TERMCAP = $ENV{'TERMCAP'};
+    $TERMCAP = '/etc/termcap' unless $TERMCAP;
+    if ($TERMCAP !~ m:^/:) {
+	if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
+	    $TERMCAP = '/etc/termcap';
+	}
+    }
+    if ($TERMCAP =~ m:^/:) {
+	$entry = '';
+	do {
+	    $loop = "
+	    open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\";
+	    while (<TERMCAP>) {
+		next if /^#/;
+		next if /^\t/;
+		if (/(^|\\|)${TERM}[:\\|]/) {
+		    chop;
+		    while (chop eq '\\\\') {
+			\$_ .= <TERMCAP>;
+			chop;
+		    }
+		    \$_ .= ':';
+		    last;
+		}
+	    }
+	    close TERMCAP;
+	    \$entry .= \$_;
+	    ";
+	    eval $loop;
+	} while s/:tc=([^:]+):/:/ && ($TERM = $1);
+	$TERMCAP = $entry;
+    }
+
+    foreach $field (split(/:[\s:\\]*/,$TERMCAP)) {
+	if ($field =~ /^\w\w$/) {
+	    $TC{$field} = 1;
+	}
+	elsif ($field =~ /^(\w\w)#(.*)/) {
+	    $TC{$1} = $2 if $TC{$1} eq '';
+	}
+	elsif ($field =~ /^(\w\w)=(.*)/) {
+	    $entry = $1;
+	    $_ = $2;
+	    s/\\E/\033/g;
+	    s/\\(\d\d\d)/pack('c',$1 & 0177)/eg;
+	    s/\\n/\n/g;
+	    s/\\r/\r/g;
+	    s/\\t/\t/g;
+	    s/\\b/\b/g;
+	    s/\\f/\f/g;
+	    s/\\\^/\377/g;
+	    s/\^\?/\177/g;
+	    s/\^(.)/pack('c',ord($1) & 31)/eg;
+	    s/\\(.)/$1/g;
+	    s/\377/^/g;
+	    $TC{$entry} = $_ if $TC{$entry} eq '';
+	}
+    }
+    $TC{'pc'} = "\0" if $TC{'pc'} eq '';
+    $TC{'bc'} = "\b" if $TC{'bc'} eq '';
+}
+
+@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2);
+
+sub Tputs {
+    local($string,$affcnt,$FH) = @_;
+    local($ms);
+    if ($string =~ /(^[\d.]+)(\*?)(.*)$/) {
+	$ms = $1;
+	$ms *= $affcnt if $2;
+	$string = $3;
+	$decr = $Tputs[$ospeed];
+	if ($decr > .1) {
+	    $ms += $decr / 2;
+	    $string .= $TC{'pc'} x ($ms / $decr);
+	}
+    }
+    print $FH $string if $FH;
+    $string;
+}
+
+sub Tgoto {
+    local($string) = shift(@_);
+    local($result) = '';
+    local($after) = '';
+    local($code,$tmp) = @_;
+    local(@tmp);
+    @tmp = ($tmp,$code);
+    local($online) = 0;
+    while ($string =~ /^([^%]*)%(.)(.*)/) {
+	$result .= $1;
+	$code = $2;
+	$string = $3;
+	if ($code eq 'd') {
+	    $result .= sprintf("%d",shift(@tmp));
+	}
+	elsif ($code eq '.') {
+	    $tmp = shift(@tmp);
+	    if ($tmp == 0 || $tmp == 4 || $tmp == 10) {
+		if ($online) {
+		    ++$tmp, $after .= $TC{'up'} if $TC{'up'};
+		}
+		else {
+		    ++$tmp, $after .= $TC{'bc'};
+		}
+	    }
+	    $result .= sprintf("%c",$tmp);
+	    $online = !$online;
+	}
+	elsif ($code eq '+') {
+	    $result .= sprintf("%c",shift(@tmp)+ord($string));
+	    $string = substr($string,1,99);
+	    $online = !$online;
+	}
+	elsif ($code eq 'r') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($tmp,$code);
+	    $online = !$online;
+	}
+	elsif ($code eq '>') {
+	    ($code,$tmp,$string) = unpack("CCa99",$string);
+	    if ($tmp[$[] > $code) {
+		$tmp[$[] += $tmp;
+	    }
+	}
+	elsif ($code eq '2') {
+	    $result .= sprintf("%02d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq '3') {
+	    $result .= sprintf("%03d",shift(@tmp));
+	    $online = !$online;
+	}
+	elsif ($code eq 'i') {
+	    ($code,$tmp) = @tmp;
+	    @tmp = ($code+1,$tmp+1);
+	}
+	else {
+	    return "OOPS";
+	}
+    }
+    $result . $string . $after;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/timelocal.pl b/gnu/usr.bin/perl/lib/timelocal.pl
new file mode 100644
index 00000000000..75f1ac1851a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/timelocal.pl
@@ -0,0 +1,109 @@
+;# timelocal.pl
+;#
+;# Usage:
+;#	$time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+;#	$time = timegm($sec,$min,$hours,$mday,$mon,$year);
+
+;# These routines are quite efficient and yet are always guaranteed to agree
+;# with localtime() and gmtime().  We manage this by caching the start times
+;# of any months we've seen before.  If we know the start time of the month,
+;# we can always calculate any time within the month.  The start times
+;# themselves are guessed by successive approximation starting at the
+;# current time, since most dates seen in practice are close to the
+;# current date.  Unlike algorithms that do a binary search (calling gmtime
+;# once for each bit of the time value, resulting in 32 calls), this algorithm
+;# calls it at most 6 times, and usually only once or twice.  If you hit
+;# the month cache, of course, it doesn't call it at all.
+
+;# timelocal is implemented using the same cache.  We just assume that we're
+;# translating a GMT time, and then fudge it when we're done for the timezone
+;# and daylight savings arguments.  The timezone is determined by examining
+;# the result of localtime(0) when the package is initialized.  The daylight
+;# savings offset is currently assumed to be one hour.
+
+;# Both routines return -1 if the integer limit is hit. I.e. for dates
+;# after the 1st of January, 2038 on most machines.
+
+CONFIG: {
+    package timelocal;
+    
+    local($[) = 0;
+    @epoch = localtime(0);
+    $tzmin = $epoch[2] * 60 + $epoch[1];	# minutes east of GMT
+    if ($tzmin > 0) {
+	$tzmin = 24 * 60 - $tzmin;		# minutes west of GMT
+	$tzmin -= 24 * 60 if $epoch[5] == 70;	# account for the date line
+    }
+
+    $SEC = 1;
+    $MIN = 60 * $SEC;
+    $HR = 60 * $MIN;
+    $DAYS = 24 * $HR;
+    $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0;
+    1;
+}
+
+sub timegm {
+    package timelocal;
+
+    local($[) = 0;
+    $ym = pack(C2, @_[5,4]);
+    $cheat = $cheat{$ym} || &cheat;
+    return -1 if $cheat<0;
+    $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
+}
+
+sub timelocal {
+    package timelocal;
+
+    local($[) = 0;
+    $time = &main'timegm + $tzmin*$MIN;
+    return -1 if $cheat<0;
+    @test = localtime($time);
+    $time -= $HR if $test[2] != $_[2];
+    $time;
+}
+
+package timelocal;
+
+sub cheat {
+    $year = $_[5];
+    $month = $_[4];
+    die "Month out of range 0..11 in timelocal.pl\n" 
+	if $month > 11 || $month < 0;
+    die "Day out of range 1..31 in timelocal.pl\n" 
+	if $_[3] > 31 || $_[3] < 1;
+    die "Hour out of range 0..23 in timelocal.pl\n"
+	if $_[2] > 23 || $_[2] < 0;
+    die "Minute out of range 0..59 in timelocal.pl\n"
+	if $_[1] > 59 || $_[1] < 0;
+    die "Second out of range 0..59 in timelocal.pl\n"
+	if $_[0] > 59 || $_[0] < 0;
+    $guess = $^T;
+    @g = gmtime($guess);
+    $year += $YearFix if $year < $epoch[5];
+    $lastguess = "";
+    while ($diff = $year - $g[5]) {
+	$guess += $diff * (363 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    while ($diff = $month - $g[4]) {
+	$guess += $diff * (27 * $DAYS);
+	@g = gmtime($guess);
+	if (($thisguess = "@g") eq $lastguess){
+	    return -1; #date beyond this machine's integer limit
+	}
+	$lastguess = $thisguess;
+    }
+    @gfake = gmtime($guess-1); #still being sceptic
+    if ("@gfake" eq $lastguess){
+	return -1; #date beyond this machine's integer limit
+    }
+    $g[3]--;
+    $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS;
+    $cheat{$ym} = $guess;
+}
diff --git a/gnu/usr.bin/perl/lib/validate.pl b/gnu/usr.bin/perl/lib/validate.pl
new file mode 100644
index 00000000000..21d0505ad4d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/validate.pl
@@ -0,0 +1,104 @@
+;# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
+
+;# The validate routine takes a single multiline string consisting of
+;# lines containing a filename plus a file test to try on it.  (The
+;# file test may also be a 'cd', causing subsequent relative filenames
+;# to be interpreted relative to that directory.)  After the file test
+;# you may put '|| die' to make it a fatal error if the file test fails.
+;# The default is '|| warn'.  The file test may optionally have a ! prepended
+;# to test for the opposite condition.  If you do a cd and then list some
+;# relative filenames, you may want to indent them slightly for readability.
+;# If you supply your own "die" or "warn" message, you can use $file to
+;# interpolate the filename.
+
+;# Filetests may be bunched:  -rwx tests for all of -r, -w and -x.
+;# Only the first failed test of the bunch will produce a warning.
+
+;# The routine returns the number of warnings issued.
+
+;# Usage:
+;#	require "validate.pl";
+;#	$warnings += do validate('
+;#	/vmunix			-e || die
+;#	/boot			-e || die
+;#	/bin			cd
+;#	    csh			-ex
+;#	    csh			!-ug
+;#	    sh			-ex
+;#	    sh			!-ug
+;#	/usr			-d || warn "What happened to $file?\n"
+;#	');
+
+sub validate {
+    local($file,$test,$warnings,$oldwarnings);
+    foreach $check (split(/\n/,$_[0])) {
+	next if $check =~ /^#/;
+	next if $check =~ /^$/;
+	($file,$test) = split(' ',$check,2);
+	if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
+	    $testlist = $2;
+	    @testlist = split(//,$testlist);
+	}
+	else {
+	    @testlist = ('Z');
+	}
+	$oldwarnings = $warnings;
+	foreach $one (@testlist) {
+	    $this = $test;
+	    $this =~ s/(-\w\b)/$1 \$file/g;
+	    $this =~ s/-Z/-$one/;
+	    $this .= ' || warn' unless $this =~ /\|\|/;
+	    $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/;
+	    $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
+	    eval $this;
+	    last if $warnings > $oldwarnings;
+	}
+    }
+    $warnings;
+}
+
+sub valmess {
+    local($disposition,$this) = @_;
+    $file = $cwd . '/' . $file unless $file =~ m|^/|;
+    if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
+	$neg = $1;
+	$tmp = $2;
+	$tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
+	$tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
+	$tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
+	$tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
+	$tmp eq 'R' && ($mess = "$file is not readable by you.");
+	$tmp eq 'W' && ($mess = "$file is not writable by you.");
+	$tmp eq 'X' && ($mess = "$file is not executable by you.");
+	$tmp eq 'O' && ($mess = "$file is not owned by you.");
+	$tmp eq 'e' && ($mess = "$file does not exist.");
+	$tmp eq 'z' && ($mess = "$file does not have zero size.");
+	$tmp eq 's' && ($mess = "$file does not have non-zero size.");
+	$tmp eq 'f' && ($mess = "$file is not a plain file.");
+	$tmp eq 'd' && ($mess = "$file is not a directory.");
+	$tmp eq 'l' && ($mess = "$file is not a symbolic link.");
+	$tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
+	$tmp eq 'S' && ($mess = "$file is not a socket.");
+	$tmp eq 'b' && ($mess = "$file is not a block special file.");
+	$tmp eq 'c' && ($mess = "$file is not a character special file.");
+	$tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
+	$tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
+	$tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
+	$tmp eq 'T' && ($mess = "$file is not a text file.");
+	$tmp eq 'B' && ($mess = "$file is not a binary file.");
+	if ($neg eq '!') {
+	    $mess =~ s/ is not / should not be / ||
+	    $mess =~ s/ does not / should not / ||
+	    $mess =~ s/ not / /;
+	}
+	print stderr $mess,"\n";
+    }
+    else {
+	$this =~ s/\$file/'$file'/g;
+	print stderr "Can't do $this.\n";
+    }
+    if ($disposition eq 'die') { exit 1; }
+    ++$warnings;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/lib/vars.pm b/gnu/usr.bin/perl/lib/vars.pm
new file mode 100644
index 00000000000..b9519291c4b
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/vars.pm
@@ -0,0 +1,39 @@
+package vars;
+
+=head1 NAME
+
+vars - Perl pragma to predeclare global variable names
+
+=head1 SYNOPSIS
+
+    use vars qw($frob @mung %seen);
+
+=head1 DESCRIPTION
+
+This will predeclare all the variables whose names are 
+in the list, allowing you to use them under "use strict", and
+disabling any typo warnings.
+
+See L<perlmod/Pragmatic Modules>.
+
+=cut
+require 5.000;
+use Carp;
+
+sub import {
+    my $callpack = caller;
+    my ($pack, @imports, $sym, $ch) = @_;
+    foreach $sym (@imports) {
+	croak "Can't declare another package's variables" if $sym =~ /::/;
+        ($ch, $sym) = unpack('a1a*', $sym);
+        *{"${callpack}::$sym"} =
+          (  $ch eq "\$" ? \$   {"${callpack}::$sym"}
+           : $ch eq "\@" ? \@   {"${callpack}::$sym"}
+           : $ch eq "\%" ? \%   {"${callpack}::$sym"}
+           : $ch eq "\*" ? \*   {"${callpack}::$sym"}
+           : $ch eq "\&" ? \&   {"${callpack}::$sym"}
+           : croak "'$ch$sym' is not a valid variable name\n");
+    }
+};
+
+1;
diff --git a/gnu/usr.bin/perl/makeaperl.SH b/gnu/usr.bin/perl/makeaperl.SH
new file mode 100644
index 00000000000..6af94195d01
--- /dev/null
+++ b/gnu/usr.bin/perl/makeaperl.SH
@@ -0,0 +1,129 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting makeaperl (with variable substitutions)"
+$spitshell >makeaperl <<!GROK!THIS!
+$startperl
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+$spitshell >>makeaperl <<'!NO!SUBS!'
+
+=head1 NAME
+
+makeaperl - create a new perl binary from static extensions
+
+=head1 SYNOPSIS
+
+C<makeaperl -l library -m makefile -o target -t tempdir [object_files] [static_extensions] [search_directories]>
+
+=head1 DESCRIPTION
+
+This utility is designed to build new perl binaries from existing
+extensions on the fly. Called without any arguments it produces a new
+binary with the name C<perl> in the current directory. Intermediate
+files are produced in C</tmp>, if that is writeable, else in the
+current directory. The most important intermediate file is a Makefile,
+that is used internally to call C<make>. The new perl binary will consist
+
+The C<-l> switch lets you specify the name of a perl library to be
+linked into the new binary. If you do not specify a library, makeaperl
+writes targets for any C<libperl*.a> it finds in the search path. The
+topmost target will be the one related to C<libperl.a>.
+
+With the C<-m> switch you can provide a name for the Makefile that
+will be written (default C</tmp/Makefile.$$>). Likewise specifies the
+C<-o> switch a name for the perl binary (default C<perl>). The C<-t>
+switch lets you determine, in which directory the intermediate files
+should be stored.
+
+All object files and static extensions following on the command line
+will be linked into the target file. If there are any directories
+specified on the command line, these directories are searched for
+C<*.a> files, and all of the found ones will be linked in, too. If
+there is no directory named, then the contents of $INC[0] are
+searched.
+
+If the command fails, there is currently no other mechanism to adjust
+the behaviour of the program than to alter the generated Makefile and
+run C<make> by hand.
+
+=head1 AUTHORS
+Tim Bunce <Tim.Bunce@ig.co.uk>, Andreas Koenig
+<koenig@franz.ww.TU-Berlin.DE>; 
+
+=head2 STATUS
+First version, written 5 Feb 1995, is considered alpha.
+
+=cut
+
+use ExtUtils::MakeMaker;
+use Getopt::Long;
+use strict qw(subs refs);
+
+$Version = 1.0;
+$Verbose = 0;
+
+sub usage{
+    warn <<END;
+$0 version $Version
+
+$0: [options] [object_files] [static_extensions ...] [directories to search through]
+ -l perllibrary     perl library to link from (the first libperl.a found)
+ -m makefilename    name of the makefile to be written (/tmp/Makefile.\$\$)
+ -o name            name for perl executable (perl)
+ -t directory       directory where intermediate files reside (/tmp)
+END
+    exit 1;
+}
+
+if (-w "/tmp") {
+    $opt_t = "/tmp";
+} else {
+    $opt_t = ".";
+}
+$opt_l = '';
+$opt_m = "$opt_t/Makefile.$$";
+$opt_o = 'perl';
+
+$Getopt::Long::ignorecase=0;
+
+GetOptions('t=s', 'l=s', 'm=s', 'o=s') || die &usage;
+
+@dirs = grep -d $_, @ARGV;
+@fils = grep -f $_, @ARGV;
+
+@dirs = $INC[0] unless @dirs;
+
+open MAKE, ">$opt_m";
+MM->init_main();
+MM->init_others();
+print MAKE MM->makeaperl('MAKE'    => $opt_m,
+			 'TARGET'  => $opt_o,
+			 'TMP'     => $opt_t,
+			 'LIBPERL' => $opt_l,
+			 'DIRS'    => [@dirs], 
+			 'STAT'    => [@fils], 
+			 'INCL'    => [@dirs]
+);
+close MAKE;
+(system "make -f $opt_m") == 0 or die "$0 failed: Please check file $opt_m and run make -f $opt_m\n";
+!NO!SUBS!
+chmod 755 makeaperl
+$eunicefix makeaperl
diff --git a/gnu/usr.bin/perl/makedepend.SH b/gnu/usr.bin/perl/makedepend.SH
new file mode 100644
index 00000000000..acd9d7ecef3
--- /dev/null
+++ b/gnu/usr.bin/perl/makedepend.SH
@@ -0,0 +1,176 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting makedepend (with variable substitutions)"
+rm -f makedepend
+$spitshell >makedepend <<!GROK!THIS!
+$startsh
+# makedepend.SH
+#
+## To use an alternate make, set \$altmake in config.sh.
+MAKE=${altmake-make}
+!GROK!THIS!
+$spitshell >>makedepend <<'!NO!SUBS!'
+
+export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
+
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+
+# We need .. when we are in the x2p directory if we are using the
+# cppstdin wrapper script.
+# Put .. and . first so that we pick up the present cppstdin, not
+# an older one lying about in /usr/local/bin.
+PATH=".:..:$PATH"
+export PATH
+
+$cat /dev/null >.deptmp
+$rm -f *.c.c c/*.c.c
+if test -f Makefile; then
+    cp Makefile $firstmakefile
+fi
+mf=$firstmakefile
+if test -f $mf; then
+    defrule=`<$mf sed -n		\
+	-e '/^\.c\(\$(OBJ_EXT)\|\.o\):.*;/{'	\
+	-e    's/\$\*\.c//'		\
+	-e    's/^[^;]*;[	 ]*//p'	\
+	-e    q				\
+	-e '}'				\
+	-e '/^\.c\(\$(OBJ_EXT)\|\.o\): *$/{'	\
+	-e    N				\
+	-e    's/\$\*\.c//'		\
+	-e    's/^.*\n[	 ]*//p'		\
+	-e    q				\
+	-e '}'`
+fi
+case "$defrule" in
+'') defrule='$(CC) -c $(CFLAGS)' ;;
+esac
+
+: Create files in UU directory to avoid problems with long filenames
+: on systems with 14 character filename limits so file.c.c and file.c
+: might be identical
+$test -d UU || mkdir UU
+
+$MAKE clist || ($echo "Searching for .c files..."; \
+	$echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
+for file in `$cat .clist`; do
+# for file in `cat /dev/null`; do
+    case "$file" in
+    *.c) filebase=`basename $file .c` ;;
+    *.y) filebase=`basename $file .y` ;;
+    esac
+    case "$file" in
+    */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;;
+    *)   finc= ;;
+    esac
+    $echo "Finding dependencies for $filebase$obj_ext."
+    ( $echo "#line 1 \"$file\""; \
+      $sed -n <$file \
+	-e "/^${filebase}_init(/q" \
+	-e '/^#line/d' \
+	-e '/^#/{' \
+	-e 's|/\*.*$||' \
+	-e 's|\\$||' \
+	-e p \
+	-e '}' ) >UU/$file.c
+    $cppstdin $finc -I/usr/local/include -I. $cppflags $cppminus <UU/$file.c |
+    $sed \
+	-e '/^#.*<stdin>/d' \
+	-e 's#\.[0-9][0-9]*\.c#'"$file.c#" \
+	-e 's/^[	 ]*#[	 ]*line/#/' \
+	-e '/^# *[0-9][0-9]* *[".\/]/!d' \
+	-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
+	-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
+	-e 's|: \./|: |' \
+	-e 's|\.c\.c|.c|' | \
+    $uniq | $sort | $uniq >> .deptmp
+done
+
+$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d'
+
+$MAKE shlist || ($echo "Searching for .SH files..."; \
+	$echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
+
+# Now extract the dependency on makedepend.SH
+# (it should reside in the main Makefile):
+mv .shlist .shlist.old
+$egrep -v '^makedepend\.SH' <.shlist.old >.shlist
+rm .shlist.old
+
+if $test -s .deptmp; then
+    for file in `cat .shlist`; do
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \
+	    /bin/sh $file >> .deptmp
+    done
+    $echo "Updating $mf..."
+    $echo "# If this runs make out of memory, delete /usr/include lines." \
+	>> $mf.new
+    $sed 's|^\(.*\(\$(OBJ_EXT)\|\.o\):\) *\(.*/.*\.c\) *$|\1 \3; '"$defrule \2|" .deptmp \
+       >>$mf.new
+else
+    $MAKE hlist || ($echo "Searching for .h files..."; \
+	$echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
+    $echo "You don't seem to have a proper C preprocessor.  Using grep instead."
+    $egrep '^#include ' `cat .clist` `cat .hlist`  >.deptmp
+    $echo "Updating $mf..."
+    <.clist $sed -n							\
+	-e '/\//{'							\
+	-e   's|^\(.*\)/\(.*\)\.c|\2\$(OBJ_EXT): \1/\2.c; '"$defrule \1/\2.c|p"	\
+	-e   d								\
+	-e '}'								\
+	-e 's|^\(.*\)\.c|\1\$(OBJ_EXT): \1.c|p' >> $mf.new
+    <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
+    <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
+       $sed 's|^[^;]*/||' | \
+       $sed -f .hsed >> $mf.new
+    <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
+       $sed -f .hsed >> $mf.new
+    for file in `$cat .shlist`; do
+	$echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \
+	    /bin/sh $file >> $mf.new
+    done
+fi
+$rm -f $mf.old
+$cp $mf $mf.old
+$cp $mf.new $mf
+$rm $mf.new
+$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf
+$rm -rf .deptmp UU .shlist .clist .hlist .hsed
+
+!NO!SUBS!
+$eunicefix makedepend
+chmod +x makedepend
+case `pwd` in
+*SH)
+    $rm -f ../makedepend
+    ln makedepend ../makedepend
+    ;;
+esac
diff --git a/gnu/usr.bin/perl/makedir.SH b/gnu/usr.bin/perl/makedir.SH
new file mode 100644
index 00000000000..09908edff27
--- /dev/null
+++ b/gnu/usr.bin/perl/makedir.SH
@@ -0,0 +1,68 @@
+case $CONFIG in
+'')
+    if test ! -f config.sh; then
+	ln ../config.sh . || \
+	ln ../../config.sh . || \
+	ln ../../../config.sh . || \
+	(echo "Can't find config.sh."; exit 1)
+    fi 2>/dev/null
+    . ./config.sh
+    ;;
+esac
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting makedir (with variable substitutions)"
+rm -f makedir
+$spitshell >makedir <<!GROK!THIS!
+$startsh
+# makedir.SH
+# 
+
+export PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
+
+case \$# in
+  0)
+    $echo "makedir pathname filenameflag"
+    exit 1
+    ;;
+esac
+
+: guarantee one slash before 1st component
+case \$1 in
+  /*) ;;
+  *)  set ./\$1 \$2 ;;
+esac
+
+: strip last component if it is to be a filename
+case X\$2 in
+  X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
+  *)  set \$1 ;;
+esac
+
+: return reasonable status if nothing to be created
+if $test -d "\$1" ; then
+    exit 0
+fi
+
+list=''
+while true ; do
+    case \$1 in
+    */*)
+	list="\$1 \$list"
+	set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
+	;;
+    *)
+	break
+	;;
+    esac
+done
+
+set \$list
+
+for dir do
+    $mkdir \$dir >/dev/null 2>&1
+done
+!GROK!THIS!
+$eunicefix makedir
+chmod +x makedir
diff --git a/gnu/usr.bin/perl/malloc.c b/gnu/usr.bin/perl/malloc.c
new file mode 100644
index 00000000000..581cbd37550
--- /dev/null
+++ b/gnu/usr.bin/perl/malloc.c
@@ -0,0 +1,478 @@
+/*    malloc.c
+ *
+ */
+
+#ifndef lint
+#ifdef DEBUGGING
+#define RCHECK
+#endif
+/*
+ * malloc.c (Caltech) 2/21/82
+ * Chris Kingsley, kingsley@cit-20.
+ *
+ * This is a very fast storage allocator.  It allocates blocks of a small 
+ * number of different sizes, and keeps free lists of each size.  Blocks that
+ * don't exactly fit are passed up to the next larger size.  In this 
+ * implementation, the available sizes are 2^n-4 (or 2^n-12) bytes long.
+ * This is designed for use in a program that uses vast quantities of memory,
+ * but bombs when it runs out. 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* I don't much care whether these are defined in sys/types.h--LAW */
+
+#define u_char unsigned char
+#define u_int unsigned int
+#define u_short unsigned short
+
+/*
+ * The overhead on a block is at least 4 bytes.  When free, this space
+ * contains a pointer to the next free block, and the bottom two bits must
+ * be zero.  When in use, the first byte is set to MAGIC, and the second
+ * byte is the size index.  The remaining bytes are for alignment.
+ * If range checking is enabled and the size of the block fits
+ * in two bytes, then the top two bytes hold the size of the requested block
+ * plus the range checking words, and the header word MINUS ONE.
+ */
+union	overhead {
+	union	overhead *ov_next;	/* when free */
+#if MEM_ALIGNBYTES > 4
+	double	strut;			/* alignment problems */
+#endif
+	struct {
+		u_char	ovu_magic;	/* magic number */
+		u_char	ovu_index;	/* bucket # */
+#ifdef RCHECK
+		u_short	ovu_size;	/* actual block size */
+		u_int	ovu_rmagic;	/* range magic number */
+#endif
+	} ovu;
+#define	ov_magic	ovu.ovu_magic
+#define	ov_index	ovu.ovu_index
+#define	ov_size		ovu.ovu_size
+#define	ov_rmagic	ovu.ovu_rmagic
+};
+
+#ifdef debug
+static void botch _((char *s));
+#endif
+static void morecore _((int bucket));
+static int findbucket _((union overhead *freep, int srchlen));
+
+#define	MAGIC		0xff		/* magic # on accounting info */
+#define RMAGIC		0x55555555	/* magic # on range info */
+#ifdef RCHECK
+#define	RSLOP		sizeof (u_int)
+#else
+#define	RSLOP		0
+#endif
+
+/*
+ * nextf[i] is the pointer to the next free block of size 2^(i+3).  The
+ * smallest allocatable block is 8 bytes.  The overhead information
+ * precedes the data area returned to the user.
+ */
+#define	NBUCKETS 30
+static	union overhead *nextf[NBUCKETS];
+extern	char *sbrk();
+
+#ifdef DEBUGGING_MSTATS
+/*
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
+ */
+static	u_int nmalloc[NBUCKETS];
+#include <stdio.h>
+#endif
+
+#ifdef debug
+#define	ASSERT(p)   if (!(p)) botch("p"); else
+static void
+botch(s)
+	char *s;
+{
+
+	printf("assertion botched: %s\n", s);
+	abort();
+}
+#else
+#define	ASSERT(p)
+#endif
+
+Malloc_t
+malloc(nbytes)
+	register MEM_SIZE nbytes;
+{
+  	register union overhead *p;
+  	register int bucket = 0;
+  	register MEM_SIZE shiftr;
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+	MEM_SIZE size = nbytes;
+#endif
+
+#ifdef MSDOS
+	if (nbytes > 0xffff) {
+		fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
+		my_exit(1);
+	}
+#endif /* MSDOS */
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+	    croak("panic: malloc");
+#endif
+#endif /* safemalloc */
+
+	/*
+	 * Convert amount of memory requested into
+	 * closest block size stored in hash buckets
+	 * which satisfies request.  Account for
+	 * space used per block for accounting.
+	 */
+  	nbytes += sizeof (union overhead) + RSLOP;
+  	nbytes = (nbytes + 3) &~ 3; 
+  	shiftr = (nbytes - 1) >> 2;
+	/* apart from this loop, this is O(1) */
+  	while (shiftr >>= 1)
+  		bucket++;
+	/*
+	 * If nothing in hash bucket right now,
+	 * request more memory from the system.
+	 */
+  	if (nextf[bucket] == NULL)    
+  		morecore(bucket);
+  	if ((p = (union overhead *)nextf[bucket]) == NULL) {
+#ifdef safemalloc
+		if (!nomemok) {
+		    fputs("Out of memory!\n", stderr);
+		    my_exit(1);
+		}
+#else
+  		return (NULL);
+#endif
+	}
+
+#ifdef safemalloc
+    DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",
+	(unsigned long)(p+1),an++,(long)size));
+#endif /* safemalloc */
+
+	/* remove from linked list */
+#ifdef RCHECK
+	if (*((int*)p) & (sizeof(union overhead) - 1))
+	    fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",
+		(unsigned long)*((int*)p),(unsigned long)p);
+#endif
+  	nextf[bucket] = p->ov_next;
+	p->ov_magic = MAGIC;
+	p->ov_index= bucket;
+#ifdef DEBUGGING_MSTATS
+  	nmalloc[bucket]++;
+#endif
+#ifdef RCHECK
+	/*
+	 * Record allocated size of block and
+	 * bound space with magic numbers.
+	 */
+  	if (nbytes <= 0x10000)
+		p->ov_size = nbytes - 1;
+	p->ov_rmagic = RMAGIC;
+  	*((u_int *)((caddr_t)p + nbytes - RSLOP)) = RMAGIC;
+#endif
+  	return ((Malloc_t)(p + 1));
+}
+
+/*
+ * Allocate more memory to the indicated bucket.
+ */
+static void
+morecore(bucket)
+	register int bucket;
+{
+  	register union overhead *op;
+  	register int rnu;       /* 2^rnu bytes will be requested */
+  	register int nblks;     /* become nblks blocks of the desired size */
+	register MEM_SIZE siz;
+
+  	if (nextf[bucket])
+  		return;
+	/*
+	 * Insure memory is allocated
+	 * on a page boundary.  Should
+	 * make getpageize call?
+	 */
+#ifndef atarist /* on the atari we dont have to worry about this */
+  	op = (union overhead *)sbrk(0);
+#ifndef I286
+  	if ((int)op & 0x3ff)
+  		(void)sbrk(1024 - ((int)op & 0x3ff));
+#else
+	/* The sbrk(0) call on the I286 always returns the next segment */
+#endif
+#endif /* atarist */
+
+#if !(defined(I286) || defined(atarist))
+	/* take 2k unless the block is bigger than that */
+  	rnu = (bucket <= 8) ? 11 : bucket + 3;
+#else
+	/* take 16k unless the block is bigger than that 
+	   (80286s like large segments!), probably good on the atari too */
+  	rnu = (bucket <= 11) ? 14 : bucket + 3;
+#endif
+  	nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
+  	if (rnu < bucket)
+		rnu = bucket;
+	op = (union overhead *)sbrk(1L << rnu);
+	/* no more room! */
+  	if ((int)op == -1)
+  		return;
+	/*
+	 * Round up to minimum allocation size boundary
+	 * and deduct from block count to reflect.
+	 */
+#ifndef I286
+  	if ((int)op & 7) {
+  		op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
+  		nblks--;
+  	}
+#else
+	/* Again, this should always be ok on an 80286 */
+#endif
+	/*
+	 * Add new memory allocated to that on
+	 * free list for this hash bucket.
+	 */
+  	nextf[bucket] = op;
+  	siz = 1 << (bucket + 3);
+  	while (--nblks > 0) {
+		op->ov_next = (union overhead *)((caddr_t)op + siz);
+		op = (union overhead *)((caddr_t)op + siz);
+  	}
+}
+
+Free_t
+free(mp)
+	Malloc_t mp;
+{   
+  	register MEM_SIZE size;
+	register union overhead *op;
+	char *cp = (char*)mp;
+
+#ifdef safemalloc
+    DEBUG_m(fprintf(stderr,"0x%lx: (%05d) free\n",(unsigned long)cp,an++));
+#endif /* safemalloc */
+
+  	if (cp == NULL)
+  		return;
+	op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+#ifdef debug
+  	ASSERT(op->ov_magic == MAGIC);		/* make sure it was in use */
+#else
+	if (op->ov_magic != MAGIC) {
+#ifdef RCHECK
+		warn("%s free() ignored",
+		    op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
+#else
+		warn("Bad free() ignored");
+#endif
+		return;				/* sanity */
+	}
+#endif
+#ifdef RCHECK
+  	ASSERT(op->ov_rmagic == RMAGIC);
+	if (op->ov_index <= 13)
+		ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC);
+	op->ov_rmagic = RMAGIC - 1;
+#endif
+  	ASSERT(op->ov_index < NBUCKETS);
+  	size = op->ov_index;
+	op->ov_next = nextf[size];
+  	nextf[size] = op;
+#ifdef DEBUGGING_MSTATS
+  	nmalloc[size]--;
+#endif
+}
+
+/*
+ * When a program attempts "storage compaction" as mentioned in the
+ * old malloc man page, it realloc's an already freed block.  Usually
+ * this is the last block it freed; occasionally it might be farther
+ * back.  We have to search all the free lists for the block in order
+ * to determine its bucket: 1st we make one pass thru the lists
+ * checking only the first block in each; if that fails we search
+ * ``reall_srchlen'' blocks in each list for a match (the variable
+ * is extern so the caller can modify it).  If that fails we just copy
+ * however many bytes was given to realloc() and hope it's not huge.
+ */
+int reall_srchlen = 4;	/* 4 should be plenty, -1 =>'s whole list */
+
+Malloc_t
+realloc(mp, nbytes)
+	Malloc_t mp; 
+	MEM_SIZE nbytes;
+{   
+  	register MEM_SIZE onb;
+	union overhead *op;
+  	char *res;
+	register int i;
+	int was_alloced = 0;
+	char *cp = (char*)mp;
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+	MEM_SIZE size = nbytes;
+#endif
+
+#ifdef MSDOS
+	if (nbytes > 0xffff) {
+		fprintf(stderr, "Reallocation too large: %lx\n", size);
+		my_exit(1);
+	}
+#endif /* MSDOS */
+	if (!cp)
+		return malloc(nbytes);
+#ifdef DEBUGGING
+	if ((long)nbytes < 0)
+		croak("panic: realloc");
+#endif
+#endif /* safemalloc */
+
+	op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
+	if (op->ov_magic == MAGIC) {
+		was_alloced++;
+		i = op->ov_index;
+	} else {
+		/*
+		 * Already free, doing "compaction".
+		 *
+		 * Search for the old block of memory on the
+		 * free list.  First, check the most common
+		 * case (last element free'd), then (this failing)
+		 * the last ``reall_srchlen'' items free'd.
+		 * If all lookups fail, then assume the size of
+		 * the memory block being realloc'd is the
+		 * smallest possible.
+		 */
+		if ((i = findbucket(op, 1)) < 0 &&
+		    (i = findbucket(op, reall_srchlen)) < 0)
+			i = 0;
+	}
+	onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
+	/* avoid the copy if same size block */
+	if (was_alloced &&
+	    nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
+#ifdef RCHECK
+		/*
+		 * Record new allocated size of block and
+		 * bound space with magic numbers.
+		 */
+		if (op->ov_index <= 13) {
+			/*
+			 * Convert amount of memory requested into
+			 * closest block size stored in hash buckets
+			 * which satisfies request.  Account for
+			 * space used per block for accounting.
+			 */
+			nbytes += sizeof (union overhead) + RSLOP;
+			nbytes = (nbytes + 3) &~ 3; 
+			op->ov_size = nbytes - 1;
+			*((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC;
+		}
+#endif
+		res = cp;
+	}
+	else {
+		if ((res = (char*)malloc(nbytes)) == NULL)
+			return (NULL);
+		if (cp != res)			/* common optimization */
+			Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
+		if (was_alloced)
+			free(cp);
+	}
+
+#ifdef safemalloc
+#ifdef DEBUGGING
+    if (debug & 128) {
+	fprintf(stderr,"0x%lx: (%05d) rfree\n",(unsigned long)res,an++);
+	fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",
+	    (unsigned long)res,an++,(long)size);
+    }
+#endif
+#endif /* safemalloc */
+  	return ((Malloc_t)res);
+}
+
+/*
+ * Search ``srchlen'' elements of each free list for a block whose
+ * header starts at ``freep''.  If srchlen is -1 search the whole list.
+ * Return bucket number, or -1 if not found.
+ */
+static int
+findbucket(freep, srchlen)
+	union overhead *freep;
+	int srchlen;
+{
+	register union overhead *p;
+	register int i, j;
+
+	for (i = 0; i < NBUCKETS; i++) {
+		j = 0;
+		for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
+			if (p == freep)
+				return (i);
+			j++;
+		}
+	}
+	return (-1);
+}
+
+#ifdef DEBUGGING_MSTATS
+/*
+ * mstats - print out statistics about malloc
+ * 
+ * Prints two lines of numbers, one showing the length of the free list
+ * for each size category, the second showing the number of mallocs -
+ * frees for each size category.
+ */
+void
+dump_mstats(s)
+	char *s;
+{
+  	register int i, j;
+  	register union overhead *p;
+  	int topbucket=0, totfree=0, totused=0;
+	u_int nfree[NBUCKETS];
+
+  	for (i=0; i < NBUCKETS; i++) {
+  		for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
+  			;
+		nfree[i] = j;
+  		totfree += nfree[i]   * (1 << (i + 3));
+  		totused += nmalloc[i] * (1 << (i + 3));
+		if (nfree[i] || nmalloc[i])
+			topbucket = i;
+  	}
+  	if (s)
+		fprintf(stderr, "Memory allocation statistics %s (buckets 8..%d)\n",
+			s, (1 << (topbucket + 3)) );
+  	fprintf(stderr, " %7d free: ", totfree);
+  	for (i=0; i <= topbucket; i++) {
+  		fprintf(stderr, (i<5)?" %5d":" %3d", nfree[i]);
+  	}
+  	fprintf(stderr, "\n %7d used: ", totused);
+  	for (i=0; i <= topbucket; i++) {
+  		fprintf(stderr, (i<5)?" %5d":" %3d", nmalloc[i]);
+  	}
+  	fprintf(stderr, "\n");
+}
+#else
+void
+dump_mstats(s)
+    char *s;
+{
+}
+#endif
+#endif /* lint */
diff --git a/gnu/usr.bin/perl/mg.c b/gnu/usr.bin/perl/mg.c
new file mode 100644
index 00000000000..5e649bb9b98
--- /dev/null
+++ b/gnu/usr.bin/perl/mg.c
@@ -0,0 +1,1409 @@
+/*    mg.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "Sam sat on the ground and put his head in his hands.  'I wish I had never
+ * come here, and I don't want to see no more magic,' he said, and fell silent."
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* Omit -- it causes too much grief on mixed systems.
+#ifdef I_UNISTD
+# include <unistd.h>
+#endif
+*/
+
+/*
+ * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
+ */
+
+struct magic_state {
+    SV* mgs_sv;
+    U32 mgs_flags;
+};
+typedef struct magic_state MGS;
+
+static void restore_magic _((void *p));
+
+static MGS *
+save_magic(sv)
+SV* sv;
+{
+    MGS* mgs;
+
+    assert(SvMAGICAL(sv));
+
+    mgs = (MGS*)safemalloc(sizeof(MGS));
+    mgs->mgs_sv = sv;
+    mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
+    SAVEDESTRUCTOR(restore_magic, mgs);
+
+    SvMAGICAL_off(sv);
+    SvREADONLY_off(sv);
+    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+
+    return mgs;
+}
+
+static void
+restore_magic(p)
+void* p;
+{
+    MGS *mgs = (MGS*)p;
+    SV* sv = mgs->mgs_sv;
+
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
+    {
+	if (mgs->mgs_flags)
+	    SvFLAGS(sv) |= mgs->mgs_flags;
+	else
+	    mg_magical(sv);
+	if (SvGMAGICAL(sv))
+	    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+    }
+
+    Safefree(mgs);
+}
+
+
+void
+mg_magical(sv)
+SV* sv;
+{
+    MAGIC* mg;
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	if (vtbl) {
+	    if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+		SvGMAGICAL_on(sv);
+	    if (vtbl->svt_set)
+		SvSMAGICAL_on(sv);
+	    if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
+		SvRMAGICAL_on(sv);
+	}
+    }
+}
+
+int
+mg_get(sv)
+SV* sv;
+{
+    MGS* mgs;
+    MAGIC* mg;
+    MAGIC** mgp;
+
+    ENTER;
+    mgs = save_magic(sv);
+
+    mgp = &SvMAGIC(sv);
+    while ((mg = *mgp) != 0) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
+	    (*vtbl->svt_get)(sv, mg);
+	    /* Ignore this magic if it's been deleted */
+	    if (*mgp == mg && (mg->mg_flags & MGf_GSKIP))
+		mgs->mgs_flags = 0;
+	}
+	/* Advance to next magic (complicated by possible deletion) */
+	if (*mgp == mg)
+	    mgp = &mg->mg_moremagic;
+    }
+
+    LEAVE;
+    return 0;
+}
+
+int
+mg_set(sv)
+SV* sv;
+{
+    MGS* mgs;
+    MAGIC* mg;
+    MAGIC* nextmg;
+
+    ENTER;
+    mgs = save_magic(sv);
+
+    for (mg = SvMAGIC(sv); mg; mg = nextmg) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	nextmg = mg->mg_moremagic;	/* it may delete itself */
+	if (mg->mg_flags & MGf_GSKIP) {
+	    mg->mg_flags &= ~MGf_GSKIP;	/* setting requires another read */
+	    mgs->mgs_flags = 0;
+	}
+	if (vtbl && vtbl->svt_set)
+	    (*vtbl->svt_set)(sv, mg);
+    }
+
+    LEAVE;
+    return 0;
+}
+
+U32
+mg_len(sv)
+SV* sv;
+{
+    MAGIC* mg;
+    char *junk;
+    STRLEN len;
+
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	if (vtbl && vtbl->svt_len) {
+	    ENTER;
+	    save_magic(sv);
+	    /* omit MGf_GSKIP -- not changed here */
+	    len = (*vtbl->svt_len)(sv, mg);
+	    LEAVE;
+	    return len;
+	}
+    }
+
+    junk = SvPV(sv, len);
+    return len;
+}
+
+int
+mg_clear(sv)
+SV* sv;
+{
+    MAGIC* mg;
+
+    ENTER;
+    save_magic(sv);
+
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	/* omit GSKIP -- never set here */
+	
+	if (vtbl && vtbl->svt_clear)
+	    (*vtbl->svt_clear)(sv, mg);
+    }
+
+    LEAVE;
+    return 0;
+}
+
+MAGIC*
+mg_find(sv, type)
+SV* sv;
+int type;
+{
+    MAGIC* mg;
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	if (mg->mg_type == type)
+	    return mg;
+    }
+    return 0;
+}
+
+int
+mg_copy(sv, nsv, key, klen)
+SV* sv;
+SV* nsv;
+char *key;
+STRLEN klen;
+{
+    int count = 0;
+    MAGIC* mg;
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+	if (isUPPER(mg->mg_type)) {
+	    sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
+	    count++;
+	}
+    }
+    return count;
+}
+
+int
+mg_free(sv)
+SV* sv;
+{
+    MAGIC* mg;
+    MAGIC* moremagic;
+    for (mg = SvMAGIC(sv); mg; mg = moremagic) {
+	MGVTBL* vtbl = mg->mg_virtual;
+	moremagic = mg->mg_moremagic;
+	if (vtbl && vtbl->svt_free)
+	    (*vtbl->svt_free)(sv, mg);
+	if (mg->mg_ptr && mg->mg_type != 'g')
+	    Safefree(mg->mg_ptr);
+	if (mg->mg_flags & MGf_REFCOUNTED)
+	    SvREFCNT_dec(mg->mg_obj);
+	Safefree(mg);
+    }
+    SvMAGIC(sv) = 0;
+    return 0;
+}
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+U32
+magic_len(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+    register I32 paren;
+    register char *s;
+    register I32 i;
+    char *t;
+
+    switch (*mg->mg_ptr) {
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curpm) {
+	    paren = atoi(mg->mg_ptr);
+	  getparen:
+	    if (curpm->op_pmregexp &&
+	      paren <= curpm->op_pmregexp->nparens &&
+	      (s = curpm->op_pmregexp->startp[paren]) &&
+	      (t = curpm->op_pmregexp->endp[paren]) ) {
+		i = t - s;
+		if (i >= 0)
+		    return i;
+	    }
+	}
+	return 0;
+	break;
+    case '+':
+	if (curpm) {
+	    paren = curpm->op_pmregexp->lastparen;
+	    if (!paren)
+		return 0;
+	    goto getparen;
+	}
+	return 0;
+	break;
+    case '`':
+	if (curpm) {
+	    if (curpm->op_pmregexp &&
+	      (s = curpm->op_pmregexp->subbeg) ) {
+		i = curpm->op_pmregexp->startp[0] - s;
+		if (i >= 0)
+		    return i;
+	    }
+	}
+	return 0;
+    case '\'':
+	if (curpm) {
+	    if (curpm->op_pmregexp &&
+	      (s = curpm->op_pmregexp->endp[0]) ) {
+		return (STRLEN) (curpm->op_pmregexp->subend - s);
+	    }
+	}
+	return 0;
+    case ',':
+	return (STRLEN)ofslen;
+    case '\\':
+	return (STRLEN)orslen;
+    }
+    magic_get(sv,mg);
+    if (!SvPOK(sv) && SvNIOK(sv))
+	sv_2pv(sv, &na);
+    if (SvPOK(sv))
+	return SvCUR(sv);
+    return 0;
+}
+
+int
+magic_get(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+    register I32 paren;
+    register char *s;
+    register I32 i;
+    char *t;
+
+    switch (*mg->mg_ptr) {
+    case '\001':		/* ^A */
+	sv_setsv(sv, bodytarget);
+	break;
+    case '\004':		/* ^D */
+	sv_setiv(sv,(I32)(debug & 32767));
+	break;
+    case '\005':  /* ^E */
+#ifdef VMS
+	{
+#	    include <descrip.h>
+#	    include <starlet.h>
+	    char msg[255];
+	    $DESCRIPTOR(msgdsc,msg);
+	    sv_setnv(sv,(double)vaxc$errno);
+	    if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
+		sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
+	    else
+		sv_setpv(sv,"");
+	}
+#else
+	sv_setnv(sv,(double)errno);
+	sv_setpv(sv, errno ? Strerror(errno) : "");
+#endif
+	SvNOK_on(sv);	/* what a wonderful hack! */
+	break;
+    case '\006':		/* ^F */
+	sv_setiv(sv,(I32)maxsysfd);
+	break;
+    case '\010':		/* ^H */
+	sv_setiv(sv,(I32)hints);
+	break;
+    case '\t':			/* ^I */
+	if (inplace)
+	    sv_setpv(sv, inplace);
+	else
+	    sv_setsv(sv,&sv_undef);
+	break;
+    case '\017':		/* ^O */
+	sv_setpv(sv,osname);
+	break;
+    case '\020':		/* ^P */
+	sv_setiv(sv,(I32)perldb);
+	break;
+    case '\024':		/* ^T */
+	sv_setiv(sv,(I32)basetime);
+	break;
+    case '\027':		/* ^W */
+	sv_setiv(sv,(I32)dowarn);
+	break;
+    case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '&':
+	if (curpm) {
+	    paren = atoi(GvENAME(mg->mg_obj));
+	  getparen:
+	    if (curpm->op_pmregexp &&
+	      paren <= curpm->op_pmregexp->nparens &&
+	      (s = curpm->op_pmregexp->startp[paren]) &&
+	      (t = curpm->op_pmregexp->endp[paren]) ) {
+		i = t - s;
+		if (i >= 0) {
+		    MAGIC *tmg;
+		    sv_setpvn(sv,s,i);
+		    if (tainting && (tmg = mg_find(sv,'t')))
+			tmg->mg_len = 0;	/* guarantee $1 untainted */
+		    break;
+		}
+	    }
+	}
+	sv_setsv(sv,&sv_undef);
+	break;
+    case '+':
+	if (curpm) {
+	    paren = curpm->op_pmregexp->lastparen;
+	    if (paren)
+		goto getparen;
+	}
+	sv_setsv(sv,&sv_undef);
+	break;
+    case '`':
+	if (curpm) {
+	    if (curpm->op_pmregexp &&
+	      (s = curpm->op_pmregexp->subbeg) ) {
+		i = curpm->op_pmregexp->startp[0] - s;
+		if (i >= 0) {
+		    sv_setpvn(sv,s,i);
+		    break;
+		}
+	    }
+	}
+	sv_setsv(sv,&sv_undef);
+	break;
+    case '\'':
+	if (curpm) {
+	    if (curpm->op_pmregexp &&
+	      (s = curpm->op_pmregexp->endp[0]) ) {
+		sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
+		break;
+	    }
+	}
+	sv_setsv(sv,&sv_undef);
+	break;
+    case '.':
+#ifndef lint
+	if (GvIO(last_in_gv)) {
+	    sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
+	}
+#endif
+	break;
+    case '?':
+	sv_setiv(sv,(I32)statusvalue);
+	break;
+    case '^':
+	s = IoTOP_NAME(GvIOp(defoutgv));
+	if (s)
+	    sv_setpv(sv,s);
+	else {
+	    sv_setpv(sv,GvENAME(defoutgv));
+	    sv_catpv(sv,"_TOP");
+	}
+	break;
+    case '~':
+	s = IoFMT_NAME(GvIOp(defoutgv));
+	if (!s)
+	    s = GvENAME(defoutgv);
+	sv_setpv(sv,s);
+	break;
+#ifndef lint
+    case '=':
+	sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
+	break;
+    case '-':
+	sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
+	break;
+    case '%':
+	sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
+	break;
+#endif
+    case ':':
+	break;
+    case '/':
+	break;
+    case '[':
+	sv_setiv(sv,(I32)curcop->cop_arybase);
+	break;
+    case '|':
+	sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
+	break;
+    case ',':
+	sv_setpvn(sv,ofs,ofslen);
+	break;
+    case '\\':
+	sv_setpvn(sv,ors,orslen);
+	break;
+    case '#':
+	sv_setpv(sv,ofmt);
+	break;
+    case '!':
+#ifdef VMS
+	sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
+#else
+	sv_setnv(sv,(double)errno);
+#endif
+	sv_setpv(sv, errno ? Strerror(errno) : "");
+	SvNOK_on(sv);	/* what a wonderful hack! */
+	break;
+    case '<':
+	sv_setiv(sv,(I32)uid);
+	break;
+    case '>':
+	sv_setiv(sv,(I32)euid);
+	break;
+    case '(':
+	s = buf;
+	(void)sprintf(s,"%d",(int)gid);
+	goto add_groups;
+    case ')':
+	s = buf;
+	(void)sprintf(s,"%d",(int)egid);
+      add_groups:
+	while (*s) s++;
+#ifdef HAS_GETGROUPS
+#ifndef NGROUPS
+#define NGROUPS 32
+#endif
+	{
+	    Groups_t gary[NGROUPS];
+
+	    i = getgroups(NGROUPS,gary);
+	    while (--i >= 0) {
+		(void)sprintf(s," %ld", (long)gary[i]);
+		while (*s) s++;
+	    }
+	}
+#endif
+	sv_setpv(sv,buf);
+	break;
+    case '*':
+	break;
+    case '0':
+	break;
+    }
+    return 0;
+}
+
+int
+magic_getuvar(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+    struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
+
+    if (uf && uf->uf_val)
+	(*uf->uf_val)(uf->uf_index, sv);
+    return 0;
+}
+
+int
+magic_setenv(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    register char *s;
+    STRLEN len;
+    I32 i;
+    s = SvPV(sv,len);
+    my_setenv(mg->mg_ptr,s);
+#ifdef DYNAMIC_ENV_FETCH
+     /* We just undefd an environment var.  Is a replacement */
+     /* waiting in the wings? */
+    if (!len) {
+	SV **envsvp;
+	if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
+	    s = SvPV(*envsvp,len);
+    }
+#endif
+			    /* And you'll never guess what the dog had */
+			    /*   in its mouth... */
+    if (tainting) {
+	if (s && strEQ(mg->mg_ptr,"PATH")) {
+	    char *strend = s + len;
+
+	    while (s < strend) {
+		s = cpytill(tokenbuf,s,strend,':',&i);
+		s++;
+		if (*tokenbuf != '/'
+		  || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+		    MgTAINTEDDIR_on(mg);
+	    }
+	}
+    }
+    return 0;
+}
+
+int
+magic_clearenv(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    my_setenv(mg->mg_ptr,Nullch);
+    return 0;
+}
+
+#ifdef HAS_SIGACTION
+/* set up reliable signal() clone */
+
+typedef void (*Sigfunc) _((int));
+
+static
+Sigfunc rsignal(signo,handler)
+int signo;
+Sigfunc handler;
+{
+    struct sigaction act,oact;
+    
+    act.sa_handler = handler;
+    sigemptyset(&act.sa_mask);
+    act.sa_flags = 0;
+#ifdef SIGALRM    
+    if (signo == SIGALRM) {
+#else
+    if (0) {
+#endif        
+#ifdef SA_INTERRUPT
+	act.sa_flags |= SA_INTERRUPT;	/* SunOS */
+#endif	
+    } else {
+#ifdef SA_RESTART
+	act.sa_flags |= SA_RESTART;	/* SVR4, 4.3+BSD */
+#endif
+    }
+    if (sigaction(signo, &act, &oact) < 0)
+    	return(SIG_ERR);
+    else
+    	return(oact.sa_handler);
+}
+
+#else
+
+/* ah well, so much for reliability */
+
+#define rsignal(x,y) signal(x,y)
+
+#endif
+
+
+int
+magic_setsig(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    register char *s;
+    I32 i;
+    SV** svp;
+
+    s = mg->mg_ptr;
+    if (*s == '_') {
+	if (strEQ(s,"__DIE__"))
+	    svp = &diehook;
+	else if (strEQ(s,"__WARN__"))
+	    svp = &warnhook;
+	else if (strEQ(s,"__PARSE__"))
+	    svp = &parsehook;
+	else
+	    croak("No such hook: %s", s);
+	i = 0;
+	if (*svp) {
+	    SvREFCNT_dec(*svp);
+	    *svp = 0;
+	}
+    }
+    else {
+	i = whichsig(s);	/* ...no, a brick */
+	if (!i) {
+	    if (dowarn || strEQ(s,"ALARM"))
+		warn("No such signal: SIG%s", s);
+	    return 0;
+	}
+    }
+    if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
+	if (i)
+	    (void)rsignal(i,sighandler);
+	else
+	    *svp = SvREFCNT_inc(sv);
+	return 0;
+    }
+    s = SvPV_force(sv,na);
+    if (strEQ(s,"IGNORE")) {
+	if (i)
+	    (void)rsignal(i,SIG_IGN);
+	else
+	    *svp = 0;
+    }
+    else if (strEQ(s,"DEFAULT") || !*s) {
+	if (i)
+	    (void)rsignal(i,SIG_DFL);
+	else
+	    *svp = 0;
+    }
+    else {
+	if (!strchr(s,':') && !strchr(s,'\'')) {
+	    sprintf(tokenbuf, "main::%s",s);
+	    sv_setpv(sv,tokenbuf);
+	}
+	if (i)
+	    (void)rsignal(i,sighandler);
+	else
+	    *svp = SvREFCNT_inc(sv);
+    }
+    return 0;
+}
+
+int
+magic_setisa(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    sub_generation++;
+    return 0;
+}
+
+#ifdef OVERLOAD
+
+int
+magic_setamagic(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    /* HV_badAMAGIC_on(Sv_STASH(sv)); */
+    amagic_generation++;
+
+    return 0;
+}
+#endif /* OVERLOAD */
+
+static int
+magic_methpack(sv,mg,meth)
+SV* sv;
+MAGIC* mg;
+char *meth;
+{
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(sp);
+    EXTEND(sp, 2);
+    PUSHs(mg->mg_obj);
+    if (mg->mg_ptr)
+	PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+    else if (mg->mg_type == 'p')
+	PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+    PUTBACK;
+
+    if (perl_call_method(meth, G_SCALAR))
+	sv_setsv(sv, *stack_sp--);
+
+    FREETMPS;
+    LEAVE;
+    return 0;
+}
+
+int
+magic_getpack(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    magic_methpack(sv,mg,"FETCH");
+    if (mg->mg_ptr)
+	mg->mg_flags |= MGf_GSKIP;
+    return 0;
+}
+
+int
+magic_setpack(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    dSP;
+
+    PUSHMARK(sp);
+    EXTEND(sp, 3);
+    PUSHs(mg->mg_obj);
+    if (mg->mg_ptr)
+	PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+    else if (mg->mg_type == 'p')
+	PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+    PUSHs(sv);
+    PUTBACK;
+
+    perl_call_method("STORE", G_SCALAR|G_DISCARD);
+
+    return 0;
+}
+
+int
+magic_clearpack(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    return magic_methpack(sv,mg,"DELETE");
+}
+
+int magic_wipepack(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    dSP;
+
+    PUSHMARK(sp);
+    XPUSHs(mg->mg_obj);
+    PUTBACK;
+
+    perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
+
+    return 0;
+}
+
+int
+magic_nextpack(sv,mg,key)
+SV* sv;
+MAGIC* mg;
+SV* key;
+{
+    dSP;
+    char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(sp);
+    EXTEND(sp, 2);
+    PUSHs(mg->mg_obj);
+    if (SvOK(key))
+	PUSHs(key);
+    PUTBACK;
+
+    if (perl_call_method(meth, G_SCALAR))
+	sv_setsv(key, *stack_sp--);
+
+    FREETMPS;
+    LEAVE;
+    return 0;
+}
+
+int
+magic_existspack(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    return magic_methpack(sv,mg,"EXISTS");
+} 
+
+int
+magic_setdbline(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    OP *o;
+    I32 i;
+    GV* gv;
+    SV** svp;
+
+    gv = DBline;
+    i = SvTRUE(sv);
+    svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
+    if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
+	o->op_private = i;
+    else
+	warn("Can't break at that line\n");
+    return 0;
+}
+
+int
+magic_getarylen(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
+    return 0;
+}
+
+int
+magic_setarylen(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
+    return 0;
+}
+
+int
+magic_getpos(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SV* lsv = LvTARG(sv);
+    
+    if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
+	mg = mg_find(lsv, 'g');
+	if (mg && mg->mg_len >= 0) {
+	    sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
+	    return 0;
+	}
+    }
+    (void)SvOK_off(sv);
+    return 0;
+}
+
+int
+magic_setpos(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SV* lsv = LvTARG(sv);
+    SSize_t pos;
+    STRLEN len;
+
+    mg = 0;
+    
+    if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
+	mg = mg_find(lsv, 'g');
+    if (!mg) {
+	if (!SvOK(sv))
+	    return 0;
+	sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
+	mg = mg_find(lsv, 'g');
+    }
+    else if (!SvOK(sv)) {
+	mg->mg_len = -1;
+	return 0;
+    }
+    len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
+
+    pos = SvIV(sv) - curcop->cop_arybase;
+    if (pos < 0) {
+	pos += len;
+	if (pos < 0)
+	    pos = 0;
+    }
+    else if (pos > len)
+	pos = len;
+    mg->mg_len = pos;
+
+    return 0;
+}
+
+int
+magic_getglob(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
+    return 0;
+}
+
+int
+magic_setglob(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    register char *s;
+    GV* gv;
+
+    if (!SvOK(sv))
+	return 0;
+    s = SvPV(sv, na);
+    if (*s == '*' && s[1])
+	s++;
+    gv = gv_fetchpv(s,TRUE, SVt_PVGV);
+    if (sv == (SV*)gv)
+	return 0;
+    if (GvGP(sv))
+	gp_free(sv);
+    GvGP(sv) = gp_ref(GvGP(gv));
+    if (!GvAV(gv))
+	gv_AVadd(gv);
+    if (!GvHV(gv))
+	gv_HVadd(gv);
+    if (!GvIOp(gv))
+	GvIOp(gv) = newIO();
+    return 0;
+}
+
+int
+magic_setsubstr(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    STRLEN len;
+    char *tmps = SvPV(sv,len);
+    sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
+    return 0;
+}
+
+int
+magic_gettaint(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    if (mg->mg_len & 1)
+	tainted = TRUE;
+    else if (mg->mg_len & 2 && mg->mg_obj == sv)	/* kludge */
+	tainted = TRUE;
+    return 0;
+}
+
+int
+magic_settaint(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    if (localizing) {
+	if (localizing == 1)
+	    mg->mg_len <<= 1;
+	else
+	    mg->mg_len >>= 1;
+    }
+    else if (tainted)
+	mg->mg_len |= 1;
+    else
+	mg->mg_len &= ~1;
+    return 0;
+}
+
+int
+magic_setvec(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    do_vecset(sv);	/* XXX slurp this routine */
+    return 0;
+}
+
+int
+magic_setmglob(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    mg->mg_len = -1;
+    SvSCREAM_off(sv);
+    return 0;
+}
+
+int
+magic_setbm(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    sv_unmagic(sv, 'B');
+    SvVALID_off(sv);
+    return 0;
+}
+
+int
+magic_setuvar(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
+
+    if (uf && uf->uf_set)
+	(*uf->uf_set)(uf->uf_index, sv);
+    return 0;
+}
+
+int
+magic_set(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    register char *s;
+    I32 i;
+    STRLEN len;
+    switch (*mg->mg_ptr) {
+    case '\001':	/* ^A */
+	sv_setsv(bodytarget, sv);
+	break;
+    case '\004':	/* ^D */
+	debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
+	DEBUG_x(dump_all());
+	break;
+    case '\005':  /* ^E */
+#ifdef VMS
+	set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#else
+	SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);		/* will anyone ever use this? */
+#endif
+	break;
+    case '\006':	/* ^F */
+	maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	break;
+    case '\010':	/* ^H */
+	hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	break;
+    case '\t':	/* ^I */
+	if (inplace)
+	    Safefree(inplace);
+	if (SvOK(sv))
+	    inplace = savepv(SvPV(sv,na));
+	else
+	    inplace = Nullch;
+	break;
+    case '\017':	/* ^O */
+	if (osname)
+	    Safefree(osname);
+	if (SvOK(sv))
+	    osname = savepv(SvPV(sv,na));
+	else
+	    osname = Nullch;
+	break;
+    case '\020':	/* ^P */
+	i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	if (i != perldb) {
+	    if (perldb)
+		oldlastpm = curpm;
+	    else
+		curpm = oldlastpm;
+	}
+	perldb = i;
+	break;
+    case '\024':	/* ^T */
+	basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	break;
+    case '\027':	/* ^W */
+	dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	break;
+    case '.':
+	if (localizing) {
+	    if (localizing == 1)
+		save_sptr((SV**)&last_in_gv);
+	}
+	else if (SvOK(sv))
+	    IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
+	break;
+    case '^':
+	Safefree(IoTOP_NAME(GvIOp(defoutgv)));
+	IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
+	IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+	break;
+    case '~':
+	Safefree(IoFMT_NAME(GvIOp(defoutgv)));
+	IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
+	IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
+	break;
+    case '=':
+	IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	break;
+    case '-':
+	IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
+	    IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
+	break;
+    case '%':
+	IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	break;
+    case '|':
+	IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
+	if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
+	    IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
+	}
+	break;
+    case '*':
+	i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	multiline = (i != 0);
+	break;
+    case '/':
+	SvREFCNT_dec(nrs);
+	nrs = newSVsv(sv);
+	SvREFCNT_dec(rs);
+	rs = SvREFCNT_inc(nrs);
+	break;
+    case '\\':
+	if (ors)
+	    Safefree(ors);
+	ors = savepv(SvPV(sv,orslen));
+	break;
+    case ',':
+	if (ofs)
+	    Safefree(ofs);
+	ofs = savepv(SvPV(sv, ofslen));
+	break;
+    case '#':
+	if (ofmt)
+	    Safefree(ofmt);
+	ofmt = savepv(SvPV(sv,na));
+	break;
+    case '[':
+	compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	break;
+    case '?':
+	statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	break;
+    case '!':
+	SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);		/* will anyone ever use this? */
+	break;
+    case '<':
+	uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	if (delaymagic) {
+	    delaymagic |= DM_RUID;
+	    break;				/* don't do magic till later */
+	}
+#ifdef HAS_SETRUID
+	(void)setruid((Uid_t)uid);
+#else
+#ifdef HAS_SETREUID
+	(void)setreuid((Uid_t)uid, (Uid_t)-1);
+#else
+#ifdef HAS_SETRESUID
+      (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
+#else
+	if (uid == euid)		/* special case $< = $> */
+	    (void)setuid(uid);
+	else {
+	    uid = (I32)getuid();
+	    croak("setruid() not implemented");
+	}
+#endif
+#endif
+#endif
+	uid = (I32)getuid();
+	tainting |= (uid && (euid != uid || egid != gid));
+	break;
+    case '>':
+	euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	if (delaymagic) {
+	    delaymagic |= DM_EUID;
+	    break;				/* don't do magic till later */
+	}
+#ifdef HAS_SETEUID
+	(void)seteuid((Uid_t)euid);
+#else
+#ifdef HAS_SETREUID
+	(void)setreuid((Uid_t)-1, (Uid_t)euid);
+#else
+#ifdef HAS_SETRESUID
+	(void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
+#else
+	if (euid == uid)		/* special case $> = $< */
+	    setuid(euid);
+	else {
+	    euid = (I32)geteuid();
+	    croak("seteuid() not implemented");
+	}
+#endif
+#endif
+#endif
+	euid = (I32)geteuid();
+	tainting |= (uid && (euid != uid || egid != gid));
+	break;
+    case '(':
+	gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	if (delaymagic) {
+	    delaymagic |= DM_RGID;
+	    break;				/* don't do magic till later */
+	}
+#ifdef HAS_SETRGID
+	(void)setrgid((Gid_t)gid);
+#else
+#ifdef HAS_SETREGID
+	(void)setregid((Gid_t)gid, (Gid_t)-1);
+#else
+#ifdef HAS_SETRESGID
+      (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
+#else
+	if (gid == egid)			/* special case $( = $) */
+	    (void)setgid(gid);
+	else {
+	    gid = (I32)getgid();
+	    croak("setrgid() not implemented");
+	}
+#endif
+#endif
+#endif
+	gid = (I32)getgid();
+	tainting |= (uid && (euid != uid || egid != gid));
+	break;
+    case ')':
+	egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	if (delaymagic) {
+	    delaymagic |= DM_EGID;
+	    break;				/* don't do magic till later */
+	}
+#ifdef HAS_SETEGID
+	(void)setegid((Gid_t)egid);
+#else
+#ifdef HAS_SETREGID
+	(void)setregid((Gid_t)-1, (Gid_t)egid);
+#else
+#ifdef HAS_SETRESGID
+	(void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
+#else
+	if (egid == gid)			/* special case $) = $( */
+	    (void)setgid(egid);
+	else {
+	    egid = (I32)getegid();
+	    croak("setegid() not implemented");
+	}
+#endif
+#endif
+#endif
+	egid = (I32)getegid();
+	tainting |= (uid && (euid != uid || egid != gid));
+	break;
+    case ':':
+	chopset = SvPV_force(sv,na);
+	break;
+    case '0':
+	if (!origalen) {
+	    s = origargv[0];
+	    s += strlen(s);
+	    /* See if all the arguments are contiguous in memory */
+	    for (i = 1; i < origargc; i++) {
+		if (origargv[i] == s + 1)
+		    s += strlen(++s);	/* this one is ok too */
+	    }
+	    if (origenviron[0] == s + 1) {	/* can grab env area too? */
+		my_setenv("NoNeSuCh", Nullch);
+					    /* force copy of environment */
+		for (i = 0; origenviron[i]; i++)
+		    if (origenviron[i] == s + 1)
+			s += strlen(++s);
+	    }
+	    origalen = s - origargv[0];
+	}
+	s = SvPV_force(sv,len);
+	i = len;
+	if (i >= origalen) {
+	    i = origalen;
+	    SvCUR_set(sv, i);
+	    *SvEND(sv) = '\0';
+	    Copy(s, origargv[0], i, char);
+	}
+	else {
+	    Copy(s, origargv[0], i, char);
+	    s = origargv[0]+i;
+	    *s++ = '\0';
+	    while (++i < origalen)
+		*s++ = ' ';
+	    s = origargv[0]+i;
+	    for (i = 1; i < origargc; i++)
+		origargv[i] = Nullch;
+	}
+	break;
+    }
+    return 0;
+}
+
+I32
+whichsig(sig)
+char *sig;
+{
+    register char **sigv;
+
+    for (sigv = sig_name+1; *sigv; sigv++)
+	if (strEQ(sig,*sigv))
+	    return sig_num[sigv - sig_name];
+#ifdef SIGCLD
+    if (strEQ(sig,"CHLD"))
+	return SIGCLD;
+#endif
+#ifdef SIGCHLD
+    if (strEQ(sig,"CLD"))
+	return SIGCHLD;
+#endif
+    return 0;
+}
+
+Signal_t
+sighandler(sig)
+int sig;
+{
+    dSP;
+    GV *gv;
+    HV *st;
+    SV *sv;
+    CV *cv;
+    AV *oldstack;
+    char *signame; 
+
+#ifdef OS2		/* or anybody else who requires SIG_ACK */
+    signal(sig, SIG_ACK);
+#endif
+
+    signame = sig_name[sig];
+    cv = sv_2cv(*hv_fetch(GvHVn(siggv),signame,strlen(signame),
+			  TRUE),
+		&st, &gv, TRUE);
+    if (!cv || !CvROOT(cv) &&
+	*signame == 'C' && instr(signame,"LD")) {
+	
+	if (signame[1] == 'H')
+	    cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
+			&st, &gv, TRUE);
+	else
+	    cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
+			&st, &gv, TRUE);
+	/* gag */
+    }
+    if (!cv || !CvROOT(cv)) {
+	if (dowarn)
+	    warn("SIG%s handler \"%s\" not defined.\n",
+		signame, GvENAME(gv) );
+	return;
+    }
+
+    oldstack = stack;
+    if (stack != signalstack)
+	AvFILL(signalstack) = 0;
+    SWITCHSTACK(stack, signalstack);
+
+    sv = sv_newmortal();
+    sv_setpv(sv,signame);
+    PUSHMARK(sp);
+    PUSHs(sv);
+    PUTBACK;
+
+    perl_call_sv((SV*)cv, G_DISCARD);
+
+    SWITCHSTACK(signalstack, oldstack);
+
+    return;
+}
diff --git a/gnu/usr.bin/perl/mg.h b/gnu/usr.bin/perl/mg.h
new file mode 100644
index 00000000000..ab24eb03abb
--- /dev/null
+++ b/gnu/usr.bin/perl/mg.h
@@ -0,0 +1,36 @@
+/*    mg.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+struct mgvtbl {
+    int		(*svt_get)	_((SV *sv, MAGIC* mg));
+    int		(*svt_set)	_((SV *sv, MAGIC* mg));
+    U32		(*svt_len)	_((SV *sv, MAGIC* mg));
+    int		(*svt_clear)	_((SV *sv, MAGIC* mg));
+    int		(*svt_free)	_((SV *sv, MAGIC* mg));
+};
+
+struct magic {
+    MAGIC*	mg_moremagic;
+    MGVTBL*	mg_virtual;	/* pointer to magic functions */
+    U16		mg_private;
+    char	mg_type;
+    U8		mg_flags;
+    SV*		mg_obj;
+    char*	mg_ptr;
+    I32		mg_len;
+};
+
+#define MGf_TAINTEDDIR 1
+#define MGf_REFCOUNTED 2
+#define MGf_GSKIP      4
+
+#define MGf_MINMATCH   1
+
+#define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR)
+#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR)
diff --git a/gnu/usr.bin/perl/minimod.pl b/gnu/usr.bin/perl/minimod.pl
new file mode 100644
index 00000000000..b9b70715b20
--- /dev/null
+++ b/gnu/usr.bin/perl/minimod.pl
@@ -0,0 +1,137 @@
+# minimod.PL writes the contents of miniperlmain.c into the module
+# ExtUtils::Miniperl for later perusal (when the perl source is
+# deleted)
+#
+# It also writes the subroutine writemain(), which takes as its
+# arguments module names that shall be statically linked into perl.
+#
+# Authors: Andreas Koenig <k@franz.ww.TU-Berlin.DE>, Tim Bunce
+#          <Tim.Bunce@ig.co.uk>
+#
+# Version 1.0, Feb 2nd 1995 by Andreas Koenig
+
+print <<'END';
+# This File keeps the contents of miniperlmain.c.
+#
+# It was generated automatically by minimod.PL from the contents
+# of miniperlmain.c. Don't edit this file!
+#
+#       ANY CHANGES MADE HERE WILL BE LOST! 
+#
+
+
+package ExtUtils::Miniperl;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(&writemain);
+
+$head= <<'EOF!HEAD';
+END
+
+open MINI, "miniperlmain.c";
+while (<MINI>) {
+    last if /Do not delete this line--writemain depends on it/;
+    print;
+}
+
+print <<'END';
+EOF!HEAD
+$tail=<<'EOF!TAIL';
+END
+
+while (<MINI>) {
+    print;
+}
+close MINI;
+
+print <<'END';
+EOF!TAIL
+
+sub writemain{
+    my(@exts) = @_;
+
+    my($pname);
+    my($dl) = canon('/','DynaLoader');
+    print $head;
+
+    foreach $_ (@exts){
+	my($pname) = canon('/', $_);
+	my($mname, $cname);
+	($mname = $pname) =~ s!/!::!g;
+	($cname = $pname) =~ s!/!__!g;
+	print "EXTERN_C void boot_${cname} _((CV* cv));\n";
+    }
+
+    my ($tail1,$tail2) = ( $tail =~ /\A(.*\n)(\s*\}.*)\Z/s );
+    print $tail1;
+
+    print "	char *file = __FILE__;\n";
+    foreach $_ (@exts){
+	my($pname) = canon('/', $_);
+	my($mname, $cname, $ccode);
+	($mname = $pname) =~ s!/!::!g;
+	($cname = $pname) =~ s!/!__!g;
+	print "\t{\n";
+	if ($pname eq $dl){
+	    # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+	    # boot_DynaLoader is called directly in DynaLoader.pm
+	    $ccode = "\t/* DynaLoader is a special case */\n
+\tnewXS(\"${mname}::boot_${cname}\", boot_${cname}, file);\n";
+	    print $ccode unless $SEEN{$ccode}++;
+	} else {
+	    $ccode = "\tnewXS(\"${mname}::bootstrap\", boot_${cname}, file);\n";
+	    print $ccode unless $SEEN{$ccode}++;
+	}
+	print "\t}\n";
+    }
+    print $tail2;
+}
+
+sub canon{
+    my($as, @ext) = @_;
+	foreach(@ext){
+	    # might be X::Y or lib/auto/X/Y/Y.a
+		next if s!::!/!g;
+	    s:^(lib|ext)/(auto/)?::;
+	    s:/\w+\.\w+$::;
+	}
+	grep(s:/:$as:, @ext) if ($as ne '/');
+	@ext;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+ExtUtils::Miniperl, writemain - write the C code for perlmain.c
+
+=head1 SYNOPSIS
+
+C<use ExtUtils::Miniperl;>
+
+C<writemain(@directories);>
+
+=head1 DESCRIPTION
+
+This whole module is written when perl itself is built from a script
+called minimod.PL. In case you want to patch it, please patch
+minimod.PL in the perl distribution instead.
+
+writemain() takes an argument list of directories containing archive
+libraries that relate to perl modules and should be linked into a new
+perl binary. It writes to STDOUT a corresponding perlmain.c file that
+is a plain C file containing all the bootstrap code to make the
+modules associated with the libraries available from within perl.
+
+The typical usage is from within a Makefile generated by
+ExtUtils::MakeMaker. So under normal circumstances you won't have to
+deal with this module directly.
+
+=head1 SEE ALSO
+
+L<ExtUtils::MakeMaker>
+
+=cut
+
+END
diff --git a/gnu/usr.bin/perl/miniperlmain.c b/gnu/usr.bin/perl/miniperlmain.c
new file mode 100644
index 00000000000..bc81e997372
--- /dev/null
+++ b/gnu/usr.bin/perl/miniperlmain.c
@@ -0,0 +1,67 @@
+/*
+ * "The Road goes ever on and on, down from the door where it began."
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef __cplusplus
+}
+#  define EXTERN_C extern "C"
+#else
+#  define EXTERN_C extern
+#endif
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+
+int
+#ifdef CAN_PROTOTYPE
+main(int argc, char **argv, char **env)
+#else
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#endif
+{
+    int exitstatus;
+
+    PERL_SYS_INIT(&argc,&argv);
+
+    perl_init_i18nl14n(1);
+
+    if (!do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+    }
+
+    exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
+    if (exitstatus)
+	exit( exitstatus );
+
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    PERL_SYS_TERM();
+
+    exit( exitstatus );
+}
+
+/* Register any extra external extensions */
+
+/* Do not delete this line--writemain depends on it */
+
+static void
+xs_init()
+{
+  dXSUB_SYS;
+}
diff --git a/gnu/usr.bin/perl/mv-if-diff b/gnu/usr.bin/perl/mv-if-diff
new file mode 100644
index 00000000000..1112a10dd3e
--- /dev/null
+++ b/gnu/usr.bin/perl/mv-if-diff
@@ -0,0 +1,14 @@
+: mv-if-diff file1 file2
+: move file1 to file2 if file1 and file2 are different.
+
+if test $# -lt 2 ; then
+	echo "usage:  $0 file1 file2"
+	echo "move file1 to file2 if file1 and file2 are different."
+	exit 1
+fi
+if cmp $1 $2 >/dev/null 2>&1; then
+	echo "File $2 not changed."
+	rm -f tmp
+else
+	mv $1 $2
+fi
diff --git a/gnu/usr.bin/perl/myconfig b/gnu/usr.bin/perl/myconfig
new file mode 100644
index 00000000000..9038197aafa
--- /dev/null
+++ b/gnu/usr.bin/perl/myconfig
@@ -0,0 +1,43 @@
+#!/bin/sh
+
+# This script is designed to provide a handy summary of the configuration
+# information being used to build perl. This is especially useful if you
+# are requesting help from comp.lang.perl.misc on usenet or via mail.
+
+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 the perl config.sh file produced by Configure"; exit 1
+fi
+. $TOP/config.sh
+
+# Note that the text lines /^Summary of/ .. /^\s*$/ are copied into Config.pm.
+# XXX Add d_sigaction (?) once it's defined.
+
+$spitshell <<!GROK!THIS!
+
+Summary of my $package ($baserev patchlevel $PATCHLEVEL subversion $SUBVERSION) configuration:
+  Platform:
+    osname=$osname, osver=$osvers, archname=$archname
+    uname='$myuname'
+    hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction
+  Compiler:
+    cc='$cc', optimize='$optimize', gccversion=$gccversion
+    cppflags='$cppflags'
+    ccflags ='$ccflags'
+    stdchar='$stdchar', d_stdstdio=$d_stdstdio, usevfork=$usevfork
+    voidflags=$voidflags, castflags=$castflags, d_casti32=$d_casti32, d_castneg=$d_castneg
+    intsize=$intsize, alignbytes=$alignbytes, usemymalloc=$usemymalloc, randbits=$randbits
+  Linker and Libraries:
+    ld='$ld', ldflags ='$ldflags'
+    libpth=$libpth
+    libs=$libs
+    libc=$libc, so=$so
+  Dynamic Linking:
+    dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags'
+    cccdlflags='$cccdlflags', lddlflags='$lddlflags'
+
+!GROK!THIS!
diff --git a/gnu/usr.bin/perl/op.c b/gnu/usr.bin/perl/op.c
new file mode 100644
index 00000000000..d56ed9ad8d4
--- /dev/null
+++ b/gnu/usr.bin/perl/op.c
@@ -0,0 +1,4140 @@
+/*    op.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
+ * our Mr. Bilbo's first cousin on the mother's side (her mother being the
+ * youngest of the Old Took's daughters); and Mr. Drogo was his second
+ * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
+ * either way, as the saying is, if you follow me."  --the Gaffer
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#define USE_OP_MASK  /* Turned on by default in 5.002beta1h */
+
+#ifdef USE_OP_MASK
+/*
+ * In the following definition, the ", (OP *) op" is just to make the compiler
+ * think the expression is of the right type: croak actually does a Siglongjmp.
+ */
+#define CHECKOP(type,op) \
+    ((op_mask && op_mask[type]) \
+     ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \
+     : (*check[type])((OP*)op))
+#else
+#define CHECKOP(type,op) (*check[type])(op)
+#endif /* USE_OP_MASK */
+
+static I32 list_assignment _((OP *op));
+static OP *bad_type _((I32 n, char *t, char *name, OP *kid));
+static OP *modkids _((OP *op, I32 type));
+static OP *no_fh_allowed _((OP *op));
+static OP *scalarboolean _((OP *op));
+static OP *too_few_arguments _((OP *op, char* name));
+static OP *too_many_arguments _((OP *op, char* name));
+static void null _((OP* op));
+static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
+	CV* startcv, I32 cx_ix));
+
+static char*
+CvNAME(cv)
+CV* cv;
+{
+    SV* tmpsv = sv_newmortal();
+    gv_efullname(tmpsv, CvGV(cv));
+    return SvPV(tmpsv,na);
+}
+
+static OP *
+no_fh_allowed(op)
+OP *op;
+{
+    sprintf(tokenbuf,"Missing comma after first argument to %s function",
+	op_desc[op->op_type]);
+    yyerror(tokenbuf);
+    return op;
+}
+
+static OP *
+too_few_arguments(op, name)
+OP* op;
+char* name;
+{
+    sprintf(tokenbuf,"Not enough arguments for %s", name);
+    yyerror(tokenbuf);
+    return op;
+}
+
+static OP *
+too_many_arguments(op, name)
+OP *op;
+char* name;
+{
+    sprintf(tokenbuf,"Too many arguments for %s", name);
+    yyerror(tokenbuf);
+    return op;
+}
+
+static OP *
+bad_type(n, t, name, kid)
+I32 n;
+char *t;
+char *name;
+OP *kid;
+{
+    sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
+	(int) n, name, t, op_desc[kid->op_type]);
+    yyerror(tokenbuf);
+    return op;
+}
+
+void
+assertref(op)
+OP *op;
+{
+    int type = op->op_type;
+    if (type != OP_AELEM && type != OP_HELEM) {
+	sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
+	yyerror(tokenbuf);
+	if (type == OP_RV2HV || type == OP_ENTERSUB)
+	    warn("(Did you mean $ or @ instead of %c?)\n",
+		type == OP_RV2HV ? '%' : '&');
+    }
+}
+
+/* "register" allocation */
+
+PADOFFSET
+pad_allocmy(name)
+char *name;
+{
+    PADOFFSET off;
+    SV *sv;
+
+    if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
+	if (!isprint(name[1]))
+	    sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */
+	croak("Can't use global %s in \"my\"",name);
+    }
+    off = pad_alloc(OP_PADSV, SVs_PADMY);
+    sv = NEWSV(1102,0);
+    sv_upgrade(sv, SVt_PVNV);
+    sv_setpv(sv, name);
+    av_store(comppad_name, off, sv);
+    SvNVX(sv) = (double)999999999;
+    SvIVX(sv) = 0;			/* Not yet introduced--see newSTATEOP */
+    if (!min_intro_pending)
+	min_intro_pending = off;
+    max_intro_pending = off;
+    if (*name == '@')
+	av_store(comppad, off, (SV*)newAV());
+    else if (*name == '%')
+	av_store(comppad, off, (SV*)newHV());
+    SvPADMY_on(curpad[off]);
+    return off;
+}
+
+static PADOFFSET
+#ifndef CAN_PROTOTYPE
+pad_findlex(name, newoff, seq, startcv, cx_ix)
+char *name;
+PADOFFSET newoff;
+I32 seq;
+CV* startcv;
+I32 cx_ix;
+#else
+pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
+#endif
+{
+    CV *cv;
+    I32 off;
+    SV *sv;
+    register I32 i;
+    register CONTEXT *cx;
+    int saweval;
+
+    for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
+	AV* curlist = CvPADLIST(cv);
+	SV** svp = av_fetch(curlist, 0, FALSE);
+	AV *curname;
+	if (!svp || *svp == &sv_undef)
+	    continue;
+	curname = (AV*)*svp;
+	svp = AvARRAY(curname);
+	for (off = AvFILL(curname); off > 0; off--) {
+	    if ((sv = svp[off]) &&
+		sv != &sv_undef &&
+		seq <= SvIVX(sv) &&
+		seq > (I32)SvNVX(sv) &&
+		strEQ(SvPVX(sv), name))
+	    {
+		I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
+		AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
+		SV *oldsv = *av_fetch(oldpad, off, TRUE);
+		if (!newoff) {		/* Not a mere clone operation. */
+		    SV *sv = NEWSV(1103,0);
+		    newoff = pad_alloc(OP_PADSV, SVs_PADMY);
+		    sv_upgrade(sv, SVt_PVNV);
+		    sv_setpv(sv, name);
+		    av_store(comppad_name, newoff, sv);
+		    SvNVX(sv) = (double)curcop->cop_seq;
+		    SvIVX(sv) = 999999999;	/* A ref, intro immediately */
+		    SvFLAGS(sv) |= SVf_FAKE;
+		}
+		av_store(comppad, newoff, SvREFCNT_inc(oldsv));
+		CvCLONE_on(compcv);
+		return newoff;
+	    }
+	}
+    }
+
+    /* Nothing in current lexical context--try eval's context, if any.
+     * This is necessary to let the perldb get at lexically scoped variables.
+     * XXX This will also probably interact badly with eval tree caching.
+     */
+
+    saweval = 0;
+    for (i = cx_ix; i >= 0; i--) {
+	cx = &cxstack[i];
+	switch (cx->cx_type) {
+	default:
+	    if (i == 0 && saweval) {
+		seq = cxstack[saweval].blk_oldcop->cop_seq;
+		return pad_findlex(name, newoff, seq, main_cv, 0);
+	    }
+	    break;
+	case CXt_EVAL:
+	    if (cx->blk_eval.old_op_type != OP_ENTEREVAL &&
+		cx->blk_eval.old_op_type != OP_ENTERTRY)
+		return 0;	/* require must have its own scope */
+	    saweval = i;
+	    break;
+	case CXt_SUB:
+	    if (!saweval)
+		return 0;
+	    cv = cx->blk_sub.cv;
+	    if (debstash && CvSTASH(cv) == debstash) {	/* ignore DB'* scope */
+		saweval = i;	/* so we know where we were called from */
+		continue;
+	    }
+	    seq = cxstack[saweval].blk_oldcop->cop_seq;
+	    return pad_findlex(name, newoff, seq, cv, i-1);
+	}
+    }
+
+    return 0;
+}
+
+PADOFFSET
+pad_findmy(name)
+char *name;
+{
+    I32 off;
+    SV *sv;
+    SV **svp = AvARRAY(comppad_name);
+    I32 seq = cop_seqmax;
+
+    /* The one we're looking for is probably just before comppad_name_fill. */
+    for (off = AvFILL(comppad_name); off > 0; off--) {
+	if ((sv = svp[off]) &&
+	    sv != &sv_undef &&
+	    seq <= SvIVX(sv) &&
+	    seq > (I32)SvNVX(sv) &&
+	    strEQ(SvPVX(sv), name))
+	{
+	    return (PADOFFSET)off;
+	}
+    }
+
+    /* See if it's in a nested scope */
+    off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
+    if (off)
+	return off;
+
+    return 0;
+}
+
+void
+pad_leavemy(fill)
+I32 fill;
+{
+    I32 off;
+    SV **svp = AvARRAY(comppad_name);
+    SV *sv;
+    if (min_intro_pending && fill < min_intro_pending) {
+	for (off = max_intro_pending; off >= min_intro_pending; off--) {
+	    if ((sv = svp[off]) && sv != &sv_undef)
+		warn("%s never introduced", SvPVX(sv));
+	}
+    }
+    /* "Deintroduce" my variables that are leaving with this scope. */
+    for (off = AvFILL(comppad_name); off > fill; off--) {
+	if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
+	    SvIVX(sv) = cop_seqmax;
+    }
+}
+
+PADOFFSET
+pad_alloc(optype,tmptype)	
+I32 optype;
+U32 tmptype;
+{
+    SV *sv;
+    I32 retval;
+
+    if (AvARRAY(comppad) != curpad)
+	croak("panic: pad_alloc");
+    if (pad_reset_pending)
+	pad_reset();
+    if (tmptype & SVs_PADMY) {
+	do {
+	    sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+	} while (SvPADBUSY(sv));		/* need a fresh one */
+	retval = AvFILL(comppad);
+    }
+    else {
+	do {
+	    sv = *av_fetch(comppad, ++padix, TRUE);
+	} while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
+	retval = padix;
+    }
+    SvFLAGS(sv) |= tmptype;
+    curpad = AvARRAY(comppad);
+    DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
+    return (PADOFFSET)retval;
+}
+
+SV *
+#ifndef CAN_PROTOTYPE
+pad_sv(po)
+PADOFFSET po;
+#else
+pad_sv(PADOFFSET po)
+#endif /* CAN_PROTOTYPE */
+{
+    if (!po)
+	croak("panic: pad_sv po");
+    DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
+    return curpad[po];		/* eventually we'll turn this into a macro */
+}
+
+void
+#ifndef CAN_PROTOTYPE
+pad_free(po)
+PADOFFSET po;
+#else
+pad_free(PADOFFSET po)
+#endif /* CAN_PROTOTYPE */
+{
+    if (!curpad)
+	return;
+    if (AvARRAY(comppad) != curpad)
+	croak("panic: pad_free curpad");
+    if (!po)
+	croak("panic: pad_free po");
+    DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
+    if (curpad[po] && curpad[po] != &sv_undef)
+	SvPADTMP_off(curpad[po]);
+    if ((I32)po < padix)
+	padix = po - 1;
+}
+
+void
+#ifndef CAN_PROTOTYPE
+pad_swipe(po)
+PADOFFSET po;
+#else
+pad_swipe(PADOFFSET po)
+#endif /* CAN_PROTOTYPE */
+{
+    if (AvARRAY(comppad) != curpad)
+	croak("panic: pad_swipe curpad");
+    if (!po)
+	croak("panic: pad_swipe po");
+    DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
+    SvPADTMP_off(curpad[po]);
+    curpad[po] = NEWSV(1107,0);
+    SvPADTMP_on(curpad[po]);
+    if ((I32)po < padix)
+	padix = po - 1;
+}
+
+void
+pad_reset()
+{
+    register I32 po;
+
+    if (AvARRAY(comppad) != curpad)
+	croak("panic: pad_reset curpad");
+    DEBUG_X(fprintf(stderr, "Pad reset\n"));
+    if (!tainting) {	/* Can't mix tainted and non-tainted temporaries. */
+	for (po = AvMAX(comppad); po > padix_floor; po--) {
+	    if (curpad[po] && curpad[po] != &sv_undef)
+		SvPADTMP_off(curpad[po]);
+	}
+	padix = padix_floor;
+    }
+    pad_reset_pending = FALSE;
+}
+
+/* Destructor */
+
+void
+op_free(op)
+OP *op;
+{
+    register OP *kid, *nextkid;
+
+    if (!op)
+	return;
+
+    if (op->op_flags & OPf_KIDS) {
+	for (kid = cUNOP->op_first; kid; kid = nextkid) {
+	    nextkid = kid->op_sibling; /* Get before next freeing kid */
+	    op_free(kid);
+	}
+    }
+
+    switch (op->op_type) {
+    case OP_NULL:
+	op->op_targ = 0;	/* Was holding old type, if any. */
+	break;
+    case OP_ENTEREVAL:
+	op->op_targ = 0;	/* Was holding hints. */
+	break;
+    case OP_GVSV:
+    case OP_GV:
+	SvREFCNT_dec(cGVOP->op_gv);
+	break;
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+	SvREFCNT_dec(cCOP->cop_filegv);
+	break;
+    case OP_CONST:
+	SvREFCNT_dec(cSVOP->op_sv);
+	break;
+    case OP_GOTO:
+    case OP_NEXT:
+    case OP_LAST:
+    case OP_REDO:
+	if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
+	    break;
+	/* FALL THROUGH */
+    case OP_TRANS:
+	Safefree(cPVOP->op_pv);
+	break;
+    case OP_SUBST:
+	op_free(cPMOP->op_pmreplroot);
+	/* FALL THROUGH */
+    case OP_PUSHRE:
+    case OP_MATCH:
+	pregfree(cPMOP->op_pmregexp);
+	SvREFCNT_dec(cPMOP->op_pmshort);
+	break;
+    default:
+	break;
+    }
+
+    if (op->op_targ > 0)
+	pad_free(op->op_targ);
+
+    Safefree(op);
+}
+
+static void
+null(op)
+OP* op;
+{
+    if (op->op_type != OP_NULL && op->op_targ > 0)
+	pad_free(op->op_targ);
+    op->op_targ = op->op_type;
+    op->op_type = OP_NULL;
+    op->op_ppaddr = ppaddr[OP_NULL];
+}
+
+/* Contextualizers */
+
+#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
+
+OP *
+linklist(op)
+OP *op;
+{
+    register OP *kid;
+
+    if (op->op_next)
+	return op->op_next;
+
+    /* establish postfix order */
+    if (cUNOP->op_first) {
+	op->op_next = LINKLIST(cUNOP->op_first);
+	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+	    if (kid->op_sibling)
+		kid->op_next = LINKLIST(kid->op_sibling);
+	    else
+		kid->op_next = op;
+	}
+    }
+    else
+	op->op_next = op;
+
+    return op->op_next;
+}
+
+OP *
+scalarkids(op)
+OP *op;
+{
+    OP *kid;
+    if (op && op->op_flags & OPf_KIDS) {
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    scalar(kid);
+    }
+    return op;
+}
+
+static OP *
+scalarboolean(op)
+OP *op;
+{
+    if (dowarn &&
+	op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
+	line_t oldline = curcop->cop_line;
+
+	if (copline != NOLINE)
+	    curcop->cop_line = copline;
+	warn("Found = in conditional, should be ==");
+	curcop->cop_line = oldline;
+    }
+    return scalar(op);
+}
+
+OP *
+scalar(op)
+OP *op;
+{
+    OP *kid;
+
+    /* assumes no premature commitment */
+    if (!op || (op->op_flags & OPf_KNOW) || error_count)
+	return op;
+
+    op->op_flags &= ~OPf_LIST;
+    op->op_flags |= OPf_KNOW;
+
+    switch (op->op_type) {
+    case OP_REPEAT:
+	if (op->op_private & OPpREPEAT_DOLIST)
+	    null(((LISTOP*)cBINOP->op_first)->op_first);
+	scalar(cBINOP->op_first);
+	break;
+    case OP_OR:
+    case OP_AND:
+    case OP_COND_EXPR:
+	for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+	    scalar(kid);
+	break;
+    case OP_SPLIT:
+	if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+	    if (!kPMOP->op_pmreplroot)
+		deprecate("implicit split to @_");
+	}
+	/* FALL THROUGH */
+    case OP_MATCH:
+    case OP_SUBST:
+    case OP_NULL:
+    default:
+	if (op->op_flags & OPf_KIDS) {
+	    for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+		scalar(kid);
+	}
+	break;
+    case OP_LEAVE:
+    case OP_LEAVETRY:
+	scalar(cLISTOP->op_first);
+	/* FALL THROUGH */
+    case OP_SCOPE:
+    case OP_LINESEQ:
+    case OP_LIST:
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+	    if (kid->op_sibling)
+		scalarvoid(kid);
+	    else
+		scalar(kid);
+	}
+	curcop = &compiling;
+	break;
+    }
+    return op;
+}
+
+OP *
+scalarvoid(op)
+OP *op;
+{
+    OP *kid;
+    char* useless = 0;
+    SV* sv;
+
+    if (!op || error_count)
+	return op;
+    if (op->op_flags & OPf_LIST)
+	return op;
+
+    op->op_flags |= OPf_KNOW;
+
+    switch (op->op_type) {
+    default:
+	if (!(opargs[op->op_type] & OA_FOLDCONST))
+	    break;
+	if (op->op_flags & OPf_STACKED)
+	    break;
+	/* FALL THROUGH */
+    case OP_GVSV:
+    case OP_WANTARRAY:
+    case OP_GV:
+    case OP_PADSV:
+    case OP_PADAV:
+    case OP_PADHV:
+    case OP_PADANY:
+    case OP_AV2ARYLEN:
+    case OP_REF:
+    case OP_REFGEN:
+    case OP_SREFGEN:
+    case OP_DEFINED:
+    case OP_HEX:
+    case OP_OCT:
+    case OP_LENGTH:
+    case OP_SUBSTR:
+    case OP_VEC:
+    case OP_INDEX:
+    case OP_RINDEX:
+    case OP_SPRINTF:
+    case OP_AELEM:
+    case OP_AELEMFAST:
+    case OP_ASLICE:
+    case OP_VALUES:
+    case OP_KEYS:
+    case OP_HELEM:
+    case OP_HSLICE:
+    case OP_UNPACK:
+    case OP_PACK:
+    case OP_JOIN:
+    case OP_LSLICE:
+    case OP_ANONLIST:
+    case OP_ANONHASH:
+    case OP_SORT:
+    case OP_REVERSE:
+    case OP_RANGE:
+    case OP_FLIP:
+    case OP_FLOP:
+    case OP_CALLER:
+    case OP_FILENO:
+    case OP_EOF:
+    case OP_TELL:
+    case OP_GETSOCKNAME:
+    case OP_GETPEERNAME:
+    case OP_READLINK:
+    case OP_TELLDIR:
+    case OP_GETPPID:
+    case OP_GETPGRP:
+    case OP_GETPRIORITY:
+    case OP_TIME:
+    case OP_TMS:
+    case OP_LOCALTIME:
+    case OP_GMTIME:
+    case OP_GHBYNAME:
+    case OP_GHBYADDR:
+    case OP_GHOSTENT:
+    case OP_GNBYNAME:
+    case OP_GNBYADDR:
+    case OP_GNETENT:
+    case OP_GPBYNAME:
+    case OP_GPBYNUMBER:
+    case OP_GPROTOENT:
+    case OP_GSBYNAME:
+    case OP_GSBYPORT:
+    case OP_GSERVENT:
+    case OP_GPWNAM:
+    case OP_GPWUID:
+    case OP_GGRNAM:
+    case OP_GGRGID:
+    case OP_GETLOGIN:
+	if (!(op->op_private & OPpLVAL_INTRO))
+	    useless = op_desc[op->op_type];
+	break;
+
+    case OP_RV2GV:
+    case OP_RV2SV:
+    case OP_RV2AV:
+    case OP_RV2HV:
+	if (!(op->op_private & OPpLVAL_INTRO) &&
+		(!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
+	    useless = "a variable";
+	break;
+
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+	curcop = ((COP*)op);		/* for warning below */
+	break;
+
+    case OP_CONST:
+	sv = cSVOP->op_sv;
+	if (dowarn) {
+	    useless = "a constant";
+	    if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+		useless = 0;
+	    else if (SvPOK(sv)) {
+		if (strnEQ(SvPVX(sv), "di", 2) ||
+		    strnEQ(SvPVX(sv), "ds", 2) ||
+		    strnEQ(SvPVX(sv), "ig", 2))
+			useless = 0;
+	    }
+	}
+	null(op);		/* don't execute a constant */
+	SvREFCNT_dec(sv);	/* don't even remember it */
+	break;
+
+    case OP_POSTINC:
+	op->op_type = OP_PREINC;		/* pre-increment is faster */
+	op->op_ppaddr = ppaddr[OP_PREINC];
+	break;
+
+    case OP_POSTDEC:
+	op->op_type = OP_PREDEC;		/* pre-decrement is faster */
+	op->op_ppaddr = ppaddr[OP_PREDEC];
+	break;
+
+    case OP_REPEAT:
+	scalarvoid(cBINOP->op_first);
+	useless = op_desc[op->op_type];
+	break;
+
+    case OP_OR:
+    case OP_AND:
+    case OP_COND_EXPR:
+	for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+	    scalarvoid(kid);
+	break;
+    case OP_NULL:
+	if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
+	    curcop = ((COP*)op);		/* for warning below */
+	if (op->op_flags & OPf_STACKED)
+	    break;
+    case OP_ENTERTRY:
+    case OP_ENTER:
+    case OP_SCALAR:
+	if (!(op->op_flags & OPf_KIDS))
+	    break;
+    case OP_SCOPE:
+    case OP_LEAVE:
+    case OP_LEAVETRY:
+    case OP_LEAVELOOP:
+	op->op_private |= OPpLEAVE_VOID;
+    case OP_LINESEQ:
+    case OP_LIST:
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    scalarvoid(kid);
+	break;
+    case OP_SPLIT:
+	if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
+	    if (!kPMOP->op_pmreplroot)
+		deprecate("implicit split to @_");
+	}
+	break;
+    case OP_DELETE:
+	op->op_private |= OPpLEAVE_VOID;
+	break;
+    }
+    if (useless && dowarn)
+	warn("Useless use of %s in void context", useless);
+    return op;
+}
+
+OP *
+listkids(op)
+OP *op;
+{
+    OP *kid;
+    if (op && op->op_flags & OPf_KIDS) {
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    list(kid);
+    }
+    return op;
+}
+
+OP *
+list(op)
+OP *op;
+{
+    OP *kid;
+
+    /* assumes no premature commitment */
+    if (!op || (op->op_flags & OPf_KNOW) || error_count)
+	return op;
+
+    op->op_flags |= (OPf_KNOW | OPf_LIST);
+
+    switch (op->op_type) {
+    case OP_FLOP:
+    case OP_REPEAT:
+	list(cBINOP->op_first);
+	break;
+    case OP_OR:
+    case OP_AND:
+    case OP_COND_EXPR:
+	for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+	    list(kid);
+	break;
+    default:
+    case OP_MATCH:
+    case OP_SUBST:
+    case OP_NULL:
+	if (!(op->op_flags & OPf_KIDS))
+	    break;
+	if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
+	    list(cBINOP->op_first);
+	    return gen_constant_list(op);
+	}
+    case OP_LIST:
+	listkids(op);
+	break;
+    case OP_LEAVE:
+    case OP_LEAVETRY:
+	list(cLISTOP->op_first);
+	/* FALL THROUGH */
+    case OP_SCOPE:
+    case OP_LINESEQ:
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+	    if (kid->op_sibling)
+		scalarvoid(kid);
+	    else
+		list(kid);
+	}
+	curcop = &compiling;
+	break;
+    }
+    return op;
+}
+
+OP *
+scalarseq(op)
+OP *op;
+{
+    OP *kid;
+
+    if (op) {
+	if (op->op_type == OP_LINESEQ ||
+	     op->op_type == OP_SCOPE ||
+	     op->op_type == OP_LEAVE ||
+	     op->op_type == OP_LEAVETRY)
+	{
+	    for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+		if (kid->op_sibling) {
+		    scalarvoid(kid);
+		}
+	    }
+	    curcop = &compiling;
+	}
+	op->op_flags &= ~OPf_PARENS;
+	if (hints & HINT_BLOCK_SCOPE)
+	    op->op_flags |= OPf_PARENS;
+    }
+    else
+	op = newOP(OP_STUB, 0);
+    return op;
+}
+
+static OP *
+modkids(op, type)
+OP *op;
+I32 type;
+{
+    OP *kid;
+    if (op && op->op_flags & OPf_KIDS) {
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    mod(kid, type);
+    }
+    return op;
+}
+
+static I32 modcount;
+
+OP *
+mod(op, type)
+OP *op;
+I32 type;
+{
+    OP *kid;
+    SV *sv;
+    char mtype;
+
+    if (!op || error_count)
+	return op;
+
+    switch (op->op_type) {
+    case OP_CONST:
+	if (!(op->op_private & (OPpCONST_ARYBASE)))
+	    goto nomod;
+	if (eval_start && eval_start->op_type == OP_CONST) {
+	    compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
+	    eval_start = 0;
+	}
+	else if (!type) {
+	    SAVEI32(compiling.cop_arybase);
+	    compiling.cop_arybase = 0;
+	}
+	else if (type == OP_REFGEN)
+	    goto nomod;
+	else
+	    croak("That use of $[ is unsupported");
+	break;
+    case OP_ENTERSUB:
+	if ((type == OP_UNDEF || type == OP_REFGEN) &&
+	    !(op->op_flags & OPf_STACKED)) {
+	    op->op_type = OP_RV2CV;		/* entersub => rv2cv */
+	    op->op_ppaddr = ppaddr[OP_RV2CV];
+	    assert(cUNOP->op_first->op_type == OP_NULL);
+	    null(((LISTOP*)cUNOP->op_first)->op_first);	/* disable pushmark */
+	    break;
+	}
+	/* FALL THROUGH */
+    default:
+      nomod:
+	/* grep, foreach, subcalls, refgen */
+	if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
+	    break;
+	sprintf(tokenbuf, "Can't modify %s in %s",
+	    op_desc[op->op_type],
+	    type ? op_desc[type] : "local");
+	yyerror(tokenbuf);
+	return op;
+
+    case OP_PREINC:
+    case OP_PREDEC:
+    case OP_POW:
+    case OP_MULTIPLY:
+    case OP_DIVIDE:
+    case OP_MODULO:
+    case OP_REPEAT:
+    case OP_ADD:
+    case OP_SUBTRACT:
+    case OP_CONCAT:
+    case OP_LEFT_SHIFT:
+    case OP_RIGHT_SHIFT:
+    case OP_BIT_AND:
+    case OP_BIT_XOR:
+    case OP_BIT_OR:
+    case OP_I_MULTIPLY:
+    case OP_I_DIVIDE:
+    case OP_I_MODULO:
+    case OP_I_ADD:
+    case OP_I_SUBTRACT:
+	if (!(op->op_flags & OPf_STACKED))
+	    goto nomod;
+	modcount++;
+	break;
+	
+    case OP_COND_EXPR:
+	for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+	    mod(kid, type);
+	break;
+
+    case OP_RV2AV:
+    case OP_RV2HV:
+	if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
+	    modcount = 10000;
+	    return op;		/* Treat \(@foo) like ordinary list. */
+	}
+	/* FALL THROUGH */
+    case OP_RV2GV:
+	ref(cUNOP->op_first, op->op_type);
+	/* FALL THROUGH */
+    case OP_AASSIGN:
+    case OP_ASLICE:
+    case OP_HSLICE:
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+    case OP_REFGEN:
+    case OP_CHOMP:
+	modcount = 10000;
+	break;
+    case OP_RV2SV:
+	if (!type && cUNOP->op_first->op_type != OP_GV)
+	    croak("Can't localize a reference");
+	ref(cUNOP->op_first, op->op_type); 
+	/* FALL THROUGH */
+    case OP_UNDEF:
+    case OP_GV:
+    case OP_AV2ARYLEN:
+    case OP_SASSIGN:
+    case OP_AELEMFAST:
+	modcount++;
+	break;
+
+    case OP_PADAV:
+    case OP_PADHV:
+	modcount = 10000;
+	/* FALL THROUGH */
+    case OP_PADSV:
+	modcount++;
+	if (!type)
+	    croak("Can't localize lexical variable %s",
+		SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
+	break;
+
+    case OP_PUSHMARK:
+	break;
+	
+    case OP_POS:
+	mtype = '.';
+	goto makelv;
+    case OP_VEC:
+	mtype = 'v';
+	goto makelv;
+    case OP_SUBSTR:
+	mtype = 'x';
+      makelv:
+	pad_free(op->op_targ);
+	op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
+	sv = PAD_SV(op->op_targ);
+	sv_upgrade(sv, SVt_PVLV);
+	sv_magic(sv, Nullsv, mtype, Nullch, 0);
+	curpad[op->op_targ] = sv;
+	if (op->op_flags & OPf_KIDS)
+	    mod(cBINOP->op_first->op_sibling, type);
+	break;
+
+    case OP_AELEM:
+    case OP_HELEM:
+	ref(cBINOP->op_first, op->op_type);
+	modcount++;
+	break;
+
+    case OP_SCOPE:
+    case OP_LEAVE:
+    case OP_ENTER:
+	if (op->op_flags & OPf_KIDS)
+	    mod(cLISTOP->op_last, type);
+	break;
+
+    case OP_NULL:
+	if (!(op->op_flags & OPf_KIDS))
+	    break;
+	if (op->op_targ != OP_LIST) {
+	    mod(cBINOP->op_first, type);
+	    break;
+	}
+	/* FALL THROUGH */
+    case OP_LIST:
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    mod(kid, type);
+	break;
+    }
+    op->op_flags |= OPf_MOD;
+
+    if (type == OP_AASSIGN || type == OP_SASSIGN)
+	op->op_flags |= OPf_SPECIAL|OPf_REF;
+    else if (!type) {
+	op->op_private |= OPpLVAL_INTRO;
+	op->op_flags &= ~OPf_SPECIAL;
+    }
+    else if (type != OP_GREPSTART && type != OP_ENTERSUB)
+	op->op_flags |= OPf_REF;
+    return op;
+}
+
+OP *
+refkids(op, type)
+OP *op;
+I32 type;
+{
+    OP *kid;
+    if (op && op->op_flags & OPf_KIDS) {
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    ref(kid, type);
+    }
+    return op;
+}
+
+OP *
+ref(op, type)
+OP *op;
+I32 type;
+{
+    OP *kid;
+
+    if (!op || error_count)
+	return op;
+
+    switch (op->op_type) {
+    case OP_ENTERSUB:
+	if ((type == OP_DEFINED) &&
+	    !(op->op_flags & OPf_STACKED)) {
+	    op->op_type = OP_RV2CV;             /* entersub => rv2cv */
+	    op->op_ppaddr = ppaddr[OP_RV2CV];
+	    assert(cUNOP->op_first->op_type == OP_NULL);
+	    null(((LISTOP*)cUNOP->op_first)->op_first);	/* disable pushmark */
+	    op->op_flags |= OPf_SPECIAL;
+	}
+	break;
+      
+    case OP_COND_EXPR:
+	for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+	    ref(kid, type);
+	break;
+    case OP_RV2SV:
+	ref(cUNOP->op_first, op->op_type);
+	/* FALL THROUGH */
+    case OP_PADSV:
+	if (type == OP_RV2AV || type == OP_RV2HV) {
+	    op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
+	    op->op_flags |= OPf_MOD;
+	}
+	break;
+      
+    case OP_RV2AV:
+    case OP_RV2HV:
+	op->op_flags |= OPf_REF; 
+	/* FALL THROUGH */
+    case OP_RV2GV:
+	ref(cUNOP->op_first, op->op_type);
+	break;
+
+    case OP_PADAV:
+    case OP_PADHV:
+	op->op_flags |= OPf_REF; 
+	break;
+      
+    case OP_SCALAR:
+    case OP_NULL:
+	if (!(op->op_flags & OPf_KIDS))
+	    break;
+	ref(cBINOP->op_first, type);
+	break;
+    case OP_AELEM:
+    case OP_HELEM:
+	ref(cBINOP->op_first, op->op_type);
+	if (type == OP_RV2AV || type == OP_RV2HV) {
+	    op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
+	    op->op_flags |= OPf_MOD;
+	}
+	break;
+
+    case OP_SCOPE:
+    case OP_LEAVE:
+    case OP_ENTER:
+    case OP_LIST:
+	if (!(op->op_flags & OPf_KIDS))
+	    break;
+	ref(cLISTOP->op_last, type);
+	break;
+    default:
+	break;
+    }
+    return scalar(op);
+
+}
+
+OP *
+my(op)
+OP *op;
+{
+    OP *kid;
+    I32 type;
+
+    if (!op || error_count)
+	return op;
+
+    type = op->op_type;
+    if (type == OP_LIST) {
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    my(kid);
+    }
+    else if (type != OP_PADSV &&
+	     type != OP_PADAV &&
+	     type != OP_PADHV &&
+	     type != OP_PUSHMARK)
+    {
+	sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]);
+	yyerror(tokenbuf);
+	return op;
+    }
+    op->op_flags |= OPf_MOD;
+    op->op_private |= OPpLVAL_INTRO;
+    return op;
+}
+
+OP *
+sawparens(o)
+OP *o;
+{
+    if (o)
+	o->op_flags |= OPf_PARENS;
+    return o;
+}
+
+OP *
+bind_match(type, left, right)
+I32 type;
+OP *left;
+OP *right;
+{
+    OP *op;
+
+    if (right->op_type == OP_MATCH ||
+	right->op_type == OP_SUBST ||
+	right->op_type == OP_TRANS) {
+	right->op_flags |= OPf_STACKED;
+	if (right->op_type != OP_MATCH)
+	    left = mod(left, right->op_type);
+	if (right->op_type == OP_TRANS)
+	    op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
+	else
+	    op = prepend_elem(right->op_type, scalar(left), right);
+	if (type == OP_NOT)
+	    return newUNOP(OP_NOT, 0, scalar(op));
+	return op;
+    }
+    else
+	return bind_match(type, left,
+		pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
+}
+
+OP *
+invert(op)
+OP *op;
+{
+    if (!op)
+	return op;
+    /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
+    return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
+}
+
+OP *
+scope(o)
+OP *o;
+{
+    if (o) {
+	if (o->op_flags & OPf_PARENS || perldb || tainting) {
+	    o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+	    o->op_type = OP_LEAVE;
+	    o->op_ppaddr = ppaddr[OP_LEAVE];
+	}
+	else {
+	    if (o->op_type == OP_LINESEQ) {
+		OP *kid;
+		o->op_type = OP_SCOPE;
+		o->op_ppaddr = ppaddr[OP_SCOPE];
+		kid = ((LISTOP*)o)->op_first;
+		if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
+		    SvREFCNT_dec(((COP*)kid)->cop_filegv);
+		    null(kid);
+		}
+	    }
+	    else
+		o = newLISTOP(OP_SCOPE, 0, o, Nullop);
+	}
+    }
+    return o;
+}
+
+int
+block_start()
+{
+    int retval = savestack_ix;
+    comppad_name_fill = AvFILL(comppad_name);
+    SAVEINT(min_intro_pending);
+    SAVEINT(max_intro_pending);
+    min_intro_pending = 0;
+    SAVEINT(comppad_name_fill);
+    SAVEINT(padix_floor);
+    padix_floor = padix;
+    pad_reset_pending = FALSE;
+    SAVEINT(hints);
+    hints &= ~HINT_BLOCK_SCOPE;
+    return retval;
+}
+
+OP*
+block_end(line, floor, seq)
+int line;
+int floor;
+OP* seq;
+{
+    int needblockscope = hints & HINT_BLOCK_SCOPE;
+    OP* retval = scalarseq(seq);
+    if (copline > (line_t)line)
+	copline = line;
+    LEAVE_SCOPE(floor);
+    pad_reset_pending = FALSE;
+    if (needblockscope)
+	hints |= HINT_BLOCK_SCOPE; /* propagate out */
+    pad_leavemy(comppad_name_fill);
+    return retval;
+}
+
+void
+newPROG(op)
+OP *op;
+{
+    if (in_eval) {
+	eval_root = newUNOP(OP_LEAVEEVAL, 0, op);
+	eval_start = linklist(eval_root);
+	eval_root->op_next = 0;
+	peep(eval_start);
+    }
+    else {
+	if (!op) {
+	    main_start = 0;
+	    return;
+	}
+	main_root = scope(sawparens(scalarvoid(op)));
+	curcop = &compiling;
+	main_start = LINKLIST(main_root);
+	main_root->op_next = 0;
+	peep(main_start);
+	main_cv = compcv;
+	compcv = 0;
+    }
+}
+
+OP *
+localize(o, lex)
+OP *o;
+I32 lex;
+{
+    if (o->op_flags & OPf_PARENS)
+	list(o);
+    else {
+	scalar(o);
+	if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
+	    char *s;
+	    for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
+	    if (*s == ';' || *s == '=')
+		warn("Parens missing around \"%s\" list", lex ? "my" : "local");
+	}
+    }
+    in_my = FALSE;
+    if (lex)
+	return my(o);
+    else
+	return mod(o, OP_NULL);		/* a bit kludgey */
+}
+
+OP *
+jmaybe(o)
+OP *o;
+{
+    if (o->op_type == OP_LIST) {
+	o = convert(OP_JOIN, 0,
+		prepend_elem(OP_LIST,
+		    newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
+		    o));
+    }
+    return o;
+}
+
+OP *
+fold_constants(o)
+register OP *o;
+{
+    register OP *curop;
+    I32 type = o->op_type;
+    SV *sv;
+
+    if (opargs[type] & OA_RETSCALAR)
+	scalar(o);
+    if (opargs[type] & OA_TARGET)
+	o->op_targ = pad_alloc(type, SVs_PADTMP);
+
+    if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
+	o->op_ppaddr = ppaddr[type = ++(o->op_type)];
+
+    if (!(opargs[type] & OA_FOLDCONST))
+	goto nope;
+
+    if (error_count)
+	goto nope;		/* Don't try to run w/ errors */
+
+    for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
+	if (curop->op_type != OP_CONST &&
+		curop->op_type != OP_LIST &&
+		curop->op_type != OP_SCALAR &&
+		curop->op_type != OP_NULL &&
+		curop->op_type != OP_PUSHMARK) {
+	    goto nope;
+	}
+    }
+
+    curop = LINKLIST(o);
+    o->op_next = 0;
+    op = curop;
+    runops();
+    sv = *(stack_sp--);
+    if (o->op_targ && sv == PAD_SV(o->op_targ))	/* grab pad temp? */
+	pad_swipe(o->op_targ);
+    else if (SvTEMP(sv)) {			/* grab mortal temp? */
+	(void)SvREFCNT_inc(sv);
+	SvTEMP_off(sv);
+    }
+    op_free(o);
+    if (type == OP_RV2GV)
+	return newGVOP(OP_GV, 0, sv);
+    else {
+	if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+	    IV iv = SvIV(sv);
+	    if ((double)iv == SvNV(sv)) {	/* can we smush double to int */
+		SvREFCNT_dec(sv);
+		sv = newSViv(iv);
+	    }
+	}
+	return newSVOP(OP_CONST, 0, sv);
+    }
+    
+  nope:
+    if (!(opargs[type] & OA_OTHERINT))
+	return o;
+
+    if (!(hints & HINT_INTEGER)) {
+	int vars = 0;
+
+	if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
+	    return o;
+
+	for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
+	    if (curop->op_type == OP_CONST) {
+		if (SvIOK(((SVOP*)curop)->op_sv)) {
+		    if (SvIVX(((SVOP*)curop)->op_sv) <= 0 && vars++)
+			return o;	/* negatives truncate wrong way, alas */
+		    continue;
+		}
+		return o;
+	    }
+	    if (opargs[curop->op_type] & OA_RETINTEGER)
+		continue;
+	    if (curop->op_type == OP_PADSV || curop->op_type == OP_RV2SV) {
+		if (vars++)
+		    return o;
+		if (((o->op_type == OP_LT || o->op_type == OP_GE) &&
+			curop == ((BINOP*)o)->op_first ) ||
+		    ((o->op_type == OP_GT || o->op_type == OP_LE) &&
+			curop == ((BINOP*)o)->op_last ))
+		{
+		    /* Allow "$i < 100" and variants to integerize */
+		    continue;
+		}
+	    }
+	    return o;
+	}
+	o->op_ppaddr = ppaddr[++(o->op_type)];
+    }
+
+    return o;
+}
+
+OP *
+gen_constant_list(o)
+register OP *o;
+{
+    register OP *curop;
+    I32 oldtmps_floor = tmps_floor;
+
+    list(o);
+    if (error_count)
+	return o;		/* Don't attempt to run with errors */
+
+    op = curop = LINKLIST(o);
+    o->op_next = 0;
+    pp_pushmark();
+    runops();
+    op = curop;
+    pp_anonlist();
+    tmps_floor = oldtmps_floor;
+
+    o->op_type = OP_RV2AV;
+    o->op_ppaddr = ppaddr[OP_RV2AV];
+    curop = ((UNOP*)o)->op_first;
+    ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
+    op_free(curop);
+    linklist(o);
+    return list(o);
+}
+
+OP *
+convert(type, flags, op)
+I32 type;
+I32 flags;
+OP* op;
+{
+    OP *kid;
+    OP *last = 0;
+
+    if (!op || op->op_type != OP_LIST)
+	op = newLISTOP(OP_LIST, 0, op, Nullop);
+    else
+	op->op_flags &= ~(OPf_KNOW|OPf_LIST);
+
+    if (!(opargs[type] & OA_MARK))
+	null(cLISTOP->op_first);
+
+    op->op_type = type;
+    op->op_ppaddr = ppaddr[type];
+    op->op_flags |= flags;
+
+    op = CHECKOP(type, op);
+    if (op->op_type != type)
+	return op;
+
+    if (cLISTOP->op_children < 7) {
+	/* XXX do we really need to do this if we're done appending?? */
+	for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+	    last = kid;
+	cLISTOP->op_last = last;	/* in case check substituted last arg */
+    }
+
+    return fold_constants(op);
+}
+
+/* List constructors */
+
+OP *
+append_elem(type, first, last)
+I32 type;
+OP* first;
+OP* last;
+{
+    if (!first)
+	return last;
+
+    if (!last)
+	return first;
+
+    if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
+	    return newLISTOP(type, 0, first, last);
+
+    if (first->op_flags & OPf_KIDS)
+	((LISTOP*)first)->op_last->op_sibling = last;
+    else {
+	first->op_flags |= OPf_KIDS;
+	((LISTOP*)first)->op_first = last;
+    }
+    ((LISTOP*)first)->op_last = last;
+    ((LISTOP*)first)->op_children++;
+    return first;
+}
+
+OP *
+append_list(type, first, last)
+I32 type;
+LISTOP* first;
+LISTOP* last;
+{
+    if (!first)
+	return (OP*)last;
+
+    if (!last)
+	return (OP*)first;
+
+    if (first->op_type != type)
+	return prepend_elem(type, (OP*)first, (OP*)last);
+
+    if (last->op_type != type)
+	return append_elem(type, (OP*)first, (OP*)last);
+
+    first->op_last->op_sibling = last->op_first;
+    first->op_last = last->op_last;
+    first->op_children += last->op_children;
+    if (first->op_children)
+	last->op_flags |= OPf_KIDS;
+
+    Safefree(last);
+    return (OP*)first;
+}
+
+OP *
+prepend_elem(type, first, last)
+I32 type;
+OP* first;
+OP* last;
+{
+    if (!first)
+	return last;
+
+    if (!last)
+	return first;
+
+    if (last->op_type == type) {
+	if (type == OP_LIST) {	/* already a PUSHMARK there */
+	    first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
+	    ((LISTOP*)last)->op_first->op_sibling = first;
+	}
+	else {
+	    if (!(last->op_flags & OPf_KIDS)) {
+		((LISTOP*)last)->op_last = first;
+		last->op_flags |= OPf_KIDS;
+	    }
+	    first->op_sibling = ((LISTOP*)last)->op_first;
+	    ((LISTOP*)last)->op_first = first;
+	}
+	((LISTOP*)last)->op_children++;
+	return last;
+    }
+
+    return newLISTOP(type, 0, first, last);
+}
+
+/* Constructors */
+
+OP *
+newNULLLIST()
+{
+    return newOP(OP_STUB, 0);
+}
+
+OP *
+force_list(op)
+OP* op;
+{
+    if (!op || op->op_type != OP_LIST)
+	op = newLISTOP(OP_LIST, 0, op, Nullop);
+    null(op);
+    return op;
+}
+
+OP *
+newLISTOP(type, flags, first, last)
+I32 type;
+I32 flags;
+OP* first;
+OP* last;
+{
+    LISTOP *listop;
+
+    Newz(1101, listop, 1, LISTOP);
+
+    listop->op_type = type;
+    listop->op_ppaddr = ppaddr[type];
+    listop->op_children = (first != 0) + (last != 0);
+    listop->op_flags = flags;
+
+    if (!last && first)
+	last = first;
+    else if (!first && last)
+	first = last;
+    else if (first)
+	first->op_sibling = last;
+    listop->op_first = first;
+    listop->op_last = last;
+    if (type == OP_LIST) {
+	OP* pushop;
+	pushop = newOP(OP_PUSHMARK, 0);
+	pushop->op_sibling = first;
+	listop->op_first = pushop;
+	listop->op_flags |= OPf_KIDS;
+	if (!last)
+	    listop->op_last = pushop;
+    }
+    else if (listop->op_children)
+	listop->op_flags |= OPf_KIDS;
+
+    return (OP*)listop;
+}
+
+OP *
+newOP(type, flags)
+I32 type;
+I32 flags;
+{
+    OP *op;
+    Newz(1101, op, 1, OP);
+    op->op_type = type;
+    op->op_ppaddr = ppaddr[type];
+    op->op_flags = flags;
+
+    op->op_next = op;
+    op->op_private = 0 + (flags >> 8);
+    if (opargs[type] & OA_RETSCALAR)
+	scalar(op);
+    if (opargs[type] & OA_TARGET)
+	op->op_targ = pad_alloc(type, SVs_PADTMP);
+    return CHECKOP(type, op);
+}
+
+OP *
+newUNOP(type, flags, first)
+I32 type;
+I32 flags;
+OP* first;
+{
+    UNOP *unop;
+
+    if (!first)
+	first = newOP(OP_STUB, 0); 
+    if (opargs[type] & OA_MARK)
+	first = force_list(first);
+
+    Newz(1101, unop, 1, UNOP);
+    unop->op_type = type;
+    unop->op_ppaddr = ppaddr[type];
+    unop->op_first = first;
+    unop->op_flags = flags | OPf_KIDS;
+    unop->op_private = 1 | (flags >> 8);
+
+    unop = (UNOP*) CHECKOP(type, unop);
+    if (unop->op_next)
+	return (OP*)unop;
+
+    return fold_constants((OP *) unop);
+}
+
+OP *
+newBINOP(type, flags, first, last)
+I32 type;
+I32 flags;
+OP* first;
+OP* last;
+{
+    BINOP *binop;
+    Newz(1101, binop, 1, BINOP);
+
+    if (!first)
+	first = newOP(OP_NULL, 0);
+
+    binop->op_type = type;
+    binop->op_ppaddr = ppaddr[type];
+    binop->op_first = first;
+    binop->op_flags = flags | OPf_KIDS;
+    if (!last) {
+	last = first;
+	binop->op_private = 1 | (flags >> 8);
+    }
+    else {
+	binop->op_private = 2 | (flags >> 8);
+	first->op_sibling = last;
+    }
+
+    binop = (BINOP*)CHECKOP(type, binop);
+    if (binop->op_next)
+	return (OP*)binop;
+
+    binop->op_last = last = binop->op_first->op_sibling;
+
+    return fold_constants((OP *)binop);
+}
+
+OP *
+pmtrans(op, expr, repl)
+OP *op;
+OP *expr;
+OP *repl;
+{
+    SV *tstr = ((SVOP*)expr)->op_sv;
+    SV *rstr = ((SVOP*)repl)->op_sv;
+    STRLEN tlen;
+    STRLEN rlen;
+    register U8 *t = (U8*)SvPV(tstr, tlen);
+    register U8 *r = (U8*)SvPV(rstr, rlen);
+    register I32 i;
+    register I32 j;
+    I32 delete;
+    I32 complement;
+    register short *tbl;
+
+    tbl = (short*)cPVOP->op_pv;
+    complement	= op->op_private & OPpTRANS_COMPLEMENT;
+    delete	= op->op_private & OPpTRANS_DELETE;
+    /* squash	= op->op_private & OPpTRANS_SQUASH; */
+
+    if (complement) {
+	Zero(tbl, 256, short);
+	for (i = 0; i < tlen; i++)
+	    tbl[t[i]] = -1;
+	for (i = 0, j = 0; i < 256; i++) {
+	    if (!tbl[i]) {
+		if (j >= rlen) {
+		    if (delete)
+			tbl[i] = -2;
+		    else if (rlen)
+			tbl[i] = r[j-1];
+		    else
+			tbl[i] = i;
+		}
+		else
+		    tbl[i] = r[j++];
+	    }
+	}
+    }
+    else {
+	if (!rlen && !delete) {
+	    r = t; rlen = tlen;
+	}
+	for (i = 0; i < 256; i++)
+	    tbl[i] = -1;
+	for (i = 0, j = 0; i < tlen; i++,j++) {
+	    if (j >= rlen) {
+		if (delete) {
+		    if (tbl[t[i]] == -1)
+			tbl[t[i]] = -2;
+		    continue;
+		}
+		--j;
+	    }
+	    if (tbl[t[i]] == -1)
+		tbl[t[i]] = r[j];
+	}
+    }
+    op_free(expr);
+    op_free(repl);
+
+    return op;
+}
+
+OP *
+newPMOP(type, flags)
+I32 type;
+I32 flags;
+{
+    PMOP *pmop;
+
+    Newz(1101, pmop, 1, PMOP);
+    pmop->op_type = type;
+    pmop->op_ppaddr = ppaddr[type];
+    pmop->op_flags = flags;
+    pmop->op_private = 0 | (flags >> 8);
+
+    /* link into pm list */
+    if (type != OP_TRANS && curstash) {
+	pmop->op_pmnext = HvPMROOT(curstash);
+	HvPMROOT(curstash) = pmop;
+    }
+
+    return (OP*)pmop;
+}
+
+OP *
+pmruntime(op, expr, repl)
+OP *op;
+OP *expr;
+OP *repl;
+{
+    PMOP *pm;
+    LOGOP *rcop;
+
+    if (op->op_type == OP_TRANS)
+	return pmtrans(op, expr, repl);
+
+    pm = (PMOP*)op;
+
+    if (expr->op_type == OP_CONST) {
+	STRLEN plen;
+	SV *pat = ((SVOP*)expr)->op_sv;
+	char *p = SvPV(pat, plen);
+	if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
+	    sv_setpvn(pat, "\\s+", 3);
+	    p = SvPV(pat, plen);
+	    pm->op_pmflags |= PMf_SKIPWHITE;
+	}
+	pm->op_pmregexp = pregcomp(p, p + plen, pm);
+	if (strEQ("\\s+", pm->op_pmregexp->precomp)) 
+	    pm->op_pmflags |= PMf_WHITE;
+	hoistmust(pm);
+	op_free(expr);
+    }
+    else {
+	if (pm->op_pmflags & PMf_KEEP)
+	    expr = newUNOP(OP_REGCMAYBE,0,expr);
+
+	Newz(1101, rcop, 1, LOGOP);
+	rcop->op_type = OP_REGCOMP;
+	rcop->op_ppaddr = ppaddr[OP_REGCOMP];
+	rcop->op_first = scalar(expr);
+	rcop->op_flags |= OPf_KIDS;
+	rcop->op_private = 1;
+	rcop->op_other = op;
+
+	/* establish postfix order */
+	if (pm->op_pmflags & PMf_KEEP) {
+	    LINKLIST(expr);
+	    rcop->op_next = expr;
+	    ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
+	}
+	else {
+	    rcop->op_next = LINKLIST(expr);
+	    expr->op_next = (OP*)rcop;
+	}
+
+	prepend_elem(op->op_type, scalar((OP*)rcop), op);
+    }
+
+    if (repl) {
+	OP *curop;
+	if (pm->op_pmflags & PMf_EVAL)
+	    curop = 0;
+	else if (repl->op_type == OP_CONST)
+	    curop = repl;
+	else {
+	    OP *lastop = 0;
+	    for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
+		if (opargs[curop->op_type] & OA_DANGEROUS) {
+		    if (curop->op_type == OP_GV) {
+			GV *gv = ((GVOP*)curop)->op_gv;
+			if (strchr("&`'123456789+", *GvENAME(gv)))
+			    break;
+		    }
+		    else if (curop->op_type == OP_RV2CV)
+			break;
+		    else if (curop->op_type == OP_RV2SV ||
+			     curop->op_type == OP_RV2AV ||
+			     curop->op_type == OP_RV2HV ||
+			     curop->op_type == OP_RV2GV) {
+			if (lastop && lastop->op_type != OP_GV)	/*funny deref?*/
+			    break;
+		    }
+		    else if (curop->op_type == OP_PADSV ||
+			     curop->op_type == OP_PADAV ||
+			     curop->op_type == OP_PADHV ||
+			     curop->op_type == OP_PADANY) {
+			     /* is okay */
+		    }
+		    else
+			break;
+		}
+		lastop = curop;
+	    }
+	}
+	if (curop == repl) {
+	    pm->op_pmflags |= PMf_CONST;	/* const for long enough */
+	    pm->op_pmpermflags |= PMf_CONST;	/* const for long enough */
+	    prepend_elem(op->op_type, scalar(repl), op);
+	}
+	else {
+	    Newz(1101, rcop, 1, LOGOP);
+	    rcop->op_type = OP_SUBSTCONT;
+	    rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
+	    rcop->op_first = scalar(repl);
+	    rcop->op_flags |= OPf_KIDS;
+	    rcop->op_private = 1;
+	    rcop->op_other = op;
+
+	    /* establish postfix order */
+	    rcop->op_next = LINKLIST(repl);
+	    repl->op_next = (OP*)rcop;
+
+	    pm->op_pmreplroot = scalar((OP*)rcop);
+	    pm->op_pmreplstart = LINKLIST(rcop);
+	    rcop->op_next = 0;
+	}
+    }
+
+    return (OP*)pm;
+}
+
+OP *
+newSVOP(type, flags, sv)
+I32 type;
+I32 flags;
+SV *sv;
+{
+    SVOP *svop;
+    Newz(1101, svop, 1, SVOP);
+    svop->op_type = type;
+    svop->op_ppaddr = ppaddr[type];
+    svop->op_sv = sv;
+    svop->op_next = (OP*)svop;
+    svop->op_flags = flags;
+    if (opargs[type] & OA_RETSCALAR)
+	scalar((OP*)svop);
+    if (opargs[type] & OA_TARGET)
+	svop->op_targ = pad_alloc(type, SVs_PADTMP);
+    return CHECKOP(type, svop);
+}
+
+OP *
+newGVOP(type, flags, gv)
+I32 type;
+I32 flags;
+GV *gv;
+{
+    GVOP *gvop;
+    Newz(1101, gvop, 1, GVOP);
+    gvop->op_type = type;
+    gvop->op_ppaddr = ppaddr[type];
+    gvop->op_gv = (GV*)SvREFCNT_inc(gv);
+    gvop->op_next = (OP*)gvop;
+    gvop->op_flags = flags;
+    if (opargs[type] & OA_RETSCALAR)
+	scalar((OP*)gvop);
+    if (opargs[type] & OA_TARGET)
+	gvop->op_targ = pad_alloc(type, SVs_PADTMP);
+    return CHECKOP(type, gvop);
+}
+
+OP *
+newPVOP(type, flags, pv)
+I32 type;
+I32 flags;
+char *pv;
+{
+    PVOP *pvop;
+    Newz(1101, pvop, 1, PVOP);
+    pvop->op_type = type;
+    pvop->op_ppaddr = ppaddr[type];
+    pvop->op_pv = pv;
+    pvop->op_next = (OP*)pvop;
+    pvop->op_flags = flags;
+    if (opargs[type] & OA_RETSCALAR)
+	scalar((OP*)pvop);
+    if (opargs[type] & OA_TARGET)
+	pvop->op_targ = pad_alloc(type, SVs_PADTMP);
+    return CHECKOP(type, pvop);
+}
+
+void
+package(op)
+OP *op;
+{
+    SV *sv;
+
+    save_hptr(&curstash);
+    save_item(curstname);
+    if (op) {
+	STRLEN len;
+	char *name;
+	sv = cSVOP->op_sv;
+	name = SvPV(sv, len);
+	curstash = gv_stashpv(name,TRUE);
+	sv_setpvn(curstname, name, len);
+	op_free(op);
+    }
+    else {
+	sv_setpv(curstname,"<none>");
+	curstash = Nullhv;
+    }
+    copline = NOLINE;
+    expect = XSTATE;
+}
+
+void
+utilize(aver, floor, id, arg)
+int aver;
+I32 floor;
+OP *id;
+OP *arg;
+{
+    OP *pack;
+    OP *meth;
+    OP *rqop;
+    OP *imop;
+
+    if (id->op_type != OP_CONST)
+	croak("Module name must be constant");
+
+    /* Fake up an import/unimport */
+    if (arg && arg->op_type == OP_STUB)
+	imop = arg;		/* no import on explicit () */
+    else {
+	/* Make copy of id so we don't free it twice */
+	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
+
+	meth = newSVOP(OP_CONST, 0,
+	    aver
+		? newSVpv("import", 6)
+		: newSVpv("unimport", 8)
+	    );
+	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
+		    append_elem(OP_LIST,
+			prepend_elem(OP_LIST, pack, list(arg)),
+			newUNOP(OP_METHOD, 0, meth)));
+    }
+
+    /* Fake up a require */
+    rqop = newUNOP(OP_REQUIRE, 0, id);
+
+    /* Fake up the BEGIN {}, which does its thing immediately. */
+    newSUB(floor,
+	newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
+	Nullop,
+	append_elem(OP_LINESEQ,
+	    newSTATEOP(0, Nullch, rqop),
+	    newSTATEOP(0, Nullch, imop) ));
+
+    copline = NOLINE;
+    expect = XSTATE;
+}
+
+OP *
+newSLICEOP(flags, subscript, listval)
+I32 flags;
+OP *subscript;
+OP *listval;
+{
+    return newBINOP(OP_LSLICE, flags,
+	    list(force_list(subscript)),
+	    list(force_list(listval)) );
+}
+
+static I32
+list_assignment(op)
+register OP *op;
+{
+    if (!op)
+	return TRUE;
+
+    if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
+	op = cUNOP->op_first;
+
+    if (op->op_type == OP_COND_EXPR) {
+	I32 t = list_assignment(cCONDOP->op_first->op_sibling);
+	I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
+
+	if (t && f)
+	    return TRUE;
+	if (t || f)
+	    yyerror("Assignment to both a list and a scalar");
+	return FALSE;
+    }
+
+    if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
+	op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
+	op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
+	return TRUE;
+
+    if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
+	return TRUE;
+
+    if (op->op_type == OP_RV2SV)
+	return FALSE;
+
+    return FALSE;
+}
+
+OP *
+newASSIGNOP(flags, left, optype, right)
+I32 flags;
+OP *left;
+I32 optype;
+OP *right;
+{
+    OP *op;
+
+    if (optype) {
+	if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
+	    return newLOGOP(optype, 0,
+		mod(scalar(left), optype),
+		newUNOP(OP_SASSIGN, 0, scalar(right)));
+	}
+	else {
+	    return newBINOP(optype, OPf_STACKED,
+		mod(scalar(left), optype), scalar(right));
+	}
+    }
+
+    if (list_assignment(left)) {
+	modcount = 0;
+	eval_start = right;	/* Grandfathering $[ assignment here.  Bletch.*/
+	left = mod(left, OP_AASSIGN);
+	if (eval_start)
+	    eval_start = 0;
+	else {
+	    op_free(left);
+	    op_free(right);
+	    return Nullop;
+	}
+	op = newBINOP(OP_AASSIGN, flags,
+		list(force_list(right)),
+		list(force_list(left)) );
+	op->op_private = 0 | (flags >> 8);
+	if (!(left->op_private & OPpLVAL_INTRO)) {
+	    static int generation = 100;
+	    OP *curop;
+	    OP *lastop = op;
+	    generation++;
+	    for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
+		if (opargs[curop->op_type] & OA_DANGEROUS) {
+		    if (curop->op_type == OP_GV) {
+			GV *gv = ((GVOP*)curop)->op_gv;
+			if (gv == defgv || SvCUR(gv) == generation)
+			    break;
+			SvCUR(gv) = generation;
+		    }
+		    else if (curop->op_type == OP_PADSV ||
+			     curop->op_type == OP_PADAV ||
+			     curop->op_type == OP_PADHV ||
+			     curop->op_type == OP_PADANY) {
+			SV **svp = AvARRAY(comppad_name);
+			SV *sv = svp[curop->op_targ];
+			if (SvCUR(sv) == generation)
+			    break;
+			SvCUR(sv) = generation;	/* (SvCUR not used any more) */
+		    }
+		    else if (curop->op_type == OP_RV2CV)
+			break;
+		    else if (curop->op_type == OP_RV2SV ||
+			     curop->op_type == OP_RV2AV ||
+			     curop->op_type == OP_RV2HV ||
+			     curop->op_type == OP_RV2GV) {
+			if (lastop->op_type != OP_GV)	/* funny deref? */
+			    break;
+		    }
+		    else
+			break;
+		}
+		lastop = curop;
+	    }
+	    if (curop != op)
+		op->op_private = OPpASSIGN_COMMON;
+	}
+	if (right && right->op_type == OP_SPLIT) {
+	    OP* tmpop;
+	    if ((tmpop = ((LISTOP*)right)->op_first) &&
+		tmpop->op_type == OP_PUSHRE)
+	    {
+		PMOP *pm = (PMOP*)tmpop;
+		if (left->op_type == OP_RV2AV &&
+		    !(left->op_private & OPpLVAL_INTRO) &&
+		    !(op->op_private & OPpASSIGN_COMMON) )
+		{
+		    tmpop = ((UNOP*)left)->op_first;
+		    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
+			pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
+			pm->op_pmflags |= PMf_ONCE;
+			tmpop = ((UNOP*)op)->op_first;	/* to list (nulled) */
+			tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
+			tmpop->op_sibling = Nullop;	/* don't free split */
+			right->op_next = tmpop->op_next;  /* fix starting loc */
+			op_free(op);			/* blow off assign */
+			right->op_flags &= ~(OPf_KNOW|OPf_LIST);
+				/* "I don't know and I don't care." */
+			return right;
+		    }
+		}
+		else {
+		    if (modcount < 10000 &&
+		      ((LISTOP*)right)->op_last->op_type == OP_CONST)
+		    {
+			SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+			if (SvIVX(sv) == 0)
+			    sv_setiv(sv, modcount+1);
+		    }
+		}
+	    }
+	}
+	return op;
+    }
+    if (!right)
+	right = newOP(OP_UNDEF, 0);
+    if (right->op_type == OP_READLINE) {
+	right->op_flags |= OPf_STACKED;
+	return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
+    }
+    else {
+	eval_start = right;	/* Grandfathering $[ assignment here.  Bletch.*/
+	op = newBINOP(OP_SASSIGN, flags,
+	    scalar(right), mod(scalar(left), OP_SASSIGN) );
+	if (eval_start)
+	    eval_start = 0;
+	else {
+	    op_free(op);
+	    return Nullop;
+	}
+    }
+    return op;
+}
+
+OP *
+newSTATEOP(flags, label, op)
+I32 flags;
+char *label;
+OP *op;
+{
+    register COP *cop;
+
+    /* Introduce my variables. */
+    if (min_intro_pending) {
+	SV **svp = AvARRAY(comppad_name);
+	I32 i;
+	SV *sv;
+	for (i = min_intro_pending; i <= max_intro_pending; i++) {
+	    if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
+		SvIVX(sv) = 999999999;	/* Don't know scope end yet. */
+		SvNVX(sv) = (double)cop_seqmax;
+	    }
+	}
+	min_intro_pending = 0;
+	comppad_name_fill = max_intro_pending;	/* Needn't search higher */
+    }
+
+    Newz(1101, cop, 1, COP);
+    if (perldb && curcop->cop_line && curstash != debstash) {
+	cop->op_type = OP_DBSTATE;
+	cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
+    }
+    else {
+	cop->op_type = OP_NEXTSTATE;
+	cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
+    }
+    cop->op_flags = flags;
+    cop->op_private = 0 | (flags >> 8);
+    cop->op_next = (OP*)cop;
+
+    if (label) {
+	cop->cop_label = label;
+	hints |= HINT_BLOCK_SCOPE;
+    }
+    cop->cop_seq = cop_seqmax++;
+    cop->cop_arybase = curcop->cop_arybase;
+
+    if (copline == NOLINE)
+        cop->cop_line = curcop->cop_line;
+    else {
+        cop->cop_line = copline;
+        copline = NOLINE;
+    }
+    cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
+    cop->cop_stash = curstash;
+
+    if (perldb && curstash != debstash) {
+	SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+	if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
+	    (void)SvIOK_on(*svp);
+	    SvIVX(*svp) = 1;
+	    SvSTASH(*svp) = (HV*)cop;
+	}
+    }
+
+    return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+}
+
+OP *
+newLOGOP(type, flags, first, other)
+I32 type;
+I32 flags;
+OP* first;
+OP* other;
+{
+    LOGOP *logop;
+    OP *op;
+
+    if (type == OP_XOR)		/* Not short circuit, but here by precedence. */
+	return newBINOP(type, flags, scalar(first), scalar(other));
+
+    scalarboolean(first);
+    /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+    if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
+	if (type == OP_AND || type == OP_OR) {
+	    if (type == OP_AND)
+		type = OP_OR;
+	    else
+		type = OP_AND;
+	    op = first;
+	    first = cUNOP->op_first;
+	    if (op->op_next)
+		first->op_next = op->op_next;
+	    cUNOP->op_first = Nullop;
+	    op_free(op);
+	}
+    }
+    if (first->op_type == OP_CONST) {
+	if (dowarn && (first->op_private & OPpCONST_BARE))
+	    warn("Probable precedence problem on %s", op_desc[type]);
+	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
+	    op_free(first);
+	    return other;
+	}
+	else {
+	    op_free(other);
+	    return first;
+	}
+    }
+    else if (first->op_type == OP_WANTARRAY) {
+	if (type == OP_AND)
+	    list(other);
+	else
+	    scalar(other);
+    }
+
+    if (!other)
+	return first;
+
+    if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
+	other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
+
+    Newz(1101, logop, 1, LOGOP);
+
+    logop->op_type = type;
+    logop->op_ppaddr = ppaddr[type];
+    logop->op_first = first;
+    logop->op_flags = flags | OPf_KIDS;
+    logop->op_other = LINKLIST(other);
+    logop->op_private = 1 | (flags >> 8);
+
+    /* establish postfix order */
+    logop->op_next = LINKLIST(first);
+    first->op_next = (OP*)logop;
+    first->op_sibling = other;
+
+    op = newUNOP(OP_NULL, 0, (OP*)logop);
+    other->op_next = op;
+
+    return op;
+}
+
+OP *
+newCONDOP(flags, first, true, false)
+I32 flags;
+OP* first;
+OP* true;
+OP* false;
+{
+    CONDOP *condop;
+    OP *op;
+
+    if (!false)
+	return newLOGOP(OP_AND, 0, first, true);
+    if (!true)
+	return newLOGOP(OP_OR, 0, first, false);
+
+    scalarboolean(first);
+    if (first->op_type == OP_CONST) {
+	if (SvTRUE(((SVOP*)first)->op_sv)) {
+	    op_free(first);
+	    op_free(false);
+	    return true;
+	}
+	else {
+	    op_free(first);
+	    op_free(true);
+	    return false;
+	}
+    }
+    else if (first->op_type == OP_WANTARRAY) {
+	list(true);
+	scalar(false);
+    }
+    Newz(1101, condop, 1, CONDOP);
+
+    condop->op_type = OP_COND_EXPR;
+    condop->op_ppaddr = ppaddr[OP_COND_EXPR];
+    condop->op_first = first;
+    condop->op_flags = flags | OPf_KIDS;
+    condop->op_true = LINKLIST(true);
+    condop->op_false = LINKLIST(false);
+    condop->op_private = 1 | (flags >> 8);
+
+    /* establish postfix order */
+    condop->op_next = LINKLIST(first);
+    first->op_next = (OP*)condop;
+
+    first->op_sibling = true;
+    true->op_sibling = false;
+    op = newUNOP(OP_NULL, 0, (OP*)condop);
+
+    true->op_next = op;
+    false->op_next = op;
+
+    return op;
+}
+
+OP *
+newRANGE(flags, left, right)
+I32 flags;
+OP *left;
+OP *right;
+{
+    CONDOP *condop;
+    OP *flip;
+    OP *flop;
+    OP *op;
+
+    Newz(1101, condop, 1, CONDOP);
+
+    condop->op_type = OP_RANGE;
+    condop->op_ppaddr = ppaddr[OP_RANGE];
+    condop->op_first = left;
+    condop->op_flags = OPf_KIDS;
+    condop->op_true = LINKLIST(left);
+    condop->op_false = LINKLIST(right);
+    condop->op_private = 1 | (flags >> 8);
+
+    left->op_sibling = right;
+
+    condop->op_next = (OP*)condop;
+    flip = newUNOP(OP_FLIP, flags, (OP*)condop);
+    flop = newUNOP(OP_FLOP, 0, flip);
+    op = newUNOP(OP_NULL, 0, flop);
+    linklist(flop);
+
+    left->op_next = flip;
+    right->op_next = flop;
+
+    condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
+    flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
+    sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
+
+    flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
+    flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
+
+    flip->op_next = op;
+    if (!flip->op_private || !flop->op_private)
+	linklist(op);		/* blow off optimizer unless constant */
+
+    return op;
+}
+
+OP *
+newLOOPOP(flags, debuggable, expr, block)
+I32 flags;
+I32 debuggable;
+OP *expr;
+OP *block;
+{
+    OP* listop;
+    OP* op;
+    int once = block && block->op_flags & OPf_SPECIAL &&
+      (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
+
+    if (expr) {
+	if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
+	    return block;	/* do {} while 0 does once */
+	else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
+	    expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
+    }
+
+    listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
+    op = newLOGOP(OP_AND, 0, expr, listop);
+
+    ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
+
+    if (once && op != listop)
+	op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
+
+    if (op == listop)
+	op = newUNOP(OP_NULL, 0, op);	/* or do {} while 1 loses outer block */
+
+    op->op_flags |= flags;
+    op = scope(op);
+    op->op_flags |= OPf_SPECIAL;	/* suppress POPBLOCK curpm restoration*/
+    return op;
+}
+
+OP *
+newWHILEOP(flags, debuggable, loop, expr, block, cont)
+I32 flags;
+I32 debuggable;
+LOOP *loop;
+OP *expr;
+OP *block;
+OP *cont;
+{
+    OP *redo;
+    OP *next = 0;
+    OP *listop;
+    OP *op;
+    OP *condop;
+
+    if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
+	expr = newUNOP(OP_DEFINED, 0,
+	    newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+    }
+
+    if (!block)
+	block = newOP(OP_NULL, 0);
+
+    if (cont)
+	next = LINKLIST(cont);
+    if (expr)
+	cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+
+    listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
+    redo = LINKLIST(listop);
+
+    if (expr) {
+	op = newLOGOP(OP_AND, 0, expr, scalar(listop));
+	if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
+	    op_free(expr);		/* oops, it's a while (0) */
+	    op_free((OP*)loop);
+	    return Nullop;		/* (listop already freed by newLOGOP) */
+	}
+	((LISTOP*)listop)->op_last->op_next = condop = 
+	    (op == listop ? redo : LINKLIST(op));
+	if (!next)
+	    next = condop;
+    }
+    else
+	op = listop;
+
+    if (!loop) {
+	Newz(1101,loop,1,LOOP);
+	loop->op_type = OP_ENTERLOOP;
+	loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
+	loop->op_private = 0;
+	loop->op_next = (OP*)loop;
+    }
+
+    op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
+
+    loop->op_redoop = redo;
+    loop->op_lastop = op;
+
+    if (next)
+	loop->op_nextop = next;
+    else
+	loop->op_nextop = op;
+
+    op->op_flags |= flags;
+    op->op_private |= (flags >> 8);
+    return op;
+}
+
+OP *
+#ifndef CAN_PROTOTYPE
+newFOROP(flags,label,forline,sv,expr,block,cont)
+I32 flags;
+char *label;
+line_t forline;
+OP* sv;
+OP* expr;
+OP*block;
+OP*cont;
+#else
+newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
+#endif /* CAN_PROTOTYPE */
+{
+    LOOP *loop;
+    int padoff = 0;
+    I32 iterflags = 0;
+
+    copline = forline;
+    if (sv) {
+	if (sv->op_type == OP_RV2SV) {	/* symbol table variable */
+	    sv->op_type = OP_RV2GV;
+	    sv->op_ppaddr = ppaddr[OP_RV2GV];
+	}
+	else if (sv->op_type == OP_PADSV) { /* private variable */
+	    padoff = sv->op_targ;
+	    op_free(sv);
+	    sv = Nullop;
+	}
+	else
+	    croak("Can't use %s for loop variable", op_desc[sv->op_type]);
+    }
+    else {
+	sv = newGVOP(OP_GV, 0, defgv);
+    }
+    if (expr->op_type == OP_RV2AV) {
+	expr = scalar(ref(expr, OP_ITER));
+	iterflags |= OPf_STACKED;
+    }
+    loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
+	append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
+		    scalar(sv))));
+    assert(!loop->op_next);
+    Renew(loop, 1, LOOP);
+    loop->op_targ = padoff;
+    return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
+	newOP(OP_ITER, 0), block, cont));
+}
+
+OP*
+newLOOPEX(type, label)
+I32 type;
+OP* label;
+{
+    OP *op;
+    if (type != OP_GOTO || label->op_type == OP_CONST) {
+	op = newPVOP(type, 0, savepv(
+		label->op_type == OP_CONST
+		    ? SvPVx(((SVOP*)label)->op_sv, na)
+		    : "" ));
+	op_free(label);
+    }
+    else {
+	if (label->op_type == OP_ENTERSUB)
+	    label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
+	op = newUNOP(type, OPf_STACKED, label);
+    }
+    hints |= HINT_BLOCK_SCOPE;
+    return op;
+}
+
+void
+cv_undef(cv)
+CV *cv;
+{
+    if (!CvXSUB(cv) && CvROOT(cv)) {
+	if (CvDEPTH(cv))
+	    croak("Can't undef active subroutine");
+	ENTER;
+
+	SAVESPTR(curpad);
+	curpad = 0;
+
+	if (!CvCLONED(cv))
+	    op_free(CvROOT(cv));
+	CvROOT(cv) = Nullop;
+	LEAVE;
+    }
+    SvREFCNT_dec(CvGV(cv));
+    CvGV(cv) = Nullgv;
+    SvREFCNT_dec(CvOUTSIDE(cv));
+    CvOUTSIDE(cv) = Nullcv;
+    if (CvPADLIST(cv)) {
+	I32 i = AvFILL(CvPADLIST(cv));
+	while (i >= 0) {
+	    SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
+	    if (svp)
+		SvREFCNT_dec(*svp);
+	}
+	SvREFCNT_dec((SV*)CvPADLIST(cv));
+	CvPADLIST(cv) = Nullav;
+    }
+}
+
+CV *
+cv_clone(proto)
+CV* proto;
+{
+    AV* av;
+    I32 ix;
+    AV* protopadlist = CvPADLIST(proto);
+    AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
+    AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+    SV** svp = AvARRAY(protopad);
+    AV* comppadlist;
+    CV* cv;
+
+    ENTER;
+    SAVESPTR(curpad);
+    SAVESPTR(comppad);
+    SAVESPTR(compcv);
+
+    cv = compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)cv, SVt_PVCV);
+    CvCLONED_on(cv);
+
+    CvFILEGV(cv)	= CvFILEGV(proto);
+    CvGV(cv)		= SvREFCNT_inc(CvGV(proto));
+    CvSTASH(cv)		= CvSTASH(proto);
+    CvROOT(cv)		= CvROOT(proto);
+    CvSTART(cv)		= CvSTART(proto);
+    if (CvOUTSIDE(proto))
+	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
+
+    comppad = newAV();
+
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
+    av_store(comppadlist, 1, (SV*)comppad);
+    CvPADLIST(cv) = comppadlist;
+    av_extend(comppad, AvFILL(protopad));
+    curpad = AvARRAY(comppad);
+
+    av = newAV();           /* will be @_ */
+    av_extend(av, 0);
+    av_store(comppad, 0, (SV*)av);
+    AvFLAGS(av) = AVf_REIFY;
+
+    svp = AvARRAY(protopad_name);
+    for ( ix = AvFILL(protopad); ix > 0; ix--) {
+	SV *sv;
+	if (svp[ix] != &sv_undef) {
+	    char *name = SvPVX(svp[ix]);    /* XXX */
+	    if (SvFLAGS(svp[ix]) & SVf_FAKE) {	/* lexical from outside? */
+		I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
+					cxstack_ix);
+		if (off != ix)
+		    croak("panic: cv_clone: %s", name);
+	    }
+	    else {				/* our own lexical */
+		if (*name == '@')
+		    av_store(comppad, ix, sv = (SV*)newAV());
+		else if (*name == '%')
+		    av_store(comppad, ix, sv = (SV*)newHV());
+		else
+		    av_store(comppad, ix, sv = NEWSV(0,0));
+		SvPADMY_on(sv);
+	    }
+	}
+	else {
+	    av_store(comppad, ix, sv = NEWSV(0,0));
+	    SvPADTMP_on(sv);
+	}
+    }
+
+    LEAVE;
+    return cv;
+}
+
+CV *
+newSUB(floor,op,proto,block)
+I32 floor;
+OP *op;
+OP *proto;
+OP *block;
+{
+    register CV *cv;
+    char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
+    GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
+    AV* av;
+    char *s;
+    I32 ix;
+
+    if (op)
+	sub_generation++;
+    if (cv = GvCV(gv)) {
+	if (GvCVGEN(gv))
+	    cv = 0;			/* just a cached method */
+	else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
+	    if (dowarn) {		/* already defined (or promised)? */
+		line_t oldline = curcop->cop_line;
+
+		curcop->cop_line = copline;
+		warn("Subroutine %s redefined",name);
+		curcop->cop_line = oldline;
+	    }
+	    SvREFCNT_dec(cv);
+	    cv = 0;
+	}
+    }
+    if (cv) {				/* must reuse cv if autoloaded */
+	cv_undef(cv);
+	CvOUTSIDE(cv) = CvOUTSIDE(compcv);
+	CvOUTSIDE(compcv) = 0;
+	CvPADLIST(cv) = CvPADLIST(compcv);
+	CvPADLIST(compcv) = 0;
+	if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
+	    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+	SvREFCNT_dec(compcv);
+    }
+    else {
+	cv = compcv;
+    }
+    GvCV(gv) = cv;
+    GvCVGEN(gv) = 0;
+    CvFILEGV(cv) = curcop->cop_filegv;
+    CvGV(cv) = SvREFCNT_inc(gv);
+    CvSTASH(cv) = curstash;
+
+    if (proto) {
+	char *p = SvPVx(((SVOP*)proto)->op_sv, na);
+	if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
+	    warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
+	sv_setpv((SV*)cv, p);
+	op_free(proto);
+    }
+
+    if (error_count) {
+	op_free(block);
+	block = Nullop;
+    }
+    if (!block) {
+	CvROOT(cv) = 0;
+	op_free(op);
+	copline = NOLINE;
+	LEAVE_SCOPE(floor);
+	return cv;
+    }
+
+    av = newAV();			/* Will be @_ */
+    av_extend(av, 0);
+    av_store(comppad, 0, (SV*)av);
+    AvFLAGS(av) = AVf_REIFY;
+
+    for (ix = AvFILL(comppad); ix > 0; ix--) {
+	if (!SvPADMY(curpad[ix]))
+	    SvPADTMP_on(curpad[ix]);
+    }
+
+    if (AvFILL(comppad_name) < AvFILL(comppad))
+	av_store(comppad_name, AvFILL(comppad), Nullsv);
+
+    CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
+    CvSTART(cv) = LINKLIST(CvROOT(cv));
+    CvROOT(cv)->op_next = 0;
+    peep(CvSTART(cv));
+    if (s = strrchr(name,':'))
+	s++;
+    else
+	s = name;
+    if (strEQ(s, "BEGIN") && !error_count) {
+	line_t oldline = compiling.cop_line;
+	SV *oldrs = rs;
+
+	ENTER;
+	SAVESPTR(compiling.cop_filegv);
+	SAVEI32(perldb);
+	if (!beginav)
+	    beginav = newAV();
+	av_push(beginav, (SV *)cv);
+	DEBUG_x( dump_sub(gv) );
+	rs = SvREFCNT_inc(nrs);
+	GvCV(gv) = 0;
+	calllist(beginav);
+	SvREFCNT_dec(rs);
+	rs = oldrs;
+	curcop = &compiling;
+	curcop->cop_line = oldline;	/* might have recursed to yylex */
+	LEAVE;
+    }
+    else if (strEQ(s, "END") && !error_count) {
+	if (!endav)
+	    endav = newAV();
+	av_unshift(endav, 1);
+	av_store(endav, 0, SvREFCNT_inc(cv));
+    }
+    if (perldb && curstash != debstash) {
+	SV *sv;
+	SV *tmpstr = sv_newmortal();
+
+	sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
+	sv = newSVpv(buf,0);
+	sv_catpv(sv,"-");
+	sprintf(buf,"%ld",(long)curcop->cop_line);
+	sv_catpv(sv,buf);
+	gv_efullname(tmpstr,gv);
+	hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+    }
+    op_free(op);
+    copline = NOLINE;
+    LEAVE_SCOPE(floor);
+    if (!op) {
+	GvCV(gv) = 0;	/* Will remember in SVOP instead. */
+	CvANON_on(cv);
+    }
+    return cv;
+}
+
+#ifdef DEPRECATED
+CV *
+newXSUB(name, ix, subaddr, filename)
+char *name;
+I32 ix;
+I32 (*subaddr)();
+char *filename;
+{
+    CV* cv = newXS(name, (void(*)())subaddr, filename);
+    CvOLDSTYLE_on(cv);
+    CvXSUBANY(cv).any_i32 = ix;
+    return cv;
+}
+#endif
+
+CV *
+newXS(name, subaddr, filename)
+char *name;
+void (*subaddr) _((CV*));
+char *filename;
+{
+    register CV *cv;
+    GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
+    char *s;
+
+    if (name)
+	sub_generation++;
+    if (cv = GvCV(gv)) {
+	if (GvCVGEN(gv))
+	    cv = 0;			/* just a cached method */
+	else if (CvROOT(cv) || CvXSUB(cv)) {	/* already defined? */
+	    if (dowarn) {
+		line_t oldline = curcop->cop_line;
+
+		curcop->cop_line = copline;
+		warn("Subroutine %s redefined",name);
+		curcop->cop_line = oldline;
+	    }
+	    SvREFCNT_dec(cv);
+	    cv = 0;
+	}
+    }
+    if (cv) {				/* must reuse cv if autoloaded */
+	assert(SvREFCNT(CvGV(cv)) > 1);
+	SvREFCNT_dec(CvGV(cv));
+    }
+    else {
+	cv = (CV*)NEWSV(1105,0);
+	sv_upgrade((SV *)cv, SVt_PVCV);
+    }
+    GvCV(gv) = cv;
+    CvGV(cv) = SvREFCNT_inc(gv);
+    GvCVGEN(gv) = 0;
+    CvFILEGV(cv) = gv_fetchfile(filename);
+    CvXSUB(cv) = subaddr;
+    if (!name)
+	s = "__ANON__";
+    else if (s = strrchr(name,':'))
+	s++;
+    else
+	s = name;
+    if (strEQ(s, "BEGIN")) {
+	if (!beginav)
+	    beginav = newAV();
+	av_push(beginav, SvREFCNT_inc(gv));
+    }
+    else if (strEQ(s, "END")) {
+	if (!endav)
+	    endav = newAV();
+	av_unshift(endav, 1);
+	av_store(endav, 0, SvREFCNT_inc(gv));
+    }
+    if (!name) {
+	GvCV(gv) = 0;	/* Will remember elsewhere instead. */
+	CvANON_on(cv);
+    }
+    return cv;
+}
+
+void
+newFORM(floor,op,block)
+I32 floor;
+OP *op;
+OP *block;
+{
+    register CV *cv;
+    char *name;
+    GV *gv;
+    I32 ix;
+
+    if (op)
+	name = SvPVx(cSVOP->op_sv, na);
+    else
+	name = "STDOUT";
+    gv = gv_fetchpv(name,TRUE, SVt_PVFM);
+    GvMULTI_on(gv);
+    if (cv = GvFORM(gv)) {
+	if (dowarn) {
+	    line_t oldline = curcop->cop_line;
+
+	    curcop->cop_line = copline;
+	    warn("Format %s redefined",name);
+	    curcop->cop_line = oldline;
+	}
+	SvREFCNT_dec(cv);
+    }
+    cv = compcv;
+    GvFORM(gv) = cv;
+    CvGV(cv) = SvREFCNT_inc(gv);
+    CvFILEGV(cv) = curcop->cop_filegv;
+
+    for (ix = AvFILL(comppad); ix > 0; ix--) {
+	if (!SvPADMY(curpad[ix]))
+	    SvPADTMP_on(curpad[ix]);
+    }
+
+    CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
+    CvSTART(cv) = LINKLIST(CvROOT(cv));
+    CvROOT(cv)->op_next = 0;
+    peep(CvSTART(cv));
+    FmLINES(cv) = 0;
+    op_free(op);
+    copline = NOLINE;
+    LEAVE_SCOPE(floor);
+}
+
+OP *
+newANONLIST(op)
+OP* op;
+{
+    return newUNOP(OP_REFGEN, 0,
+	mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
+}
+
+OP *
+newANONHASH(op)
+OP* op;
+{
+    return newUNOP(OP_REFGEN, 0,
+	mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
+}
+
+OP *
+newANONSUB(floor, proto, block)
+I32 floor;
+OP *proto;
+OP *block;
+{
+    return newUNOP(OP_REFGEN, 0,
+	newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
+}
+
+OP *
+oopsAV(o)
+OP *o;
+{
+    switch (o->op_type) {
+    case OP_PADSV:
+	o->op_type = OP_PADAV;
+	o->op_ppaddr = ppaddr[OP_PADAV];
+	return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
+	
+    case OP_RV2SV:
+	o->op_type = OP_RV2AV;
+	o->op_ppaddr = ppaddr[OP_RV2AV];
+	ref(o, OP_RV2AV);
+	break;
+
+    default:
+	warn("oops: oopsAV");
+	break;
+    }
+    return o;
+}
+
+OP *
+oopsHV(o)
+OP *o;
+{
+    switch (o->op_type) {
+    case OP_PADSV:
+    case OP_PADAV:
+	o->op_type = OP_PADHV;
+	o->op_ppaddr = ppaddr[OP_PADHV];
+	return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
+
+    case OP_RV2SV:
+    case OP_RV2AV:
+	o->op_type = OP_RV2HV;
+	o->op_ppaddr = ppaddr[OP_RV2HV];
+	ref(o, OP_RV2HV);
+	break;
+
+    default:
+	warn("oops: oopsHV");
+	break;
+    }
+    return o;
+}
+
+OP *
+newAVREF(o)
+OP *o;
+{
+    if (o->op_type == OP_PADANY) {
+	o->op_type = OP_PADAV;
+	o->op_ppaddr = ppaddr[OP_PADAV];
+	return o;
+    }
+    return newUNOP(OP_RV2AV, 0, scalar(o));
+}
+
+OP *
+newGVREF(type,o)
+I32 type;
+OP *o;
+{
+    if (type == OP_MAPSTART)
+	return newUNOP(OP_NULL, 0, o);
+    return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
+}
+
+OP *
+newHVREF(o)
+OP *o;
+{
+    if (o->op_type == OP_PADANY) {
+	o->op_type = OP_PADHV;
+	o->op_ppaddr = ppaddr[OP_PADHV];
+	return o;
+    }
+    return newUNOP(OP_RV2HV, 0, scalar(o));
+}
+
+OP *
+oopsCV(o)
+OP *o;
+{
+    croak("NOT IMPL LINE %d",__LINE__);
+    /* STUB */
+    return o;
+}
+
+OP *
+newCVREF(flags, o)
+I32 flags;
+OP *o;
+{
+    return newUNOP(OP_RV2CV, flags, scalar(o));
+}
+
+OP *
+newSVREF(o)
+OP *o;
+{
+    if (o->op_type == OP_PADANY) {
+	o->op_type = OP_PADSV;
+	o->op_ppaddr = ppaddr[OP_PADSV];
+	return o;
+    }
+    return newUNOP(OP_RV2SV, 0, scalar(o));
+}
+
+/* Check routines. */
+
+OP *
+ck_concat(op)
+OP *op;
+{
+    if (cUNOP->op_first->op_type == OP_CONCAT)
+	op->op_flags |= OPf_STACKED;
+    return op;
+}
+
+OP *
+ck_spair(op)
+OP *op;
+{
+    if (op->op_flags & OPf_KIDS) {
+	OP* newop;
+	OP* kid;
+	op = modkids(ck_fun(op), op->op_type);
+	kid = cUNOP->op_first;
+	newop = kUNOP->op_first->op_sibling;
+	if (newop &&
+	    (newop->op_sibling ||
+	     !(opargs[newop->op_type] & OA_RETSCALAR) ||
+	     newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
+	     newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
+	    
+	    return op;
+	}
+	op_free(kUNOP->op_first);
+	kUNOP->op_first = newop;
+    }
+    op->op_ppaddr = ppaddr[++op->op_type];
+    return ck_fun(op);
+}
+
+OP *
+ck_delete(op)
+OP *op;
+{
+    op = ck_fun(op);
+    if (op->op_flags & OPf_KIDS) {
+	OP *kid = cUNOP->op_first;
+	if (kid->op_type != OP_HELEM)
+	    croak("%s argument is not a HASH element", op_desc[op->op_type]);
+	null(kid);
+    }
+    return op;
+}
+
+OP *
+ck_eof(op)
+OP *op;
+{
+    I32 type = op->op_type;
+
+    if (op->op_flags & OPf_KIDS) {
+	if (cLISTOP->op_first->op_type == OP_STUB) {
+	    op_free(op);
+	    op = newUNOP(type, OPf_SPECIAL,
+		newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
+	}
+	return ck_fun(op);
+    }
+    return op;
+}
+
+OP *
+ck_eval(op)
+OP *op;
+{
+    hints |= HINT_BLOCK_SCOPE;
+    if (op->op_flags & OPf_KIDS) {
+	SVOP *kid = (SVOP*)cUNOP->op_first;
+
+	if (!kid) {
+	    op->op_flags &= ~OPf_KIDS;
+	    null(op);
+	}
+	else if (kid->op_type == OP_LINESEQ) {
+	    LOGOP *enter;
+
+	    kid->op_next = op->op_next;
+	    cUNOP->op_first = 0;
+	    op_free(op);
+
+	    Newz(1101, enter, 1, LOGOP);
+	    enter->op_type = OP_ENTERTRY;
+	    enter->op_ppaddr = ppaddr[OP_ENTERTRY];
+	    enter->op_private = 0;
+
+	    /* establish postfix order */
+	    enter->op_next = (OP*)enter;
+
+	    op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
+	    op->op_type = OP_LEAVETRY;
+	    op->op_ppaddr = ppaddr[OP_LEAVETRY];
+	    enter->op_other = op;
+	    return op;
+	}
+    }
+    else {
+	op_free(op);
+	op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+    }
+    op->op_targ = (PADOFFSET)hints;
+    return op;
+}
+
+OP *
+ck_exec(op)
+OP *op;
+{
+    OP *kid;
+    if (op->op_flags & OPf_STACKED) {
+	op = ck_fun(op);
+	kid = cUNOP->op_first->op_sibling;
+	if (kid->op_type == OP_RV2GV)
+	    null(kid);
+    }
+    else
+	op = listkids(op);
+    return op;
+}
+
+OP *
+ck_gvconst(o)
+register OP *o;
+{
+    o = fold_constants(o);
+    if (o->op_type == OP_CONST)
+	o->op_type = OP_GV;
+    return o;
+}
+
+OP *
+ck_rvconst(op)
+register OP *op;
+{
+    SVOP *kid = (SVOP*)cUNOP->op_first;
+
+    op->op_private |= (hints & HINT_STRICT_REFS);
+    if (kid->op_type == OP_CONST) {
+	int iscv = (op->op_type==OP_RV2CV)*2;
+	GV *gv = 0;
+	kid->op_type = OP_GV;
+	for (gv = 0; !gv; iscv++) {
+	    /*
+	     * This is a little tricky.  We only want to add the symbol if we
+	     * didn't add it in the lexer.  Otherwise we get duplicate strict
+	     * warnings.  But if we didn't add it in the lexer, we must at
+	     * least pretend like we wanted to add it even if it existed before,
+	     * or we get possible typo warnings.  OPpCONST_ENTERED says
+	     * whether the lexer already added THIS instance of this symbol.
+	     */
+	    gv = gv_fetchpv(SvPVx(kid->op_sv, na),
+		iscv | !(kid->op_private & OPpCONST_ENTERED),
+		iscv
+		    ? SVt_PVCV
+		    : op->op_type == OP_RV2SV
+			? SVt_PV
+			: op->op_type == OP_RV2AV
+			    ? SVt_PVAV
+			    : op->op_type == OP_RV2HV
+				? SVt_PVHV
+				: SVt_PVGV);
+	}
+	SvREFCNT_dec(kid->op_sv);
+	kid->op_sv = SvREFCNT_inc(gv);
+    }
+    return op;
+}
+
+OP *
+ck_formline(op)
+OP *op;
+{
+    return ck_fun(op);
+}
+
+OP *
+ck_ftst(op)
+OP *op;
+{
+    I32 type = op->op_type;
+
+    if (op->op_flags & OPf_REF)
+	return op;
+
+    if (op->op_flags & OPf_KIDS) {
+	SVOP *kid = (SVOP*)cUNOP->op_first;
+
+	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+	    OP *newop = newGVOP(type, OPf_REF,
+		gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
+	    op_free(op);
+	    return newop;
+	}
+    }
+    else {
+	op_free(op);
+	if (type == OP_FTTTY)
+	    return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
+				SVt_PVIO));
+	else
+	    return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+    }
+    return op;
+}
+
+OP *
+ck_fun(op)
+OP *op;
+{
+    register OP *kid;
+    OP **tokid;
+    OP *sibl;
+    I32 numargs = 0;
+    int type = op->op_type;
+    register I32 oa = opargs[type] >> OASHIFT;
+    
+    if (op->op_flags & OPf_STACKED) {
+	if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
+	    oa &= ~OA_OPTIONAL;
+	else
+	    return no_fh_allowed(op);
+    }
+
+    if (op->op_flags & OPf_KIDS) {
+	tokid = &cLISTOP->op_first;
+	kid = cLISTOP->op_first;
+	if (kid->op_type == OP_PUSHMARK ||
+	    kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
+	{
+	    tokid = &kid->op_sibling;
+	    kid = kid->op_sibling;
+	}
+	if (!kid && opargs[type] & OA_DEFGV)
+	    *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
+
+	while (oa && kid) {
+	    numargs++;
+	    sibl = kid->op_sibling;
+	    switch (oa & 7) {
+	    case OA_SCALAR:
+		scalar(kid);
+		break;
+	    case OA_LIST:
+		if (oa < 16) {
+		    kid = 0;
+		    continue;
+		}
+		else
+		    list(kid);
+		break;
+	    case OA_AVREF:
+		if (kid->op_type == OP_CONST &&
+		  (kid->op_private & OPpCONST_BARE)) {
+		    char *name = SvPVx(((SVOP*)kid)->op_sv, na);
+		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
+			gv_fetchpv(name, TRUE, SVt_PVAV) ));
+		    if (dowarn)
+			warn("Array @%s missing the @ in argument %d of %s()",
+			    name, numargs, op_desc[type]);
+		    op_free(kid);
+		    kid = newop;
+		    kid->op_sibling = sibl;
+		    *tokid = kid;
+		}
+		else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
+		    bad_type(numargs, "array", op_desc[op->op_type], kid);
+		mod(kid, type);
+		break;
+	    case OA_HVREF:
+		if (kid->op_type == OP_CONST &&
+		  (kid->op_private & OPpCONST_BARE)) {
+		    char *name = SvPVx(((SVOP*)kid)->op_sv, na);
+		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
+			gv_fetchpv(name, TRUE, SVt_PVHV) ));
+		    if (dowarn)
+			warn("Hash %%%s missing the %% in argument %d of %s()",
+			    name, numargs, op_desc[type]);
+		    op_free(kid);
+		    kid = newop;
+		    kid->op_sibling = sibl;
+		    *tokid = kid;
+		}
+		else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
+		    bad_type(numargs, "hash", op_desc[op->op_type], kid);
+		mod(kid, type);
+		break;
+	    case OA_CVREF:
+		{
+		    OP *newop = newUNOP(OP_NULL, 0, kid);
+		    kid->op_sibling = 0;
+		    linklist(kid);
+		    newop->op_next = newop;
+		    kid = newop;
+		    kid->op_sibling = sibl;
+		    *tokid = kid;
+		}
+		break;
+	    case OA_FILEREF:
+		if (kid->op_type != OP_GV) {
+		    if (kid->op_type == OP_CONST &&
+		      (kid->op_private & OPpCONST_BARE)) {
+			OP *newop = newGVOP(OP_GV, 0,
+			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
+					SVt_PVIO) );
+			op_free(kid);
+			kid = newop;
+		    }
+		    else {
+			kid->op_sibling = 0;
+			kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+		    }
+		    kid->op_sibling = sibl;
+		    *tokid = kid;
+		}
+		scalar(kid);
+		break;
+	    case OA_SCALARREF:
+		mod(scalar(kid), type);
+		break;
+	    }
+	    oa >>= 4;
+	    tokid = &kid->op_sibling;
+	    kid = kid->op_sibling;
+	}
+	op->op_private |= numargs;
+	if (kid)
+	    return too_many_arguments(op,op_desc[op->op_type]);
+	listkids(op);
+    }
+    else if (opargs[type] & OA_DEFGV) {
+	op_free(op);
+	return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+    }
+
+    if (oa) {
+	while (oa & OA_OPTIONAL)
+	    oa >>= 4;
+	if (oa && oa != OA_LIST)
+	    return too_few_arguments(op,op_desc[op->op_type]);
+    }
+    return op;
+}
+
+OP *
+ck_glob(op)
+OP *op;
+{
+    GV *gv = newGVgen("main");
+    gv_IOadd(gv);
+    append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
+    scalarkids(op);
+    return ck_fun(op);
+}
+
+OP *
+ck_grep(op)
+OP *op;
+{
+    LOGOP *gwop;
+    OP *kid;
+    OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+
+    op->op_ppaddr = ppaddr[OP_GREPSTART];
+    Newz(1101, gwop, 1, LOGOP);
+    
+    if (op->op_flags & OPf_STACKED) {
+	OP* k;
+	op = ck_sort(op);
+        kid = cLISTOP->op_first->op_sibling;
+	for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
+	    kid = k;
+	}
+	kid->op_next = (OP*)gwop;
+	op->op_flags &= ~OPf_STACKED;
+    }
+    kid = cLISTOP->op_first->op_sibling;
+    if (type == OP_MAPWHILE)
+	list(kid);
+    else
+	scalar(kid);
+    op = ck_fun(op);
+    if (error_count)
+	return op;
+    kid = cLISTOP->op_first->op_sibling; 
+    if (kid->op_type != OP_NULL)
+	croak("panic: ck_grep");
+    kid = kUNOP->op_first;
+
+    gwop->op_type = type;
+    gwop->op_ppaddr = ppaddr[type];
+    gwop->op_first = listkids(op);
+    gwop->op_flags |= OPf_KIDS;
+    gwop->op_private = 1;
+    gwop->op_other = LINKLIST(kid);
+    gwop->op_targ = pad_alloc(type, SVs_PADTMP);
+    kid->op_next = (OP*)gwop;
+
+    kid = cLISTOP->op_first->op_sibling;
+    if (!kid || !kid->op_sibling)
+	return too_few_arguments(op,op_desc[op->op_type]);
+    for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
+	mod(kid, OP_GREPSTART);
+
+    return (OP*)gwop;
+}
+
+OP *
+ck_index(op)
+OP *op;
+{
+    if (op->op_flags & OPf_KIDS) {
+	OP *kid = cLISTOP->op_first->op_sibling;	/* get past pushmark */
+	if (kid && kid->op_type == OP_CONST)
+	    fbm_compile(((SVOP*)kid)->op_sv, 0);
+    }
+    return ck_fun(op);
+}
+
+OP *
+ck_lengthconst(op)
+OP *op;
+{
+    /* XXX length optimization goes here */
+    return ck_fun(op);
+}
+
+OP *
+ck_lfun(op)
+OP *op;
+{
+    return modkids(ck_fun(op), op->op_type);
+}
+
+OP *
+ck_rfun(op)
+OP *op;
+{
+    return refkids(ck_fun(op), op->op_type);
+}
+
+OP *
+ck_listiob(op)
+OP *op;
+{
+    register OP *kid;
+    
+    kid = cLISTOP->op_first;
+    if (!kid) {
+	op = force_list(op);
+	kid = cLISTOP->op_first;
+    }
+    if (kid->op_type == OP_PUSHMARK)
+	kid = kid->op_sibling;
+    if (kid && op->op_flags & OPf_STACKED)
+	kid = kid->op_sibling;
+    else if (kid && !kid->op_sibling) {		/* print HANDLE; */
+	if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
+	    op->op_flags |= OPf_STACKED;	/* make it a filehandle */
+	    kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
+	    cLISTOP->op_first->op_sibling = kid;
+	    cLISTOP->op_last = kid;
+	    kid = kid->op_sibling;
+	}
+    }
+	
+    if (!kid)
+	append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+
+    return listkids(op);
+}
+
+OP *
+ck_match(op)
+OP *op;
+{
+    cPMOP->op_pmflags |= PMf_RUNTIME;
+    cPMOP->op_pmpermflags |= PMf_RUNTIME;
+    return op;
+}
+
+OP *
+ck_null(op)
+OP *op;
+{
+    return op;
+}
+
+OP *
+ck_repeat(op)
+OP *op;
+{
+    if (cBINOP->op_first->op_flags & OPf_PARENS) {
+	op->op_private |= OPpREPEAT_DOLIST;
+	cBINOP->op_first = force_list(cBINOP->op_first);
+    }
+    else
+	scalar(op);
+    return op;
+}
+
+OP *
+ck_require(op)
+OP *op;
+{
+    if (op->op_flags & OPf_KIDS) {	/* Shall we supply missing .pm? */
+	SVOP *kid = (SVOP*)cUNOP->op_first;
+
+	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+	    char *s;
+	    for (s = SvPVX(kid->op_sv); *s; s++) {
+		if (*s == ':' && s[1] == ':') {
+		    *s = '/';
+		    Move(s+2, s+1, strlen(s+2)+1, char);
+		    --SvCUR(kid->op_sv);
+		}
+	    }
+	    sv_catpvn(kid->op_sv, ".pm", 3);
+	}
+    }
+    return ck_fun(op);
+}
+
+OP *
+ck_retarget(op)
+OP *op;
+{
+    croak("NOT IMPL LINE %d",__LINE__);
+    /* STUB */
+    return op;
+}
+
+OP *
+ck_select(op)
+OP *op;
+{
+    OP* kid;
+    if (op->op_flags & OPf_KIDS) {
+	kid = cLISTOP->op_first->op_sibling;	/* get past pushmark */
+	if (kid && kid->op_sibling) {
+	    op->op_type = OP_SSELECT;
+	    op->op_ppaddr = ppaddr[OP_SSELECT];
+	    op = ck_fun(op);
+	    return fold_constants(op);
+	}
+    }
+    op = ck_fun(op);
+    kid = cLISTOP->op_first->op_sibling;    /* get past pushmark */
+    if (kid && kid->op_type == OP_RV2GV)
+	kid->op_private &= ~HINT_STRICT_REFS;
+    return op;
+}
+
+OP *
+ck_shift(op)
+OP *op;
+{
+    I32 type = op->op_type;
+
+    if (!(op->op_flags & OPf_KIDS)) {
+	op_free(op);
+	return newUNOP(type, 0,
+	    scalar(newUNOP(OP_RV2AV, 0,
+		scalar(newGVOP(OP_GV, 0,
+		    gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
+    }
+    return scalar(modkids(ck_fun(op), type));
+}
+
+OP *
+ck_sort(op)
+OP *op;
+{
+    if (op->op_flags & OPf_STACKED) {
+	OP *kid = cLISTOP->op_first->op_sibling;	/* get past pushmark */
+	OP *k;
+	kid = kUNOP->op_first;				/* get past rv2gv */
+
+	if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
+	    linklist(kid);
+	    if (kid->op_type == OP_SCOPE) {
+		k = kid->op_next;
+		kid->op_next = 0;
+	    }
+	    else if (kid->op_type == OP_LEAVE) {
+		if (op->op_type == OP_SORT) {
+		    null(kid);			/* wipe out leave */
+		    kid->op_next = kid;
+
+		    for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
+			if (k->op_next == kid)
+			    k->op_next = 0;
+		    }
+		}
+		else
+		    kid->op_next = 0;		/* just disconnect the leave */
+		k = kLISTOP->op_first;
+	    }
+	    peep(k);
+
+	    kid = cLISTOP->op_first->op_sibling;	/* get past pushmark */
+	    null(kid);					/* wipe out rv2gv */
+	    if (op->op_type == OP_SORT)
+		kid->op_next = kid;
+	    else
+		kid->op_next = k;
+	    op->op_flags |= OPf_SPECIAL;
+	}
+    }
+    return op;
+}
+
+OP *
+ck_split(op)
+OP *op;
+{
+    register OP *kid;
+    PMOP* pm;
+    
+    if (op->op_flags & OPf_STACKED)
+	return no_fh_allowed(op);
+
+    kid = cLISTOP->op_first;
+    if (kid->op_type != OP_NULL)
+	croak("panic: ck_split");
+    kid = kid->op_sibling;
+    op_free(cLISTOP->op_first);
+    cLISTOP->op_first = kid;
+    if (!kid) {
+	cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
+	cLISTOP->op_last = kid; /* There was only one element previously */
+    }
+
+    if (kid->op_type != OP_MATCH) {
+	OP *sibl = kid->op_sibling;
+	kid->op_sibling = 0;
+	kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
+	if (cLISTOP->op_first == cLISTOP->op_last)
+	    cLISTOP->op_last = kid;
+	cLISTOP->op_first = kid;
+	kid->op_sibling = sibl;
+    }
+    pm = (PMOP*)kid;
+    if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
+	SvREFCNT_dec(pm->op_pmshort);	/* can't use substring to optimize */
+	pm->op_pmshort = 0;
+    }
+
+    kid->op_type = OP_PUSHRE;
+    kid->op_ppaddr = ppaddr[OP_PUSHRE];
+    scalar(kid);
+
+    if (!kid->op_sibling)
+	append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+
+    kid = kid->op_sibling;
+    scalar(kid);
+
+    if (!kid->op_sibling)
+	append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
+
+    kid = kid->op_sibling;
+    scalar(kid);
+
+    if (kid->op_sibling)
+	return too_many_arguments(op,op_desc[op->op_type]);
+
+    return op;
+}
+
+OP *
+ck_subr(op)
+OP *op;
+{
+    OP *prev = ((cUNOP->op_first->op_sibling)
+	     ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
+    OP *o = prev->op_sibling;
+    OP *cvop;
+    char *proto = 0;
+    CV *cv = 0;
+    int optional = 0;
+    I32 arg = 0;
+
+    for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
+    if (cvop->op_type == OP_RV2CV) {
+	SVOP* tmpop;
+	op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
+	null(cvop);		/* disable rv2cv */
+	tmpop = (SVOP*)((UNOP*)cvop)->op_first;
+	if (tmpop->op_type == OP_GV) {
+	    cv = GvCV(tmpop->op_sv);
+	    if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
+		proto = SvPV((SV*)cv,na);
+	}
+    }
+    op->op_private |= (hints & HINT_STRICT_REFS);
+    if (perldb && curstash != debstash)
+	op->op_private |= OPpENTERSUB_DB;
+    while (o != cvop) {
+	if (proto) {
+	    switch (*proto) {
+	    case '\0':
+		return too_many_arguments(op, CvNAME(cv));
+	    case ';':
+		optional = 1;
+		proto++;
+		continue;
+	    case '$':
+		proto++;
+		arg++;
+		scalar(o);
+		break;
+	    case '%':
+	    case '@':
+		list(o);
+		arg++;
+		break;
+	    case '&':
+		proto++;
+		arg++;
+		if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
+		    bad_type(arg, "block", CvNAME(cv), o);
+		break;
+	    case '*':
+		proto++;
+		arg++;
+		if (o->op_type == OP_RV2GV)
+		    goto wrapref;
+		{
+		    OP* kid = o;
+		    o = newUNOP(OP_RV2GV, 0, kid);
+		    o->op_sibling = kid->op_sibling;
+		    kid->op_sibling = 0;
+		    prev->op_sibling = o;
+		}
+		goto wrapref;
+	    case '\\':
+		proto++;
+		arg++;
+		switch (*proto++) {
+		case '*':
+		    if (o->op_type != OP_RV2GV)
+			bad_type(arg, "symbol", CvNAME(cv), o);
+		    goto wrapref;
+		case '&':
+		    if (o->op_type != OP_RV2CV)
+			bad_type(arg, "sub", CvNAME(cv), o);
+		    goto wrapref;
+		case '$':
+		    if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
+			bad_type(arg, "scalar", CvNAME(cv), o);
+		    goto wrapref;
+		case '@':
+		    if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
+			bad_type(arg, "array", CvNAME(cv), o);
+		    goto wrapref;
+		case '%':
+		    if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
+			bad_type(arg, "hash", CvNAME(cv), o);
+		  wrapref:
+		    {
+			OP* kid = o;
+			o = newUNOP(OP_REFGEN, 0, kid);
+			o->op_sibling = kid->op_sibling;
+			kid->op_sibling = 0;
+			prev->op_sibling = o;
+		    }
+		    break;
+		default: goto oops;
+		}
+		break;
+	    default:
+	      oops:
+		croak("Malformed prototype for %s: %s",
+			CvNAME(cv),SvPV((SV*)cv,na));
+	    }
+	}
+	else
+	    list(o);
+	mod(o, OP_ENTERSUB);
+	prev = o;
+	o = o->op_sibling;
+    }
+    if (proto && !optional && *proto == '$')
+	return too_few_arguments(op, CvNAME(cv));
+    return op;
+}
+
+OP *
+ck_svconst(op)
+OP *op;
+{
+    SvREADONLY_on(cSVOP->op_sv);
+    return op;
+}
+
+OP *
+ck_trunc(op)
+OP *op;
+{
+    if (op->op_flags & OPf_KIDS) {
+	SVOP *kid = (SVOP*)cUNOP->op_first;
+
+	if (kid->op_type == OP_NULL)
+	    kid = (SVOP*)kid->op_sibling;
+	if (kid &&
+	  kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
+	    op->op_flags |= OPf_SPECIAL;
+    }
+    return ck_fun(op);
+}
+
+/* A peephole optimizer.  We visit the ops in the order they're to execute. */
+
+void
+peep(o)
+register OP* o;
+{
+    register OP* oldop = 0;
+    if (!o || o->op_seq)
+	return;
+    ENTER;
+    SAVESPTR(op);
+    SAVESPTR(curcop);
+    for (; o; o = o->op_next) {
+	if (o->op_seq)
+	    break;
+	if (!op_seqmax)
+	    op_seqmax++;
+	op = o;
+	switch (o->op_type) {
+	case OP_NEXTSTATE:
+	case OP_DBSTATE:
+	    curcop = ((COP*)o);		/* for warnings */
+	    o->op_seq = op_seqmax++;
+	    break;
+
+	case OP_CONCAT:
+	case OP_CONST:
+	case OP_JOIN:
+	case OP_UC:
+	case OP_UCFIRST:
+	case OP_LC:
+	case OP_LCFIRST:
+	case OP_QUOTEMETA:
+	    if (o->op_next->op_type == OP_STRINGIFY)
+		null(o->op_next);
+	    o->op_seq = op_seqmax++;
+	    break;
+	case OP_STUB:
+	    if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
+		o->op_seq = op_seqmax++;
+		break;	/* Scalar stub must produce undef.  List stub is noop */
+	    }
+	    goto nothin;
+	case OP_NULL:
+	    if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+		curcop = ((COP*)op);
+	    goto nothin;
+	case OP_SCALAR:
+	case OP_LINESEQ:
+	case OP_SCOPE:
+	  nothin:
+	    if (oldop && o->op_next) {
+		oldop->op_next = o->op_next;
+		continue;
+	    }
+	    o->op_seq = op_seqmax++;
+	    break;
+
+	case OP_GV:
+	    if (o->op_next->op_type == OP_RV2SV) {
+		if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
+		    null(o->op_next);
+		    o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
+		    o->op_next = o->op_next->op_next;
+		    o->op_type = OP_GVSV;
+		    o->op_ppaddr = ppaddr[OP_GVSV];
+		}
+	    }
+	    else if (o->op_next->op_type == OP_RV2AV) {
+		OP* pop = o->op_next->op_next;
+		IV i;
+		if (pop->op_type == OP_CONST &&
+		    (op = pop->op_next) &&
+		    pop->op_next->op_type == OP_AELEM &&
+		    !(pop->op_next->op_private &
+			(OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
+		    (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
+				<= 255 &&
+		    i >= 0)
+		{
+		    SvREFCNT_dec(((SVOP*)pop)->op_sv);
+		    null(o->op_next);
+		    null(pop->op_next);
+		    null(pop);
+		    o->op_flags |= pop->op_next->op_flags & OPf_MOD;
+		    o->op_next = pop->op_next->op_next;
+		    o->op_type = OP_AELEMFAST;
+		    o->op_ppaddr = ppaddr[OP_AELEMFAST];
+		    o->op_private = (U8)i;
+		    GvAVn((GV*)(((SVOP*)o)->op_sv));
+		}
+	    }
+	    o->op_seq = op_seqmax++;
+	    break;
+
+	case OP_MAPWHILE:
+	case OP_GREPWHILE:
+	case OP_AND:
+	case OP_OR:
+	    o->op_seq = op_seqmax++;
+	    peep(cLOGOP->op_other);
+	    break;
+
+	case OP_COND_EXPR:
+	    o->op_seq = op_seqmax++;
+	    peep(cCONDOP->op_true);
+	    peep(cCONDOP->op_false);
+	    break;
+
+	case OP_ENTERLOOP:
+	    o->op_seq = op_seqmax++;
+	    peep(cLOOP->op_redoop);
+	    peep(cLOOP->op_nextop);
+	    peep(cLOOP->op_lastop);
+	    break;
+
+	case OP_MATCH:
+	case OP_SUBST:
+	    o->op_seq = op_seqmax++;
+	    peep(cPMOP->op_pmreplstart);
+	    break;
+
+	case OP_EXEC:
+	    o->op_seq = op_seqmax++;
+	    if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
+		if (o->op_next->op_sibling &&
+			o->op_next->op_sibling->op_type != OP_DIE) {
+		    line_t oldline = curcop->cop_line;
+
+		    curcop->cop_line = ((COP*)o->op_next)->cop_line;
+		    warn("Statement unlikely to be reached");
+		    warn("(Maybe you meant system() when you said exec()?)\n");
+		    curcop->cop_line = oldline;
+		}
+	    }
+	    break;
+	default:
+	    o->op_seq = op_seqmax++;
+	    break;
+	}
+	oldop = o;
+    }
+    LEAVE;
+}
diff --git a/gnu/usr.bin/perl/op.h b/gnu/usr.bin/perl/op.h
new file mode 100644
index 00000000000..304099bd8ff
--- /dev/null
+++ b/gnu/usr.bin/perl/op.h
@@ -0,0 +1,244 @@
+/*    op.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * The fields of BASEOP are:
+ *	op_next		Pointer to next ppcode to execute after this one.
+ *			(Top level pre-grafted op points to first op,
+ *			but this is replaced when op is grafted in, when
+ *			this op will point to the real next op, and the new
+ *			parent takes over role of remembering starting op.)
+ *	op_ppaddr	Pointer to current ppcode's function.
+ *	op_type		The type of the operation.
+ *	op_flags	Flags common to all operations.  See OPf_* below.
+ *	op_private	Flags peculiar to a particular operation (BUT,
+ *			by default, set to the number of children until
+ *			the operation is privatized by a check routine,
+ *			which may or may not check number of children).
+ */
+
+typedef U32 PADOFFSET;
+
+#ifdef DEBUGGING_OPS
+#define OPCODE opcode
+#else
+#define OPCODE U16
+#endif
+
+#define BASEOP				\
+    OP*		op_next;		\
+    OP*		op_sibling;		\
+    OP*		(*op_ppaddr)();		\
+    PADOFFSET	op_targ;		\
+    OPCODE	op_type;		\
+    U16		op_seq;			\
+    U8		op_flags;		\
+    U8		op_private;
+
+#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : dowantarray())
+
+/* Public flags */
+#define OPf_LIST	1	/* Do operator in list context. */
+#define OPf_KNOW	2	/* Context is known. */
+#define OPf_KIDS	4	/* There is a firstborn child. */
+#define OPf_PARENS	8	/* This operator was parenthesized. */
+				/*  (Or block needs explicit scope entry.) */
+#define OPf_REF		16	/* Certified reference. */
+				/*  (Return container, not containee). */
+#define OPf_MOD		32	/* Will modify (lvalue). */
+#define OPf_STACKED	64	/* Some arg is arriving on the stack. */
+#define OPf_SPECIAL	128	/* Do something weird for this op: */
+				/*  On local LVAL, don't init local value. */
+				/*  On OP_SORT, subroutine is inlined. */
+				/*  On OP_NOT, inversion was implicit. */
+				/*  On OP_LEAVE, don't restore curpm. */
+				/*  On truncate, we truncate filehandle */
+				/*  On control verbs, we saw no label */
+				/*  On flipflop, we saw ... instead of .. */
+				/*  On UNOPs, saw bare parens, e.g. eof(). */
+				/*  On OP_ENTERSUB || OP_NULL, saw a "do". */
+
+/* Private for lvalues */
+#define OPpLVAL_INTRO	128	/* Lvalue must be localized */
+
+/* Private for OP_AASSIGN */
+#define OPpASSIGN_COMMON	64	/* Left & right have syms in common. */
+
+/* Private for OP_SASSIGN */
+#define OPpASSIGN_BACKWARDS	64	/* Left & right switched. */
+
+/* Private for OP_TRANS */
+#define OPpTRANS_SQUASH		16
+#define OPpTRANS_DELETE		32
+#define OPpTRANS_COMPLEMENT	64
+
+/* Private for OP_REPEAT */
+#define OPpREPEAT_DOLIST	64	/* List replication. */
+
+/* Private for OP_ENTERSUB, OP_RV2?V, OP_?ELEM */
+  /* (lower bits carry hints) */
+#define OPpENTERSUB_AMPER	8	/* Used & form to call. */
+#define OPpENTERSUB_DB		16	/* Debug subroutine. */
+#define OPpDEREF_AV		32	/* Want ref to AV. */
+#define OPpDEREF_HV		64	/* Want ref to HV. */
+
+/* Private for OP_CONST */
+#define OPpCONST_ENTERED	16	/* Has been entered as symbol. */
+#define OPpCONST_ARYBASE	32	/* Was a $[ translated to constant. */
+#define OPpCONST_BARE		64	/* Was a bare word (filehandle?). */
+
+/* Private for OP_FLIP/FLOP */
+#define OPpFLIP_LINENUM		64	/* Range arg potentially a line num. */
+
+/* Private for OP_LIST */
+#define OPpLIST_GUESSED		64	/* Guessed that pushmark was needed. */
+
+/* Private for OP_LEAVE and friends */
+#define OPpLEAVE_VOID		64	/* No need to copy out values. */
+
+struct op {
+    BASEOP
+};
+
+struct unop {
+    BASEOP
+    OP *	op_first;
+};
+
+struct binop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_last;
+};
+
+struct logop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_other;
+};
+
+struct condop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_true;
+    OP *	op_false;
+};
+
+struct listop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_last;
+    U32		op_children;
+};
+
+struct pmop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_last;
+    U32		op_children;
+    OP *	op_pmreplroot;
+    OP *	op_pmreplstart;
+    PMOP *	op_pmnext;		/* list of all scanpats */
+    REGEXP *	op_pmregexp;		/* compiled expression */
+    SV *	op_pmshort;		/* for a fast bypass of execute() */
+    U16		op_pmflags;
+    U16		op_pmpermflags;
+    char	op_pmslen;
+};
+
+#define PMf_USED	0x0001		/* pm has been used once already */
+#define PMf_ONCE	0x0002		/* use pattern only once per reset */
+#define PMf_SCANFIRST	0x0004		/* initial constant not anchored */
+#define PMf_ALL		0x0008		/* initial constant is whole pat */
+#define PMf_SKIPWHITE	0x0010		/* skip leading whitespace for split */
+#define PMf_FOLD	0x0020		/* case insensitivity */
+#define PMf_CONST	0x0040		/* subst replacement is constant */
+#define PMf_KEEP	0x0080		/* keep 1st runtime pattern forever */
+#define PMf_GLOBAL	0x0100		/* pattern had a g modifier */
+#define PMf_RUNTIME	0x0200		/* pattern coming in on the stack */
+#define PMf_EVAL	0x0400		/* evaluating replacement as expr */
+#define PMf_WHITE	0x0800		/* pattern is \s+ */
+#define PMf_MULTILINE	0x1000		/* assume multiple lines */
+#define PMf_SINGLELINE	0x2000		/* assume single line */
+#define PMf_UNUSED	0x4000		/* (unused) */
+#define PMf_EXTENDED	0x8000		/* chuck embedded whitespace */
+
+struct svop {
+    BASEOP
+    SV *	op_sv;
+};
+
+struct gvop {
+    BASEOP
+    GV *	op_gv;
+};
+
+struct pvop {
+    BASEOP
+    char *	op_pv;
+};
+
+struct loop {
+    BASEOP
+    OP *	op_first;
+    OP *	op_last;
+    U32		op_children;
+    OP *	op_redoop;
+    OP *	op_nextop;
+    OP *	op_lastop;
+};
+
+#define cUNOP ((UNOP*)op)
+#define cBINOP ((BINOP*)op)
+#define cLISTOP ((LISTOP*)op)
+#define cLOGOP ((LOGOP*)op)
+#define cCONDOP ((CONDOP*)op)
+#define cPMOP ((PMOP*)op)
+#define cSVOP ((SVOP*)op)
+#define cGVOP ((GVOP*)op)
+#define cPVOP ((PVOP*)op)
+#define cCOP ((COP*)op)
+#define cLOOP ((LOOP*)op)
+
+#define kUNOP ((UNOP*)kid)
+#define kBINOP ((BINOP*)kid)
+#define kLISTOP ((LISTOP*)kid)
+#define kLOGOP ((LOGOP*)kid)
+#define kCONDOP ((CONDOP*)kid)
+#define kPMOP ((PMOP*)kid)
+#define kSVOP ((SVOP*)kid)
+#define kGVOP ((GVOP*)kid)
+#define kPVOP ((PVOP*)kid)
+#define kCOP ((COP*)kid)
+#define kLOOP ((LOOP*)kid)
+
+#define Nullop Null(OP*)
+
+/* Lowest byte of opargs */
+#define OA_MARK 1
+#define OA_FOLDCONST 2
+#define OA_RETSCALAR 4
+#define OA_TARGET 8
+#define OA_RETINTEGER 16
+#define OA_OTHERINT 32
+#define OA_DANGEROUS 64
+#define OA_DEFGV 128
+
+#define OASHIFT 8
+
+/* Remaining nybbles of opargs */
+#define OA_SCALAR 1
+#define OA_LIST 2
+#define OA_AVREF 3
+#define OA_HVREF 4
+#define OA_CVREF 5
+#define OA_FILEREF 6
+#define OA_SCALARREF 7
+#define OA_OPTIONAL 8
+
diff --git a/gnu/usr.bin/perl/opcode.h b/gnu/usr.bin/perl/opcode.h
new file mode 100644
index 00000000000..b13849d8aa3
--- /dev/null
+++ b/gnu/usr.bin/perl/opcode.h
@@ -0,0 +1,2476 @@
+#define pp_i_preinc pp_preinc
+#define pp_i_predec pp_predec
+#define pp_i_postinc pp_postinc
+#define pp_i_postdec pp_postdec
+
+typedef enum {
+	OP_NULL,	/* 0 */
+	OP_STUB,	/* 1 */
+	OP_SCALAR,	/* 2 */
+	OP_PUSHMARK,	/* 3 */
+	OP_WANTARRAY,	/* 4 */
+	OP_CONST,	/* 5 */
+	OP_GVSV,	/* 6 */
+	OP_GV,		/* 7 */
+	OP_GELEM,	/* 8 */
+	OP_PADSV,	/* 9 */
+	OP_PADAV,	/* 10 */
+	OP_PADHV,	/* 11 */
+	OP_PADANY,	/* 12 */
+	OP_PUSHRE,	/* 13 */
+	OP_RV2GV,	/* 14 */
+	OP_RV2SV,	/* 15 */
+	OP_AV2ARYLEN,	/* 16 */
+	OP_RV2CV,	/* 17 */
+	OP_ANONCODE,	/* 18 */
+	OP_PROTOTYPE,	/* 19 */
+	OP_REFGEN,	/* 20 */
+	OP_SREFGEN,	/* 21 */
+	OP_REF,		/* 22 */
+	OP_BLESS,	/* 23 */
+	OP_BACKTICK,	/* 24 */
+	OP_GLOB,	/* 25 */
+	OP_READLINE,	/* 26 */
+	OP_RCATLINE,	/* 27 */
+	OP_REGCMAYBE,	/* 28 */
+	OP_REGCOMP,	/* 29 */
+	OP_MATCH,	/* 30 */
+	OP_SUBST,	/* 31 */
+	OP_SUBSTCONT,	/* 32 */
+	OP_TRANS,	/* 33 */
+	OP_SASSIGN,	/* 34 */
+	OP_AASSIGN,	/* 35 */
+	OP_CHOP,	/* 36 */
+	OP_SCHOP,	/* 37 */
+	OP_CHOMP,	/* 38 */
+	OP_SCHOMP,	/* 39 */
+	OP_DEFINED,	/* 40 */
+	OP_UNDEF,	/* 41 */
+	OP_STUDY,	/* 42 */
+	OP_POS,		/* 43 */
+	OP_PREINC,	/* 44 */
+	OP_I_PREINC,	/* 45 */
+	OP_PREDEC,	/* 46 */
+	OP_I_PREDEC,	/* 47 */
+	OP_POSTINC,	/* 48 */
+	OP_I_POSTINC,	/* 49 */
+	OP_POSTDEC,	/* 50 */
+	OP_I_POSTDEC,	/* 51 */
+	OP_POW,		/* 52 */
+	OP_MULTIPLY,	/* 53 */
+	OP_I_MULTIPLY,	/* 54 */
+	OP_DIVIDE,	/* 55 */
+	OP_I_DIVIDE,	/* 56 */
+	OP_MODULO,	/* 57 */
+	OP_I_MODULO,	/* 58 */
+	OP_REPEAT,	/* 59 */
+	OP_ADD,		/* 60 */
+	OP_I_ADD,	/* 61 */
+	OP_SUBTRACT,	/* 62 */
+	OP_I_SUBTRACT,	/* 63 */
+	OP_CONCAT,	/* 64 */
+	OP_STRINGIFY,	/* 65 */
+	OP_LEFT_SHIFT,	/* 66 */
+	OP_RIGHT_SHIFT,	/* 67 */
+	OP_LT,		/* 68 */
+	OP_I_LT,	/* 69 */
+	OP_GT,		/* 70 */
+	OP_I_GT,	/* 71 */
+	OP_LE,		/* 72 */
+	OP_I_LE,	/* 73 */
+	OP_GE,		/* 74 */
+	OP_I_GE,	/* 75 */
+	OP_EQ,		/* 76 */
+	OP_I_EQ,	/* 77 */
+	OP_NE,		/* 78 */
+	OP_I_NE,	/* 79 */
+	OP_NCMP,	/* 80 */
+	OP_I_NCMP,	/* 81 */
+	OP_SLT,		/* 82 */
+	OP_SGT,		/* 83 */
+	OP_SLE,		/* 84 */
+	OP_SGE,		/* 85 */
+	OP_SEQ,		/* 86 */
+	OP_SNE,		/* 87 */
+	OP_SCMP,	/* 88 */
+	OP_BIT_AND,	/* 89 */
+	OP_BIT_XOR,	/* 90 */
+	OP_BIT_OR,	/* 91 */
+	OP_NEGATE,	/* 92 */
+	OP_I_NEGATE,	/* 93 */
+	OP_NOT,		/* 94 */
+	OP_COMPLEMENT,	/* 95 */
+	OP_ATAN2,	/* 96 */
+	OP_SIN,		/* 97 */
+	OP_COS,		/* 98 */
+	OP_RAND,	/* 99 */
+	OP_SRAND,	/* 100 */
+	OP_EXP,		/* 101 */
+	OP_LOG,		/* 102 */
+	OP_SQRT,	/* 103 */
+	OP_INT,		/* 104 */
+	OP_HEX,		/* 105 */
+	OP_OCT,		/* 106 */
+	OP_ABS,		/* 107 */
+	OP_LENGTH,	/* 108 */
+	OP_SUBSTR,	/* 109 */
+	OP_VEC,		/* 110 */
+	OP_INDEX,	/* 111 */
+	OP_RINDEX,	/* 112 */
+	OP_SPRINTF,	/* 113 */
+	OP_FORMLINE,	/* 114 */
+	OP_ORD,		/* 115 */
+	OP_CHR,		/* 116 */
+	OP_CRYPT,	/* 117 */
+	OP_UCFIRST,	/* 118 */
+	OP_LCFIRST,	/* 119 */
+	OP_UC,		/* 120 */
+	OP_LC,		/* 121 */
+	OP_QUOTEMETA,	/* 122 */
+	OP_RV2AV,	/* 123 */
+	OP_AELEMFAST,	/* 124 */
+	OP_AELEM,	/* 125 */
+	OP_ASLICE,	/* 126 */
+	OP_EACH,	/* 127 */
+	OP_VALUES,	/* 128 */
+	OP_KEYS,	/* 129 */
+	OP_DELETE,	/* 130 */
+	OP_EXISTS,	/* 131 */
+	OP_RV2HV,	/* 132 */
+	OP_HELEM,	/* 133 */
+	OP_HSLICE,	/* 134 */
+	OP_UNPACK,	/* 135 */
+	OP_PACK,	/* 136 */
+	OP_SPLIT,	/* 137 */
+	OP_JOIN,	/* 138 */
+	OP_LIST,	/* 139 */
+	OP_LSLICE,	/* 140 */
+	OP_ANONLIST,	/* 141 */
+	OP_ANONHASH,	/* 142 */
+	OP_SPLICE,	/* 143 */
+	OP_PUSH,	/* 144 */
+	OP_POP,		/* 145 */
+	OP_SHIFT,	/* 146 */
+	OP_UNSHIFT,	/* 147 */
+	OP_SORT,	/* 148 */
+	OP_REVERSE,	/* 149 */
+	OP_GREPSTART,	/* 150 */
+	OP_GREPWHILE,	/* 151 */
+	OP_MAPSTART,	/* 152 */
+	OP_MAPWHILE,	/* 153 */
+	OP_RANGE,	/* 154 */
+	OP_FLIP,	/* 155 */
+	OP_FLOP,	/* 156 */
+	OP_AND,		/* 157 */
+	OP_OR,		/* 158 */
+	OP_XOR,		/* 159 */
+	OP_COND_EXPR,	/* 160 */
+	OP_ANDASSIGN,	/* 161 */
+	OP_ORASSIGN,	/* 162 */
+	OP_METHOD,	/* 163 */
+	OP_ENTERSUB,	/* 164 */
+	OP_LEAVESUB,	/* 165 */
+	OP_CALLER,	/* 166 */
+	OP_WARN,	/* 167 */
+	OP_DIE,		/* 168 */
+	OP_RESET,	/* 169 */
+	OP_LINESEQ,	/* 170 */
+	OP_NEXTSTATE,	/* 171 */
+	OP_DBSTATE,	/* 172 */
+	OP_UNSTACK,	/* 173 */
+	OP_ENTER,	/* 174 */
+	OP_LEAVE,	/* 175 */
+	OP_SCOPE,	/* 176 */
+	OP_ENTERITER,	/* 177 */
+	OP_ITER,	/* 178 */
+	OP_ENTERLOOP,	/* 179 */
+	OP_LEAVELOOP,	/* 180 */
+	OP_RETURN,	/* 181 */
+	OP_LAST,	/* 182 */
+	OP_NEXT,	/* 183 */
+	OP_REDO,	/* 184 */
+	OP_DUMP,	/* 185 */
+	OP_GOTO,	/* 186 */
+	OP_EXIT,	/* 187 */
+	OP_OPEN,	/* 188 */
+	OP_CLOSE,	/* 189 */
+	OP_PIPE_OP,	/* 190 */
+	OP_FILENO,	/* 191 */
+	OP_UMASK,	/* 192 */
+	OP_BINMODE,	/* 193 */
+	OP_TIE,		/* 194 */
+	OP_UNTIE,	/* 195 */
+	OP_TIED,	/* 196 */
+	OP_DBMOPEN,	/* 197 */
+	OP_DBMCLOSE,	/* 198 */
+	OP_SSELECT,	/* 199 */
+	OP_SELECT,	/* 200 */
+	OP_GETC,	/* 201 */
+	OP_READ,	/* 202 */
+	OP_ENTERWRITE,	/* 203 */
+	OP_LEAVEWRITE,	/* 204 */
+	OP_PRTF,	/* 205 */
+	OP_PRINT,	/* 206 */
+	OP_SYSOPEN,	/* 207 */
+	OP_SYSREAD,	/* 208 */
+	OP_SYSWRITE,	/* 209 */
+	OP_SEND,	/* 210 */
+	OP_RECV,	/* 211 */
+	OP_EOF,		/* 212 */
+	OP_TELL,	/* 213 */
+	OP_SEEK,	/* 214 */
+	OP_TRUNCATE,	/* 215 */
+	OP_FCNTL,	/* 216 */
+	OP_IOCTL,	/* 217 */
+	OP_FLOCK,	/* 218 */
+	OP_SOCKET,	/* 219 */
+	OP_SOCKPAIR,	/* 220 */
+	OP_BIND,	/* 221 */
+	OP_CONNECT,	/* 222 */
+	OP_LISTEN,	/* 223 */
+	OP_ACCEPT,	/* 224 */
+	OP_SHUTDOWN,	/* 225 */
+	OP_GSOCKOPT,	/* 226 */
+	OP_SSOCKOPT,	/* 227 */
+	OP_GETSOCKNAME,	/* 228 */
+	OP_GETPEERNAME,	/* 229 */
+	OP_LSTAT,	/* 230 */
+	OP_STAT,	/* 231 */
+	OP_FTRREAD,	/* 232 */
+	OP_FTRWRITE,	/* 233 */
+	OP_FTREXEC,	/* 234 */
+	OP_FTEREAD,	/* 235 */
+	OP_FTEWRITE,	/* 236 */
+	OP_FTEEXEC,	/* 237 */
+	OP_FTIS,	/* 238 */
+	OP_FTEOWNED,	/* 239 */
+	OP_FTROWNED,	/* 240 */
+	OP_FTZERO,	/* 241 */
+	OP_FTSIZE,	/* 242 */
+	OP_FTMTIME,	/* 243 */
+	OP_FTATIME,	/* 244 */
+	OP_FTCTIME,	/* 245 */
+	OP_FTSOCK,	/* 246 */
+	OP_FTCHR,	/* 247 */
+	OP_FTBLK,	/* 248 */
+	OP_FTFILE,	/* 249 */
+	OP_FTDIR,	/* 250 */
+	OP_FTPIPE,	/* 251 */
+	OP_FTLINK,	/* 252 */
+	OP_FTSUID,	/* 253 */
+	OP_FTSGID,	/* 254 */
+	OP_FTSVTX,	/* 255 */
+	OP_FTTTY,	/* 256 */
+	OP_FTTEXT,	/* 257 */
+	OP_FTBINARY,	/* 258 */
+	OP_CHDIR,	/* 259 */
+	OP_CHOWN,	/* 260 */
+	OP_CHROOT,	/* 261 */
+	OP_UNLINK,	/* 262 */
+	OP_CHMOD,	/* 263 */
+	OP_UTIME,	/* 264 */
+	OP_RENAME,	/* 265 */
+	OP_LINK,	/* 266 */
+	OP_SYMLINK,	/* 267 */
+	OP_READLINK,	/* 268 */
+	OP_MKDIR,	/* 269 */
+	OP_RMDIR,	/* 270 */
+	OP_OPEN_DIR,	/* 271 */
+	OP_READDIR,	/* 272 */
+	OP_TELLDIR,	/* 273 */
+	OP_SEEKDIR,	/* 274 */
+	OP_REWINDDIR,	/* 275 */
+	OP_CLOSEDIR,	/* 276 */
+	OP_FORK,	/* 277 */
+	OP_WAIT,	/* 278 */
+	OP_WAITPID,	/* 279 */
+	OP_SYSTEM,	/* 280 */
+	OP_EXEC,	/* 281 */
+	OP_KILL,	/* 282 */
+	OP_GETPPID,	/* 283 */
+	OP_GETPGRP,	/* 284 */
+	OP_SETPGRP,	/* 285 */
+	OP_GETPRIORITY,	/* 286 */
+	OP_SETPRIORITY,	/* 287 */
+	OP_TIME,	/* 288 */
+	OP_TMS,		/* 289 */
+	OP_LOCALTIME,	/* 290 */
+	OP_GMTIME,	/* 291 */
+	OP_ALARM,	/* 292 */
+	OP_SLEEP,	/* 293 */
+	OP_SHMGET,	/* 294 */
+	OP_SHMCTL,	/* 295 */
+	OP_SHMREAD,	/* 296 */
+	OP_SHMWRITE,	/* 297 */
+	OP_MSGGET,	/* 298 */
+	OP_MSGCTL,	/* 299 */
+	OP_MSGSND,	/* 300 */
+	OP_MSGRCV,	/* 301 */
+	OP_SEMGET,	/* 302 */
+	OP_SEMCTL,	/* 303 */
+	OP_SEMOP,	/* 304 */
+	OP_REQUIRE,	/* 305 */
+	OP_DOFILE,	/* 306 */
+	OP_ENTEREVAL,	/* 307 */
+	OP_LEAVEEVAL,	/* 308 */
+	OP_ENTERTRY,	/* 309 */
+	OP_LEAVETRY,	/* 310 */
+	OP_GHBYNAME,	/* 311 */
+	OP_GHBYADDR,	/* 312 */
+	OP_GHOSTENT,	/* 313 */
+	OP_GNBYNAME,	/* 314 */
+	OP_GNBYADDR,	/* 315 */
+	OP_GNETENT,	/* 316 */
+	OP_GPBYNAME,	/* 317 */
+	OP_GPBYNUMBER,	/* 318 */
+	OP_GPROTOENT,	/* 319 */
+	OP_GSBYNAME,	/* 320 */
+	OP_GSBYPORT,	/* 321 */
+	OP_GSERVENT,	/* 322 */
+	OP_SHOSTENT,	/* 323 */
+	OP_SNETENT,	/* 324 */
+	OP_SPROTOENT,	/* 325 */
+	OP_SSERVENT,	/* 326 */
+	OP_EHOSTENT,	/* 327 */
+	OP_ENETENT,	/* 328 */
+	OP_EPROTOENT,	/* 329 */
+	OP_ESERVENT,	/* 330 */
+	OP_GPWNAM,	/* 331 */
+	OP_GPWUID,	/* 332 */
+	OP_GPWENT,	/* 333 */
+	OP_SPWENT,	/* 334 */
+	OP_EPWENT,	/* 335 */
+	OP_GGRNAM,	/* 336 */
+	OP_GGRGID,	/* 337 */
+	OP_GGRENT,	/* 338 */
+	OP_SGRENT,	/* 339 */
+	OP_EGRENT,	/* 340 */
+	OP_GETLOGIN,	/* 341 */
+	OP_SYSCALL,	/* 342 */
+	OP_max		
+} opcode;
+
+#define MAXO 343
+
+#ifndef DOINIT
+EXT char *op_name[];
+#else
+EXT char *op_name[] = {
+	"null",
+	"stub",
+	"scalar",
+	"pushmark",
+	"wantarray",
+	"const",
+	"gvsv",
+	"gv",
+	"gelem",
+	"padsv",
+	"padav",
+	"padhv",
+	"padany",
+	"pushre",
+	"rv2gv",
+	"rv2sv",
+	"av2arylen",
+	"rv2cv",
+	"anoncode",
+	"prototype",
+	"refgen",
+	"srefgen",
+	"ref",
+	"bless",
+	"backtick",
+	"glob",
+	"readline",
+	"rcatline",
+	"regcmaybe",
+	"regcomp",
+	"match",
+	"subst",
+	"substcont",
+	"trans",
+	"sassign",
+	"aassign",
+	"chop",
+	"schop",
+	"chomp",
+	"schomp",
+	"defined",
+	"undef",
+	"study",
+	"pos",
+	"preinc",
+	"i_preinc",
+	"predec",
+	"i_predec",
+	"postinc",
+	"i_postinc",
+	"postdec",
+	"i_postdec",
+	"pow",
+	"multiply",
+	"i_multiply",
+	"divide",
+	"i_divide",
+	"modulo",
+	"i_modulo",
+	"repeat",
+	"add",
+	"i_add",
+	"subtract",
+	"i_subtract",
+	"concat",
+	"stringify",
+	"left_shift",
+	"right_shift",
+	"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",
+	"bit_and",
+	"bit_xor",
+	"bit_or",
+	"negate",
+	"i_negate",
+	"not",
+	"complement",
+	"atan2",
+	"sin",
+	"cos",
+	"rand",
+	"srand",
+	"exp",
+	"log",
+	"sqrt",
+	"int",
+	"hex",
+	"oct",
+	"abs",
+	"length",
+	"substr",
+	"vec",
+	"index",
+	"rindex",
+	"sprintf",
+	"formline",
+	"ord",
+	"chr",
+	"crypt",
+	"ucfirst",
+	"lcfirst",
+	"uc",
+	"lc",
+	"quotemeta",
+	"rv2av",
+	"aelemfast",
+	"aelem",
+	"aslice",
+	"each",
+	"values",
+	"keys",
+	"delete",
+	"exists",
+	"rv2hv",
+	"helem",
+	"hslice",
+	"unpack",
+	"pack",
+	"split",
+	"join",
+	"list",
+	"lslice",
+	"anonlist",
+	"anonhash",
+	"splice",
+	"push",
+	"pop",
+	"shift",
+	"unshift",
+	"sort",
+	"reverse",
+	"grepstart",
+	"grepwhile",
+	"mapstart",
+	"mapwhile",
+	"range",
+	"flip",
+	"flop",
+	"and",
+	"or",
+	"xor",
+	"cond_expr",
+	"andassign",
+	"orassign",
+	"method",
+	"entersub",
+	"leavesub",
+	"caller",
+	"warn",
+	"die",
+	"reset",
+	"lineseq",
+	"nextstate",
+	"dbstate",
+	"unstack",
+	"enter",
+	"leave",
+	"scope",
+	"enteriter",
+	"iter",
+	"enterloop",
+	"leaveloop",
+	"return",
+	"last",
+	"next",
+	"redo",
+	"dump",
+	"goto",
+	"exit",
+	"open",
+	"close",
+	"pipe_op",
+	"fileno",
+	"umask",
+	"binmode",
+	"tie",
+	"untie",
+	"tied",
+	"dbmopen",
+	"dbmclose",
+	"sselect",
+	"select",
+	"getc",
+	"read",
+	"enterwrite",
+	"leavewrite",
+	"prtf",
+	"print",
+	"sysopen",
+	"sysread",
+	"syswrite",
+	"send",
+	"recv",
+	"eof",
+	"tell",
+	"seek",
+	"truncate",
+	"fcntl",
+	"ioctl",
+	"flock",
+	"socket",
+	"sockpair",
+	"bind",
+	"connect",
+	"listen",
+	"accept",
+	"shutdown",
+	"gsockopt",
+	"ssockopt",
+	"getsockname",
+	"getpeername",
+	"lstat",
+	"stat",
+	"ftrread",
+	"ftrwrite",
+	"ftrexec",
+	"fteread",
+	"ftewrite",
+	"fteexec",
+	"ftis",
+	"fteowned",
+	"ftrowned",
+	"ftzero",
+	"ftsize",
+	"ftmtime",
+	"ftatime",
+	"ftctime",
+	"ftsock",
+	"ftchr",
+	"ftblk",
+	"ftfile",
+	"ftdir",
+	"ftpipe",
+	"ftlink",
+	"ftsuid",
+	"ftsgid",
+	"ftsvtx",
+	"fttty",
+	"fttext",
+	"ftbinary",
+	"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",
+	"dofile",
+	"entereval",
+	"leaveeval",
+	"entertry",
+	"leavetry",
+	"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",
+};
+#endif
+
+#ifndef DOINIT
+EXT char *op_desc[];
+#else
+EXT char *op_desc[] = {
+	"null operation",
+	"stub",
+	"scalar",
+	"pushmark",
+	"wantarray",
+	"constant item",
+	"scalar variable",
+	"glob value",
+	"glob elem",
+	"private variable",
+	"private array",
+	"private hash",
+	"private something",
+	"push regexp",
+	"ref-to-glob cast",
+	"scalar deref",
+	"array length",
+	"subroutine deref",
+	"anonymous subroutine",
+	"subroutine prototype",
+	"reference constructor",
+	"scalar ref constructor",
+	"reference-type operator",
+	"bless",
+	"backticks",
+	"glob",
+	"<HANDLE>",
+	"append I/O operator",
+	"regexp comp once",
+	"regexp compilation",
+	"pattern match",
+	"substitution",
+	"substitution cont",
+	"character translation",
+	"scalar assignment",
+	"list assignment",
+	"chop",
+	"scalar chop",
+	"safe chop",
+	"scalar safe chop",
+	"defined operator",
+	"undef operator",
+	"study",
+	"match position",
+	"preincrement",
+	"integer preincrement",
+	"predecrement",
+	"integer predecrement",
+	"postincrement",
+	"integer postincrement",
+	"postdecrement",
+	"integer postdecrement",
+	"exponentiation",
+	"multiplication",
+	"integer multiplication",
+	"division",
+	"integer division",
+	"modulus",
+	"integer modulus",
+	"repeat",
+	"addition",
+	"integer addition",
+	"subtraction",
+	"integer subtraction",
+	"concatenation",
+	"string",
+	"left bitshift",
+	"right bitshift",
+	"numeric lt",
+	"integer lt",
+	"numeric gt",
+	"integer gt",
+	"numeric le",
+	"integer le",
+	"numeric ge",
+	"integer ge",
+	"numeric eq",
+	"integer eq",
+	"numeric ne",
+	"integer ne",
+	"spaceship operator",
+	"integer spaceship",
+	"string lt",
+	"string gt",
+	"string le",
+	"string ge",
+	"string eq",
+	"string ne",
+	"string comparison",
+	"bitwise and",
+	"bitwise xor",
+	"bitwise or",
+	"negate",
+	"integer negate",
+	"not",
+	"1's complement",
+	"atan2",
+	"sin",
+	"cos",
+	"rand",
+	"srand",
+	"exp",
+	"log",
+	"sqrt",
+	"int",
+	"hex",
+	"oct",
+	"abs",
+	"length",
+	"substr",
+	"vec",
+	"index",
+	"rindex",
+	"sprintf",
+	"formline",
+	"ord",
+	"chr",
+	"crypt",
+	"upper case first",
+	"lower case first",
+	"upper case",
+	"lower case",
+	"quote metachars",
+	"array deref",
+	"known array element",
+	"array element",
+	"array slice",
+	"each",
+	"values",
+	"keys",
+	"delete",
+	"exists operator",
+	"associative array deref",
+	"associative array elem",
+	"associative array slice",
+	"unpack",
+	"pack",
+	"split",
+	"join",
+	"list",
+	"list slice",
+	"anonymous list",
+	"anonymous hash",
+	"splice",
+	"push",
+	"pop",
+	"shift",
+	"unshift",
+	"sort",
+	"reverse",
+	"grep",
+	"grep iterator",
+	"map",
+	"map iterator",
+	"flipflop",
+	"range (or flip)",
+	"range (or flop)",
+	"logical and",
+	"logical or",
+	"logical xor",
+	"conditional expression",
+	"logical and assignment",
+	"logical or assignment",
+	"method lookup",
+	"subroutine entry",
+	"subroutine exit",
+	"caller",
+	"warn",
+	"die",
+	"reset",
+	"line sequence",
+	"next statement",
+	"debug next statement",
+	"unstack",
+	"block entry",
+	"block exit",
+	"block",
+	"foreach loop entry",
+	"foreach loop iterator",
+	"loop entry",
+	"loop exit",
+	"return",
+	"last",
+	"next",
+	"redo",
+	"dump",
+	"goto",
+	"exit",
+	"open",
+	"close",
+	"pipe",
+	"fileno",
+	"umask",
+	"binmode",
+	"tie",
+	"untie",
+	"tied",
+	"dbmopen",
+	"dbmclose",
+	"select system call",
+	"select",
+	"getc",
+	"read",
+	"write",
+	"write exit",
+	"printf",
+	"print",
+	"sysopen",
+	"sysread",
+	"syswrite",
+	"send",
+	"recv",
+	"eof",
+	"tell",
+	"seek",
+	"truncate",
+	"fcntl",
+	"ioctl",
+	"flock",
+	"socket",
+	"socketpair",
+	"bind",
+	"connect",
+	"listen",
+	"accept",
+	"shutdown",
+	"getsockopt",
+	"setsockopt",
+	"getsockname",
+	"getpeername",
+	"lstat",
+	"stat",
+	"-R",
+	"-W",
+	"-X",
+	"-r",
+	"-w",
+	"-x",
+	"-e",
+	"-O",
+	"-o",
+	"-z",
+	"-s",
+	"-M",
+	"-A",
+	"-C",
+	"-S",
+	"-c",
+	"-b",
+	"-f",
+	"-d",
+	"-p",
+	"-l",
+	"-u",
+	"-g",
+	"-k",
+	"-t",
+	"-T",
+	"-B",
+	"chdir",
+	"chown",
+	"chroot",
+	"unlink",
+	"chmod",
+	"utime",
+	"rename",
+	"link",
+	"symlink",
+	"readlink",
+	"mkdir",
+	"rmdir",
+	"opendir",
+	"readdir",
+	"telldir",
+	"seekdir",
+	"rewinddir",
+	"closedir",
+	"fork",
+	"wait",
+	"waitpid",
+	"system",
+	"exec",
+	"kill",
+	"getppid",
+	"getpgrp",
+	"setpgrp",
+	"getpriority",
+	"setpriority",
+	"time",
+	"times",
+	"localtime",
+	"gmtime",
+	"alarm",
+	"sleep",
+	"shmget",
+	"shmctl",
+	"shmread",
+	"shmwrite",
+	"msgget",
+	"msgctl",
+	"msgsnd",
+	"msgrcv",
+	"semget",
+	"semctl",
+	"semop",
+	"require",
+	"do 'file'",
+	"eval string",
+	"eval exit",
+	"eval block",
+	"eval block exit",
+	"gethostbyname",
+	"gethostbyaddr",
+	"gethostent",
+	"getnetbyname",
+	"getnetbyaddr",
+	"getnetent",
+	"getprotobyname",
+	"getprotobynumber",
+	"getprotoent",
+	"getservbyname",
+	"getservbyport",
+	"getservent",
+	"sethostent",
+	"setnetent",
+	"setprotoent",
+	"setservent",
+	"endhostent",
+	"endnetent",
+	"endprotoent",
+	"endservent",
+	"getpwnam",
+	"getpwuid",
+	"getpwent",
+	"setpwent",
+	"endpwent",
+	"getgrnam",
+	"getgrgid",
+	"getgrent",
+	"setgrent",
+	"endgrent",
+	"getlogin",
+	"syscall",
+};
+#endif
+
+OP *	ck_concat	_((OP* op));
+OP *	ck_delete	_((OP* op));
+OP *	ck_eof		_((OP* op));
+OP *	ck_eval		_((OP* op));
+OP *	ck_exec		_((OP* op));
+OP *	ck_formline	_((OP* op));
+OP *	ck_ftst		_((OP* op));
+OP *	ck_fun		_((OP* op));
+OP *	ck_glob		_((OP* op));
+OP *	ck_grep		_((OP* op));
+OP *	ck_index	_((OP* op));
+OP *	ck_lengthconst	_((OP* op));
+OP *	ck_lfun		_((OP* op));
+OP *	ck_listiob	_((OP* op));
+OP *	ck_match	_((OP* op));
+OP *	ck_null		_((OP* op));
+OP *	ck_repeat	_((OP* op));
+OP *	ck_require	_((OP* op));
+OP *	ck_rfun		_((OP* op));
+OP *	ck_rvconst	_((OP* op));
+OP *	ck_select	_((OP* op));
+OP *	ck_shift	_((OP* op));
+OP *	ck_sort		_((OP* op));
+OP *	ck_spair	_((OP* op));
+OP *	ck_split	_((OP* op));
+OP *	ck_subr		_((OP* op));
+OP *	ck_svconst	_((OP* op));
+OP *	ck_trunc	_((OP* op));
+
+OP *	pp_null		_((void));
+OP *	pp_stub		_((void));
+OP *	pp_scalar	_((void));
+OP *	pp_pushmark	_((void));
+OP *	pp_wantarray	_((void));
+OP *	pp_const	_((void));
+OP *	pp_gvsv		_((void));
+OP *	pp_gv		_((void));
+OP *	pp_gelem	_((void));
+OP *	pp_padsv	_((void));
+OP *	pp_padav	_((void));
+OP *	pp_padhv	_((void));
+OP *	pp_padany	_((void));
+OP *	pp_pushre	_((void));
+OP *	pp_rv2gv	_((void));
+OP *	pp_rv2sv	_((void));
+OP *	pp_av2arylen	_((void));
+OP *	pp_rv2cv	_((void));
+OP *	pp_anoncode	_((void));
+OP *	pp_prototype	_((void));
+OP *	pp_refgen	_((void));
+OP *	pp_srefgen	_((void));
+OP *	pp_ref		_((void));
+OP *	pp_bless	_((void));
+OP *	pp_backtick	_((void));
+OP *	pp_glob		_((void));
+OP *	pp_readline	_((void));
+OP *	pp_rcatline	_((void));
+OP *	pp_regcmaybe	_((void));
+OP *	pp_regcomp	_((void));
+OP *	pp_match	_((void));
+OP *	pp_subst	_((void));
+OP *	pp_substcont	_((void));
+OP *	pp_trans	_((void));
+OP *	pp_sassign	_((void));
+OP *	pp_aassign	_((void));
+OP *	pp_chop		_((void));
+OP *	pp_schop	_((void));
+OP *	pp_chomp	_((void));
+OP *	pp_schomp	_((void));
+OP *	pp_defined	_((void));
+OP *	pp_undef	_((void));
+OP *	pp_study	_((void));
+OP *	pp_pos		_((void));
+OP *	pp_preinc	_((void));
+OP *	pp_i_preinc	_((void));
+OP *	pp_predec	_((void));
+OP *	pp_i_predec	_((void));
+OP *	pp_postinc	_((void));
+OP *	pp_i_postinc	_((void));
+OP *	pp_postdec	_((void));
+OP *	pp_i_postdec	_((void));
+OP *	pp_pow		_((void));
+OP *	pp_multiply	_((void));
+OP *	pp_i_multiply	_((void));
+OP *	pp_divide	_((void));
+OP *	pp_i_divide	_((void));
+OP *	pp_modulo	_((void));
+OP *	pp_i_modulo	_((void));
+OP *	pp_repeat	_((void));
+OP *	pp_add		_((void));
+OP *	pp_i_add	_((void));
+OP *	pp_subtract	_((void));
+OP *	pp_i_subtract	_((void));
+OP *	pp_concat	_((void));
+OP *	pp_stringify	_((void));
+OP *	pp_left_shift	_((void));
+OP *	pp_right_shift	_((void));
+OP *	pp_lt		_((void));
+OP *	pp_i_lt		_((void));
+OP *	pp_gt		_((void));
+OP *	pp_i_gt		_((void));
+OP *	pp_le		_((void));
+OP *	pp_i_le		_((void));
+OP *	pp_ge		_((void));
+OP *	pp_i_ge		_((void));
+OP *	pp_eq		_((void));
+OP *	pp_i_eq		_((void));
+OP *	pp_ne		_((void));
+OP *	pp_i_ne		_((void));
+OP *	pp_ncmp		_((void));
+OP *	pp_i_ncmp	_((void));
+OP *	pp_slt		_((void));
+OP *	pp_sgt		_((void));
+OP *	pp_sle		_((void));
+OP *	pp_sge		_((void));
+OP *	pp_seq		_((void));
+OP *	pp_sne		_((void));
+OP *	pp_scmp		_((void));
+OP *	pp_bit_and	_((void));
+OP *	pp_bit_xor	_((void));
+OP *	pp_bit_or	_((void));
+OP *	pp_negate	_((void));
+OP *	pp_i_negate	_((void));
+OP *	pp_not		_((void));
+OP *	pp_complement	_((void));
+OP *	pp_atan2	_((void));
+OP *	pp_sin		_((void));
+OP *	pp_cos		_((void));
+OP *	pp_rand		_((void));
+OP *	pp_srand	_((void));
+OP *	pp_exp		_((void));
+OP *	pp_log		_((void));
+OP *	pp_sqrt		_((void));
+OP *	pp_int		_((void));
+OP *	pp_hex		_((void));
+OP *	pp_oct		_((void));
+OP *	pp_abs		_((void));
+OP *	pp_length	_((void));
+OP *	pp_substr	_((void));
+OP *	pp_vec		_((void));
+OP *	pp_index	_((void));
+OP *	pp_rindex	_((void));
+OP *	pp_sprintf	_((void));
+OP *	pp_formline	_((void));
+OP *	pp_ord		_((void));
+OP *	pp_chr		_((void));
+OP *	pp_crypt	_((void));
+OP *	pp_ucfirst	_((void));
+OP *	pp_lcfirst	_((void));
+OP *	pp_uc		_((void));
+OP *	pp_lc		_((void));
+OP *	pp_quotemeta	_((void));
+OP *	pp_rv2av	_((void));
+OP *	pp_aelemfast	_((void));
+OP *	pp_aelem	_((void));
+OP *	pp_aslice	_((void));
+OP *	pp_each		_((void));
+OP *	pp_values	_((void));
+OP *	pp_keys		_((void));
+OP *	pp_delete	_((void));
+OP *	pp_exists	_((void));
+OP *	pp_rv2hv	_((void));
+OP *	pp_helem	_((void));
+OP *	pp_hslice	_((void));
+OP *	pp_unpack	_((void));
+OP *	pp_pack		_((void));
+OP *	pp_split	_((void));
+OP *	pp_join		_((void));
+OP *	pp_list		_((void));
+OP *	pp_lslice	_((void));
+OP *	pp_anonlist	_((void));
+OP *	pp_anonhash	_((void));
+OP *	pp_splice	_((void));
+OP *	pp_push		_((void));
+OP *	pp_pop		_((void));
+OP *	pp_shift	_((void));
+OP *	pp_unshift	_((void));
+OP *	pp_sort		_((void));
+OP *	pp_reverse	_((void));
+OP *	pp_grepstart	_((void));
+OP *	pp_grepwhile	_((void));
+OP *	pp_mapstart	_((void));
+OP *	pp_mapwhile	_((void));
+OP *	pp_range	_((void));
+OP *	pp_flip		_((void));
+OP *	pp_flop		_((void));
+OP *	pp_and		_((void));
+OP *	pp_or		_((void));
+OP *	pp_xor		_((void));
+OP *	pp_cond_expr	_((void));
+OP *	pp_andassign	_((void));
+OP *	pp_orassign	_((void));
+OP *	pp_method	_((void));
+OP *	pp_entersub	_((void));
+OP *	pp_leavesub	_((void));
+OP *	pp_caller	_((void));
+OP *	pp_warn		_((void));
+OP *	pp_die		_((void));
+OP *	pp_reset	_((void));
+OP *	pp_lineseq	_((void));
+OP *	pp_nextstate	_((void));
+OP *	pp_dbstate	_((void));
+OP *	pp_unstack	_((void));
+OP *	pp_enter	_((void));
+OP *	pp_leave	_((void));
+OP *	pp_scope	_((void));
+OP *	pp_enteriter	_((void));
+OP *	pp_iter		_((void));
+OP *	pp_enterloop	_((void));
+OP *	pp_leaveloop	_((void));
+OP *	pp_return	_((void));
+OP *	pp_last		_((void));
+OP *	pp_next		_((void));
+OP *	pp_redo		_((void));
+OP *	pp_dump		_((void));
+OP *	pp_goto		_((void));
+OP *	pp_exit		_((void));
+OP *	pp_open		_((void));
+OP *	pp_close	_((void));
+OP *	pp_pipe_op	_((void));
+OP *	pp_fileno	_((void));
+OP *	pp_umask	_((void));
+OP *	pp_binmode	_((void));
+OP *	pp_tie		_((void));
+OP *	pp_untie	_((void));
+OP *	pp_tied		_((void));
+OP *	pp_dbmopen	_((void));
+OP *	pp_dbmclose	_((void));
+OP *	pp_sselect	_((void));
+OP *	pp_select	_((void));
+OP *	pp_getc		_((void));
+OP *	pp_read		_((void));
+OP *	pp_enterwrite	_((void));
+OP *	pp_leavewrite	_((void));
+OP *	pp_prtf		_((void));
+OP *	pp_print	_((void));
+OP *	pp_sysopen	_((void));
+OP *	pp_sysread	_((void));
+OP *	pp_syswrite	_((void));
+OP *	pp_send		_((void));
+OP *	pp_recv		_((void));
+OP *	pp_eof		_((void));
+OP *	pp_tell		_((void));
+OP *	pp_seek		_((void));
+OP *	pp_truncate	_((void));
+OP *	pp_fcntl	_((void));
+OP *	pp_ioctl	_((void));
+OP *	pp_flock	_((void));
+OP *	pp_socket	_((void));
+OP *	pp_sockpair	_((void));
+OP *	pp_bind		_((void));
+OP *	pp_connect	_((void));
+OP *	pp_listen	_((void));
+OP *	pp_accept	_((void));
+OP *	pp_shutdown	_((void));
+OP *	pp_gsockopt	_((void));
+OP *	pp_ssockopt	_((void));
+OP *	pp_getsockname	_((void));
+OP *	pp_getpeername	_((void));
+OP *	pp_lstat	_((void));
+OP *	pp_stat		_((void));
+OP *	pp_ftrread	_((void));
+OP *	pp_ftrwrite	_((void));
+OP *	pp_ftrexec	_((void));
+OP *	pp_fteread	_((void));
+OP *	pp_ftewrite	_((void));
+OP *	pp_fteexec	_((void));
+OP *	pp_ftis		_((void));
+OP *	pp_fteowned	_((void));
+OP *	pp_ftrowned	_((void));
+OP *	pp_ftzero	_((void));
+OP *	pp_ftsize	_((void));
+OP *	pp_ftmtime	_((void));
+OP *	pp_ftatime	_((void));
+OP *	pp_ftctime	_((void));
+OP *	pp_ftsock	_((void));
+OP *	pp_ftchr	_((void));
+OP *	pp_ftblk	_((void));
+OP *	pp_ftfile	_((void));
+OP *	pp_ftdir	_((void));
+OP *	pp_ftpipe	_((void));
+OP *	pp_ftlink	_((void));
+OP *	pp_ftsuid	_((void));
+OP *	pp_ftsgid	_((void));
+OP *	pp_ftsvtx	_((void));
+OP *	pp_fttty	_((void));
+OP *	pp_fttext	_((void));
+OP *	pp_ftbinary	_((void));
+OP *	pp_chdir	_((void));
+OP *	pp_chown	_((void));
+OP *	pp_chroot	_((void));
+OP *	pp_unlink	_((void));
+OP *	pp_chmod	_((void));
+OP *	pp_utime	_((void));
+OP *	pp_rename	_((void));
+OP *	pp_link		_((void));
+OP *	pp_symlink	_((void));
+OP *	pp_readlink	_((void));
+OP *	pp_mkdir	_((void));
+OP *	pp_rmdir	_((void));
+OP *	pp_open_dir	_((void));
+OP *	pp_readdir	_((void));
+OP *	pp_telldir	_((void));
+OP *	pp_seekdir	_((void));
+OP *	pp_rewinddir	_((void));
+OP *	pp_closedir	_((void));
+OP *	pp_fork		_((void));
+OP *	pp_wait		_((void));
+OP *	pp_waitpid	_((void));
+OP *	pp_system	_((void));
+OP *	pp_exec		_((void));
+OP *	pp_kill		_((void));
+OP *	pp_getppid	_((void));
+OP *	pp_getpgrp	_((void));
+OP *	pp_setpgrp	_((void));
+OP *	pp_getpriority	_((void));
+OP *	pp_setpriority	_((void));
+OP *	pp_time		_((void));
+OP *	pp_tms		_((void));
+OP *	pp_localtime	_((void));
+OP *	pp_gmtime	_((void));
+OP *	pp_alarm	_((void));
+OP *	pp_sleep	_((void));
+OP *	pp_shmget	_((void));
+OP *	pp_shmctl	_((void));
+OP *	pp_shmread	_((void));
+OP *	pp_shmwrite	_((void));
+OP *	pp_msgget	_((void));
+OP *	pp_msgctl	_((void));
+OP *	pp_msgsnd	_((void));
+OP *	pp_msgrcv	_((void));
+OP *	pp_semget	_((void));
+OP *	pp_semctl	_((void));
+OP *	pp_semop	_((void));
+OP *	pp_require	_((void));
+OP *	pp_dofile	_((void));
+OP *	pp_entereval	_((void));
+OP *	pp_leaveeval	_((void));
+OP *	pp_entertry	_((void));
+OP *	pp_leavetry	_((void));
+OP *	pp_ghbyname	_((void));
+OP *	pp_ghbyaddr	_((void));
+OP *	pp_ghostent	_((void));
+OP *	pp_gnbyname	_((void));
+OP *	pp_gnbyaddr	_((void));
+OP *	pp_gnetent	_((void));
+OP *	pp_gpbyname	_((void));
+OP *	pp_gpbynumber	_((void));
+OP *	pp_gprotoent	_((void));
+OP *	pp_gsbyname	_((void));
+OP *	pp_gsbyport	_((void));
+OP *	pp_gservent	_((void));
+OP *	pp_shostent	_((void));
+OP *	pp_snetent	_((void));
+OP *	pp_sprotoent	_((void));
+OP *	pp_sservent	_((void));
+OP *	pp_ehostent	_((void));
+OP *	pp_enetent	_((void));
+OP *	pp_eprotoent	_((void));
+OP *	pp_eservent	_((void));
+OP *	pp_gpwnam	_((void));
+OP *	pp_gpwuid	_((void));
+OP *	pp_gpwent	_((void));
+OP *	pp_spwent	_((void));
+OP *	pp_epwent	_((void));
+OP *	pp_ggrnam	_((void));
+OP *	pp_ggrgid	_((void));
+OP *	pp_ggrent	_((void));
+OP *	pp_sgrent	_((void));
+OP *	pp_egrent	_((void));
+OP *	pp_getlogin	_((void));
+OP *	pp_syscall	_((void));
+
+#ifndef DOINIT
+EXT OP * (*ppaddr[])();
+#else
+EXT OP * (*ppaddr[])() = {
+	pp_null,
+	pp_stub,
+	pp_scalar,
+	pp_pushmark,
+	pp_wantarray,
+	pp_const,
+	pp_gvsv,
+	pp_gv,
+	pp_gelem,
+	pp_padsv,
+	pp_padav,
+	pp_padhv,
+	pp_padany,
+	pp_pushre,
+	pp_rv2gv,
+	pp_rv2sv,
+	pp_av2arylen,
+	pp_rv2cv,
+	pp_anoncode,
+	pp_prototype,
+	pp_refgen,
+	pp_srefgen,
+	pp_ref,
+	pp_bless,
+	pp_backtick,
+	pp_glob,
+	pp_readline,
+	pp_rcatline,
+	pp_regcmaybe,
+	pp_regcomp,
+	pp_match,
+	pp_subst,
+	pp_substcont,
+	pp_trans,
+	pp_sassign,
+	pp_aassign,
+	pp_chop,
+	pp_schop,
+	pp_chomp,
+	pp_schomp,
+	pp_defined,
+	pp_undef,
+	pp_study,
+	pp_pos,
+	pp_preinc,
+	pp_i_preinc,
+	pp_predec,
+	pp_i_predec,
+	pp_postinc,
+	pp_i_postinc,
+	pp_postdec,
+	pp_i_postdec,
+	pp_pow,
+	pp_multiply,
+	pp_i_multiply,
+	pp_divide,
+	pp_i_divide,
+	pp_modulo,
+	pp_i_modulo,
+	pp_repeat,
+	pp_add,
+	pp_i_add,
+	pp_subtract,
+	pp_i_subtract,
+	pp_concat,
+	pp_stringify,
+	pp_left_shift,
+	pp_right_shift,
+	pp_lt,
+	pp_i_lt,
+	pp_gt,
+	pp_i_gt,
+	pp_le,
+	pp_i_le,
+	pp_ge,
+	pp_i_ge,
+	pp_eq,
+	pp_i_eq,
+	pp_ne,
+	pp_i_ne,
+	pp_ncmp,
+	pp_i_ncmp,
+	pp_slt,
+	pp_sgt,
+	pp_sle,
+	pp_sge,
+	pp_seq,
+	pp_sne,
+	pp_scmp,
+	pp_bit_and,
+	pp_bit_xor,
+	pp_bit_or,
+	pp_negate,
+	pp_i_negate,
+	pp_not,
+	pp_complement,
+	pp_atan2,
+	pp_sin,
+	pp_cos,
+	pp_rand,
+	pp_srand,
+	pp_exp,
+	pp_log,
+	pp_sqrt,
+	pp_int,
+	pp_hex,
+	pp_oct,
+	pp_abs,
+	pp_length,
+	pp_substr,
+	pp_vec,
+	pp_index,
+	pp_rindex,
+	pp_sprintf,
+	pp_formline,
+	pp_ord,
+	pp_chr,
+	pp_crypt,
+	pp_ucfirst,
+	pp_lcfirst,
+	pp_uc,
+	pp_lc,
+	pp_quotemeta,
+	pp_rv2av,
+	pp_aelemfast,
+	pp_aelem,
+	pp_aslice,
+	pp_each,
+	pp_values,
+	pp_keys,
+	pp_delete,
+	pp_exists,
+	pp_rv2hv,
+	pp_helem,
+	pp_hslice,
+	pp_unpack,
+	pp_pack,
+	pp_split,
+	pp_join,
+	pp_list,
+	pp_lslice,
+	pp_anonlist,
+	pp_anonhash,
+	pp_splice,
+	pp_push,
+	pp_pop,
+	pp_shift,
+	pp_unshift,
+	pp_sort,
+	pp_reverse,
+	pp_grepstart,
+	pp_grepwhile,
+	pp_mapstart,
+	pp_mapwhile,
+	pp_range,
+	pp_flip,
+	pp_flop,
+	pp_and,
+	pp_or,
+	pp_xor,
+	pp_cond_expr,
+	pp_andassign,
+	pp_orassign,
+	pp_method,
+	pp_entersub,
+	pp_leavesub,
+	pp_caller,
+	pp_warn,
+	pp_die,
+	pp_reset,
+	pp_lineseq,
+	pp_nextstate,
+	pp_dbstate,
+	pp_unstack,
+	pp_enter,
+	pp_leave,
+	pp_scope,
+	pp_enteriter,
+	pp_iter,
+	pp_enterloop,
+	pp_leaveloop,
+	pp_return,
+	pp_last,
+	pp_next,
+	pp_redo,
+	pp_dump,
+	pp_goto,
+	pp_exit,
+	pp_open,
+	pp_close,
+	pp_pipe_op,
+	pp_fileno,
+	pp_umask,
+	pp_binmode,
+	pp_tie,
+	pp_untie,
+	pp_tied,
+	pp_dbmopen,
+	pp_dbmclose,
+	pp_sselect,
+	pp_select,
+	pp_getc,
+	pp_read,
+	pp_enterwrite,
+	pp_leavewrite,
+	pp_prtf,
+	pp_print,
+	pp_sysopen,
+	pp_sysread,
+	pp_syswrite,
+	pp_send,
+	pp_recv,
+	pp_eof,
+	pp_tell,
+	pp_seek,
+	pp_truncate,
+	pp_fcntl,
+	pp_ioctl,
+	pp_flock,
+	pp_socket,
+	pp_sockpair,
+	pp_bind,
+	pp_connect,
+	pp_listen,
+	pp_accept,
+	pp_shutdown,
+	pp_gsockopt,
+	pp_ssockopt,
+	pp_getsockname,
+	pp_getpeername,
+	pp_lstat,
+	pp_stat,
+	pp_ftrread,
+	pp_ftrwrite,
+	pp_ftrexec,
+	pp_fteread,
+	pp_ftewrite,
+	pp_fteexec,
+	pp_ftis,
+	pp_fteowned,
+	pp_ftrowned,
+	pp_ftzero,
+	pp_ftsize,
+	pp_ftmtime,
+	pp_ftatime,
+	pp_ftctime,
+	pp_ftsock,
+	pp_ftchr,
+	pp_ftblk,
+	pp_ftfile,
+	pp_ftdir,
+	pp_ftpipe,
+	pp_ftlink,
+	pp_ftsuid,
+	pp_ftsgid,
+	pp_ftsvtx,
+	pp_fttty,
+	pp_fttext,
+	pp_ftbinary,
+	pp_chdir,
+	pp_chown,
+	pp_chroot,
+	pp_unlink,
+	pp_chmod,
+	pp_utime,
+	pp_rename,
+	pp_link,
+	pp_symlink,
+	pp_readlink,
+	pp_mkdir,
+	pp_rmdir,
+	pp_open_dir,
+	pp_readdir,
+	pp_telldir,
+	pp_seekdir,
+	pp_rewinddir,
+	pp_closedir,
+	pp_fork,
+	pp_wait,
+	pp_waitpid,
+	pp_system,
+	pp_exec,
+	pp_kill,
+	pp_getppid,
+	pp_getpgrp,
+	pp_setpgrp,
+	pp_getpriority,
+	pp_setpriority,
+	pp_time,
+	pp_tms,
+	pp_localtime,
+	pp_gmtime,
+	pp_alarm,
+	pp_sleep,
+	pp_shmget,
+	pp_shmctl,
+	pp_shmread,
+	pp_shmwrite,
+	pp_msgget,
+	pp_msgctl,
+	pp_msgsnd,
+	pp_msgrcv,
+	pp_semget,
+	pp_semctl,
+	pp_semop,
+	pp_require,
+	pp_dofile,
+	pp_entereval,
+	pp_leaveeval,
+	pp_entertry,
+	pp_leavetry,
+	pp_ghbyname,
+	pp_ghbyaddr,
+	pp_ghostent,
+	pp_gnbyname,
+	pp_gnbyaddr,
+	pp_gnetent,
+	pp_gpbyname,
+	pp_gpbynumber,
+	pp_gprotoent,
+	pp_gsbyname,
+	pp_gsbyport,
+	pp_gservent,
+	pp_shostent,
+	pp_snetent,
+	pp_sprotoent,
+	pp_sservent,
+	pp_ehostent,
+	pp_enetent,
+	pp_eprotoent,
+	pp_eservent,
+	pp_gpwnam,
+	pp_gpwuid,
+	pp_gpwent,
+	pp_spwent,
+	pp_epwent,
+	pp_ggrnam,
+	pp_ggrgid,
+	pp_ggrent,
+	pp_sgrent,
+	pp_egrent,
+	pp_getlogin,
+	pp_syscall,
+};
+#endif
+
+#ifndef DOINIT
+EXT OP * (*check[])();
+#else
+EXT OP * (*check[])() = {
+	ck_null,	/* null */
+	ck_null,	/* stub */
+	ck_fun,		/* scalar */
+	ck_null,	/* pushmark */
+	ck_null,	/* wantarray */
+	ck_svconst,	/* const */
+	ck_null,	/* gvsv */
+	ck_null,	/* gv */
+	ck_null,	/* gelem */
+	ck_null,	/* padsv */
+	ck_null,	/* padav */
+	ck_null,	/* padhv */
+	ck_null,	/* padany */
+	ck_null,	/* pushre */
+	ck_rvconst,	/* rv2gv */
+	ck_rvconst,	/* rv2sv */
+	ck_null,	/* av2arylen */
+	ck_rvconst,	/* rv2cv */
+	ck_null,	/* anoncode */
+	ck_null,	/* prototype */
+	ck_spair,	/* refgen */
+	ck_null,	/* srefgen */
+	ck_fun,		/* ref */
+	ck_fun,		/* bless */
+	ck_null,	/* backtick */
+	ck_glob,	/* glob */
+	ck_null,	/* readline */
+	ck_null,	/* rcatline */
+	ck_fun,		/* regcmaybe */
+	ck_null,	/* regcomp */
+	ck_match,	/* match */
+	ck_null,	/* subst */
+	ck_null,	/* substcont */
+	ck_null,	/* trans */
+	ck_null,	/* sassign */
+	ck_null,	/* aassign */
+	ck_spair,	/* chop */
+	ck_null,	/* schop */
+	ck_spair,	/* chomp */
+	ck_null,	/* schomp */
+	ck_rfun,	/* defined */
+	ck_lfun,	/* undef */
+	ck_fun,		/* study */
+	ck_lfun,	/* pos */
+	ck_lfun,	/* preinc */
+	ck_lfun,	/* i_preinc */
+	ck_lfun,	/* predec */
+	ck_lfun,	/* i_predec */
+	ck_lfun,	/* postinc */
+	ck_lfun,	/* i_postinc */
+	ck_lfun,	/* postdec */
+	ck_lfun,	/* i_postdec */
+	ck_null,	/* pow */
+	ck_null,	/* multiply */
+	ck_null,	/* i_multiply */
+	ck_null,	/* divide */
+	ck_null,	/* i_divide */
+	ck_null,	/* modulo */
+	ck_null,	/* i_modulo */
+	ck_repeat,	/* repeat */
+	ck_null,	/* add */
+	ck_null,	/* i_add */
+	ck_null,	/* subtract */
+	ck_null,	/* i_subtract */
+	ck_concat,	/* concat */
+	ck_fun,		/* stringify */
+	ck_null,	/* left_shift */
+	ck_null,	/* right_shift */
+	ck_null,	/* lt */
+	ck_null,	/* i_lt */
+	ck_null,	/* gt */
+	ck_null,	/* i_gt */
+	ck_null,	/* le */
+	ck_null,	/* i_le */
+	ck_null,	/* ge */
+	ck_null,	/* i_ge */
+	ck_null,	/* eq */
+	ck_null,	/* i_eq */
+	ck_null,	/* ne */
+	ck_null,	/* i_ne */
+	ck_null,	/* ncmp */
+	ck_null,	/* i_ncmp */
+	ck_null,	/* slt */
+	ck_null,	/* sgt */
+	ck_null,	/* sle */
+	ck_null,	/* sge */
+	ck_null,	/* seq */
+	ck_null,	/* sne */
+	ck_null,	/* scmp */
+	ck_null,	/* bit_and */
+	ck_null,	/* bit_xor */
+	ck_null,	/* bit_or */
+	ck_null,	/* negate */
+	ck_null,	/* i_negate */
+	ck_null,	/* not */
+	ck_null,	/* complement */
+	ck_fun,		/* atan2 */
+	ck_fun,		/* sin */
+	ck_fun,		/* cos */
+	ck_fun,		/* rand */
+	ck_fun,		/* srand */
+	ck_fun,		/* exp */
+	ck_fun,		/* log */
+	ck_fun,		/* sqrt */
+	ck_fun,		/* int */
+	ck_fun,		/* hex */
+	ck_fun,		/* oct */
+	ck_fun,		/* abs */
+	ck_lengthconst,	/* length */
+	ck_fun,		/* substr */
+	ck_fun,		/* vec */
+	ck_index,	/* index */
+	ck_index,	/* rindex */
+	ck_fun,		/* sprintf */
+	ck_formline,	/* formline */
+	ck_fun,		/* ord */
+	ck_fun,		/* chr */
+	ck_fun,		/* crypt */
+	ck_fun,		/* ucfirst */
+	ck_fun,		/* lcfirst */
+	ck_fun,		/* uc */
+	ck_fun,		/* lc */
+	ck_fun,		/* quotemeta */
+	ck_rvconst,	/* rv2av */
+	ck_null,	/* aelemfast */
+	ck_null,	/* aelem */
+	ck_null,	/* aslice */
+	ck_fun,		/* each */
+	ck_fun,		/* values */
+	ck_fun,		/* keys */
+	ck_delete,	/* delete */
+	ck_delete,	/* exists */
+	ck_rvconst,	/* rv2hv */
+	ck_null,	/* helem */
+	ck_null,	/* hslice */
+	ck_fun,		/* unpack */
+	ck_fun,		/* pack */
+	ck_split,	/* split */
+	ck_fun,		/* join */
+	ck_null,	/* list */
+	ck_null,	/* lslice */
+	ck_fun,		/* anonlist */
+	ck_fun,		/* anonhash */
+	ck_fun,		/* splice */
+	ck_fun,		/* push */
+	ck_shift,	/* pop */
+	ck_shift,	/* shift */
+	ck_fun,		/* unshift */
+	ck_sort,	/* sort */
+	ck_fun,		/* reverse */
+	ck_grep,	/* grepstart */
+	ck_null,	/* grepwhile */
+	ck_grep,	/* mapstart */
+	ck_null,	/* mapwhile */
+	ck_null,	/* range */
+	ck_null,	/* flip */
+	ck_null,	/* flop */
+	ck_null,	/* and */
+	ck_null,	/* or */
+	ck_null,	/* xor */
+	ck_null,	/* cond_expr */
+	ck_null,	/* andassign */
+	ck_null,	/* orassign */
+	ck_null,	/* method */
+	ck_subr,	/* entersub */
+	ck_null,	/* leavesub */
+	ck_fun,		/* caller */
+	ck_fun,		/* warn */
+	ck_fun,		/* die */
+	ck_fun,		/* reset */
+	ck_null,	/* lineseq */
+	ck_null,	/* nextstate */
+	ck_null,	/* dbstate */
+	ck_null,	/* unstack */
+	ck_null,	/* enter */
+	ck_null,	/* leave */
+	ck_null,	/* scope */
+	ck_null,	/* enteriter */
+	ck_null,	/* iter */
+	ck_null,	/* enterloop */
+	ck_null,	/* leaveloop */
+	ck_null,	/* return */
+	ck_null,	/* last */
+	ck_null,	/* next */
+	ck_null,	/* redo */
+	ck_null,	/* dump */
+	ck_null,	/* goto */
+	ck_fun,		/* exit */
+	ck_fun,		/* open */
+	ck_fun,		/* close */
+	ck_fun,		/* pipe_op */
+	ck_fun,		/* fileno */
+	ck_fun,		/* umask */
+	ck_fun,		/* binmode */
+	ck_fun,		/* tie */
+	ck_fun,		/* untie */
+	ck_fun,		/* tied */
+	ck_fun,		/* dbmopen */
+	ck_fun,		/* dbmclose */
+	ck_select,	/* sselect */
+	ck_select,	/* select */
+	ck_eof,		/* getc */
+	ck_fun,		/* read */
+	ck_fun,		/* enterwrite */
+	ck_null,	/* leavewrite */
+	ck_listiob,	/* prtf */
+	ck_listiob,	/* print */
+	ck_fun,		/* sysopen */
+	ck_fun,		/* sysread */
+	ck_fun,		/* syswrite */
+	ck_fun,		/* send */
+	ck_fun,		/* recv */
+	ck_eof,		/* eof */
+	ck_fun,		/* tell */
+	ck_fun,		/* seek */
+	ck_trunc,	/* truncate */
+	ck_fun,		/* fcntl */
+	ck_fun,		/* ioctl */
+	ck_fun,		/* flock */
+	ck_fun,		/* socket */
+	ck_fun,		/* sockpair */
+	ck_fun,		/* bind */
+	ck_fun,		/* connect */
+	ck_fun,		/* listen */
+	ck_fun,		/* accept */
+	ck_fun,		/* shutdown */
+	ck_fun,		/* gsockopt */
+	ck_fun,		/* ssockopt */
+	ck_fun,		/* getsockname */
+	ck_fun,		/* getpeername */
+	ck_ftst,	/* lstat */
+	ck_ftst,	/* stat */
+	ck_ftst,	/* ftrread */
+	ck_ftst,	/* ftrwrite */
+	ck_ftst,	/* ftrexec */
+	ck_ftst,	/* fteread */
+	ck_ftst,	/* ftewrite */
+	ck_ftst,	/* fteexec */
+	ck_ftst,	/* ftis */
+	ck_ftst,	/* fteowned */
+	ck_ftst,	/* ftrowned */
+	ck_ftst,	/* ftzero */
+	ck_ftst,	/* ftsize */
+	ck_ftst,	/* ftmtime */
+	ck_ftst,	/* ftatime */
+	ck_ftst,	/* ftctime */
+	ck_ftst,	/* ftsock */
+	ck_ftst,	/* ftchr */
+	ck_ftst,	/* ftblk */
+	ck_ftst,	/* ftfile */
+	ck_ftst,	/* ftdir */
+	ck_ftst,	/* ftpipe */
+	ck_ftst,	/* ftlink */
+	ck_ftst,	/* ftsuid */
+	ck_ftst,	/* ftsgid */
+	ck_ftst,	/* ftsvtx */
+	ck_ftst,	/* fttty */
+	ck_ftst,	/* fttext */
+	ck_ftst,	/* ftbinary */
+	ck_fun,		/* chdir */
+	ck_fun,		/* chown */
+	ck_fun,		/* chroot */
+	ck_fun,		/* unlink */
+	ck_fun,		/* chmod */
+	ck_fun,		/* utime */
+	ck_fun,		/* rename */
+	ck_fun,		/* link */
+	ck_fun,		/* symlink */
+	ck_fun,		/* readlink */
+	ck_fun,		/* mkdir */
+	ck_fun,		/* rmdir */
+	ck_fun,		/* open_dir */
+	ck_fun,		/* readdir */
+	ck_fun,		/* telldir */
+	ck_fun,		/* seekdir */
+	ck_fun,		/* rewinddir */
+	ck_fun,		/* closedir */
+	ck_null,	/* fork */
+	ck_null,	/* wait */
+	ck_fun,		/* waitpid */
+	ck_exec,	/* system */
+	ck_exec,	/* exec */
+	ck_fun,		/* kill */
+	ck_null,	/* getppid */
+	ck_fun,		/* getpgrp */
+	ck_fun,		/* setpgrp */
+	ck_fun,		/* getpriority */
+	ck_fun,		/* setpriority */
+	ck_null,	/* time */
+	ck_null,	/* tms */
+	ck_fun,		/* localtime */
+	ck_fun,		/* gmtime */
+	ck_fun,		/* alarm */
+	ck_fun,		/* sleep */
+	ck_fun,		/* shmget */
+	ck_fun,		/* shmctl */
+	ck_fun,		/* shmread */
+	ck_fun,		/* shmwrite */
+	ck_fun,		/* msgget */
+	ck_fun,		/* msgctl */
+	ck_fun,		/* msgsnd */
+	ck_fun,		/* msgrcv */
+	ck_fun,		/* semget */
+	ck_fun,		/* semctl */
+	ck_fun,		/* semop */
+	ck_require,	/* require */
+	ck_fun,		/* dofile */
+	ck_eval,	/* entereval */
+	ck_null,	/* leaveeval */
+	ck_null,	/* entertry */
+	ck_null,	/* leavetry */
+	ck_fun,		/* ghbyname */
+	ck_fun,		/* ghbyaddr */
+	ck_null,	/* ghostent */
+	ck_fun,		/* gnbyname */
+	ck_fun,		/* gnbyaddr */
+	ck_null,	/* gnetent */
+	ck_fun,		/* gpbyname */
+	ck_fun,		/* gpbynumber */
+	ck_null,	/* gprotoent */
+	ck_fun,		/* gsbyname */
+	ck_fun,		/* gsbyport */
+	ck_null,	/* gservent */
+	ck_fun,		/* shostent */
+	ck_fun,		/* snetent */
+	ck_fun,		/* sprotoent */
+	ck_fun,		/* sservent */
+	ck_null,	/* ehostent */
+	ck_null,	/* enetent */
+	ck_null,	/* eprotoent */
+	ck_null,	/* eservent */
+	ck_fun,		/* gpwnam */
+	ck_fun,		/* gpwuid */
+	ck_null,	/* gpwent */
+	ck_null,	/* spwent */
+	ck_null,	/* epwent */
+	ck_fun,		/* ggrnam */
+	ck_fun,		/* ggrgid */
+	ck_null,	/* ggrent */
+	ck_null,	/* sgrent */
+	ck_null,	/* egrent */
+	ck_null,	/* getlogin */
+	ck_fun,		/* syscall */
+};
+#endif
+
+#ifndef DOINIT
+EXT U32 opargs[];
+#else
+EXT U32 opargs[] = {
+	0x00000000,	/* null */
+	0x00000000,	/* stub */
+	0x00000104,	/* scalar */
+	0x00000004,	/* pushmark */
+	0x00000014,	/* wantarray */
+	0x00000004,	/* const */
+	0x00000044,	/* gvsv */
+	0x00000044,	/* gv */
+	0x00001140,	/* gelem */
+	0x00000044,	/* padsv */
+	0x00000040,	/* padav */
+	0x00000040,	/* padhv */
+	0x00000040,	/* padany */
+	0x00000000,	/* pushre */
+	0x00000044,	/* rv2gv */
+	0x00000044,	/* rv2sv */
+	0x00000014,	/* av2arylen */
+	0x00000040,	/* rv2cv */
+	0x00000000,	/* anoncode */
+	0x00000104,	/* prototype */
+	0x00000201,	/* refgen */
+	0x00000106,	/* srefgen */
+	0x0000098c,	/* ref */
+	0x00009104,	/* bless */
+	0x00000008,	/* backtick */
+	0x00001108,	/* glob */
+	0x00000008,	/* readline */
+	0x00000008,	/* rcatline */
+	0x00000104,	/* regcmaybe */
+	0x00000104,	/* regcomp */
+	0x00000040,	/* match */
+	0x00000154,	/* subst */
+	0x00000054,	/* substcont */
+	0x00000114,	/* trans */
+	0x00000004,	/* sassign */
+	0x00002208,	/* aassign */
+	0x0000020d,	/* chop */
+	0x0000098c,	/* schop */
+	0x0000020d,	/* chomp */
+	0x0000098c,	/* schomp */
+	0x00000994,	/* defined */
+	0x00000904,	/* undef */
+	0x00000984,	/* study */
+	0x0000098c,	/* pos */
+	0x00000164,	/* preinc */
+	0x00000154,	/* i_preinc */
+	0x00000164,	/* predec */
+	0x00000154,	/* i_predec */
+	0x0000016c,	/* postinc */
+	0x0000015c,	/* i_postinc */
+	0x0000016c,	/* postdec */
+	0x0000015c,	/* i_postdec */
+	0x0000110e,	/* pow */
+	0x0000112e,	/* multiply */
+	0x0000111e,	/* i_multiply */
+	0x0000112e,	/* divide */
+	0x0000111e,	/* i_divide */
+	0x0000113e,	/* modulo */
+	0x0000111e,	/* i_modulo */
+	0x00001209,	/* repeat */
+	0x0000112e,	/* add */
+	0x0000111e,	/* i_add */
+	0x0000112e,	/* subtract */
+	0x0000111e,	/* i_subtract */
+	0x0000110e,	/* concat */
+	0x0000010e,	/* stringify */
+	0x0000111e,	/* left_shift */
+	0x0000111e,	/* right_shift */
+	0x00001136,	/* lt */
+	0x00001116,	/* i_lt */
+	0x00001136,	/* gt */
+	0x00001116,	/* i_gt */
+	0x00001136,	/* le */
+	0x00001116,	/* i_le */
+	0x00001136,	/* ge */
+	0x00001116,	/* i_ge */
+	0x00001136,	/* eq */
+	0x00001116,	/* i_eq */
+	0x00001136,	/* ne */
+	0x00001116,	/* i_ne */
+	0x0000113e,	/* ncmp */
+	0x0000111e,	/* i_ncmp */
+	0x00001116,	/* slt */
+	0x00001116,	/* sgt */
+	0x00001116,	/* sle */
+	0x00001116,	/* sge */
+	0x00001116,	/* seq */
+	0x00001116,	/* sne */
+	0x0000111e,	/* scmp */
+	0x0000110e,	/* bit_and */
+	0x0000110e,	/* bit_xor */
+	0x0000110e,	/* bit_or */
+	0x0000012e,	/* negate */
+	0x0000011e,	/* i_negate */
+	0x00000116,	/* not */
+	0x0000010e,	/* complement */
+	0x0000110e,	/* atan2 */
+	0x0000098e,	/* sin */
+	0x0000098e,	/* cos */
+	0x0000090c,	/* rand */
+	0x00000904,	/* srand */
+	0x0000098e,	/* exp */
+	0x0000098e,	/* log */
+	0x0000098e,	/* sqrt */
+	0x0000098e,	/* int */
+	0x0000099c,	/* hex */
+	0x0000099c,	/* oct */
+	0x0000098e,	/* abs */
+	0x0000099c,	/* length */
+	0x0009110c,	/* substr */
+	0x0001111c,	/* vec */
+	0x0009111c,	/* index */
+	0x0009111c,	/* rindex */
+	0x0000210d,	/* sprintf */
+	0x00002105,	/* formline */
+	0x0000099e,	/* ord */
+	0x0000098e,	/* chr */
+	0x0000110e,	/* crypt */
+	0x0000010e,	/* ucfirst */
+	0x0000010e,	/* lcfirst */
+	0x0000010e,	/* uc */
+	0x0000010e,	/* lc */
+	0x0000010e,	/* quotemeta */
+	0x00000048,	/* rv2av */
+	0x00001304,	/* aelemfast */
+	0x00001304,	/* aelem */
+	0x00002301,	/* aslice */
+	0x00000408,	/* each */
+	0x00000408,	/* values */
+	0x00000408,	/* keys */
+	0x00000104,	/* delete */
+	0x00000114,	/* exists */
+	0x00000048,	/* rv2hv */
+	0x00001404,	/* helem */
+	0x00002401,	/* hslice */
+	0x00001100,	/* unpack */
+	0x0000210d,	/* pack */
+	0x00011108,	/* split */
+	0x0000210d,	/* join */
+	0x00000201,	/* list */
+	0x00022400,	/* lslice */
+	0x00000205,	/* anonlist */
+	0x00000205,	/* anonhash */
+	0x00299301,	/* splice */
+	0x0000231d,	/* push */
+	0x00000304,	/* pop */
+	0x00000304,	/* shift */
+	0x0000231d,	/* unshift */
+	0x00002d01,	/* sort */
+	0x00000209,	/* reverse */
+	0x00002541,	/* grepstart */
+	0x00000048,	/* grepwhile */
+	0x00002541,	/* mapstart */
+	0x00000048,	/* mapwhile */
+	0x00001100,	/* range */
+	0x00001100,	/* flip */
+	0x00000000,	/* flop */
+	0x00000000,	/* and */
+	0x00000000,	/* or */
+	0x00001106,	/* xor */
+	0x00000040,	/* cond_expr */
+	0x00000004,	/* andassign */
+	0x00000004,	/* orassign */
+	0x00000040,	/* method */
+	0x00000249,	/* entersub */
+	0x00000000,	/* leavesub */
+	0x00000908,	/* caller */
+	0x0000021d,	/* warn */
+	0x0000025d,	/* die */
+	0x00000914,	/* reset */
+	0x00000000,	/* lineseq */
+	0x00000004,	/* nextstate */
+	0x00000004,	/* dbstate */
+	0x00000004,	/* unstack */
+	0x00000000,	/* enter */
+	0x00000000,	/* leave */
+	0x00000000,	/* scope */
+	0x00000040,	/* enteriter */
+	0x00000000,	/* iter */
+	0x00000040,	/* enterloop */
+	0x00000000,	/* leaveloop */
+	0x00000241,	/* return */
+	0x00000044,	/* last */
+	0x00000044,	/* next */
+	0x00000044,	/* redo */
+	0x00000044,	/* dump */
+	0x00000044,	/* goto */
+	0x00000944,	/* exit */
+	0x0000961c,	/* open */
+	0x00000e14,	/* close */
+	0x00006614,	/* pipe_op */
+	0x0000061c,	/* fileno */
+	0x0000091c,	/* umask */
+	0x00000604,	/* binmode */
+	0x00021755,	/* tie */
+	0x00000714,	/* untie */
+	0x00000704,	/* tied */
+	0x00011414,	/* dbmopen */
+	0x00000414,	/* dbmclose */
+	0x00111108,	/* sselect */
+	0x00000e0c,	/* select */
+	0x00000e0c,	/* getc */
+	0x0091761d,	/* read */
+	0x00000e54,	/* enterwrite */
+	0x00000000,	/* leavewrite */
+	0x00002e15,	/* prtf */
+	0x00002e15,	/* print */
+	0x00911604,	/* sysopen */
+	0x0091761d,	/* sysread */
+	0x0091161d,	/* syswrite */
+	0x0091161d,	/* send */
+	0x0011761d,	/* recv */
+	0x00000e14,	/* eof */
+	0x00000e0c,	/* tell */
+	0x00011604,	/* seek */
+	0x00001114,	/* truncate */
+	0x0001160c,	/* fcntl */
+	0x0001160c,	/* ioctl */
+	0x0000161c,	/* flock */
+	0x00111614,	/* socket */
+	0x01116614,	/* sockpair */
+	0x00001614,	/* bind */
+	0x00001614,	/* connect */
+	0x00001614,	/* listen */
+	0x0000661c,	/* accept */
+	0x0000161c,	/* shutdown */
+	0x00011614,	/* gsockopt */
+	0x00111614,	/* ssockopt */
+	0x00000614,	/* getsockname */
+	0x00000614,	/* getpeername */
+	0x00000680,	/* lstat */
+	0x00000680,	/* stat */
+	0x00000694,	/* ftrread */
+	0x00000694,	/* ftrwrite */
+	0x00000694,	/* ftrexec */
+	0x00000694,	/* fteread */
+	0x00000694,	/* ftewrite */
+	0x00000694,	/* fteexec */
+	0x00000694,	/* ftis */
+	0x00000694,	/* fteowned */
+	0x00000694,	/* ftrowned */
+	0x00000694,	/* ftzero */
+	0x0000069c,	/* ftsize */
+	0x0000068c,	/* ftmtime */
+	0x0000068c,	/* ftatime */
+	0x0000068c,	/* ftctime */
+	0x00000694,	/* ftsock */
+	0x00000694,	/* ftchr */
+	0x00000694,	/* ftblk */
+	0x00000694,	/* ftfile */
+	0x00000694,	/* ftdir */
+	0x00000694,	/* ftpipe */
+	0x00000694,	/* ftlink */
+	0x00000694,	/* ftsuid */
+	0x00000694,	/* ftsgid */
+	0x00000694,	/* ftsvtx */
+	0x00000614,	/* fttty */
+	0x00000694,	/* fttext */
+	0x00000694,	/* ftbinary */
+	0x0000091c,	/* chdir */
+	0x0000021d,	/* chown */
+	0x0000099c,	/* chroot */
+	0x0000029d,	/* unlink */
+	0x0000021d,	/* chmod */
+	0x0000021d,	/* utime */
+	0x0000111c,	/* rename */
+	0x0000111c,	/* link */
+	0x0000111c,	/* symlink */
+	0x0000098c,	/* readlink */
+	0x0000111c,	/* mkdir */
+	0x0000099c,	/* rmdir */
+	0x00001614,	/* open_dir */
+	0x00000600,	/* readdir */
+	0x0000060c,	/* telldir */
+	0x00001604,	/* seekdir */
+	0x00000604,	/* rewinddir */
+	0x00000614,	/* closedir */
+	0x0000001c,	/* fork */
+	0x0000001c,	/* wait */
+	0x0000111c,	/* waitpid */
+	0x0000291d,	/* system */
+	0x0000295d,	/* exec */
+	0x0000025d,	/* kill */
+	0x0000001c,	/* getppid */
+	0x0000091c,	/* getpgrp */
+	0x0000991c,	/* setpgrp */
+	0x0000111c,	/* getpriority */
+	0x0001111c,	/* setpriority */
+	0x0000001c,	/* time */
+	0x00000000,	/* tms */
+	0x00000908,	/* localtime */
+	0x00000908,	/* gmtime */
+	0x0000099c,	/* alarm */
+	0x0000091c,	/* sleep */
+	0x0001111d,	/* shmget */
+	0x0001111d,	/* shmctl */
+	0x0011111d,	/* shmread */
+	0x0011111d,	/* shmwrite */
+	0x0000111d,	/* msgget */
+	0x0001111d,	/* msgctl */
+	0x0001111d,	/* msgsnd */
+	0x0111111d,	/* msgrcv */
+	0x0001111d,	/* semget */
+	0x0011111d,	/* semctl */
+	0x0000111d,	/* semop */
+	0x000009c0,	/* require */
+	0x00000140,	/* dofile */
+	0x00000140,	/* entereval */
+	0x00000100,	/* leaveeval */
+	0x00000000,	/* entertry */
+	0x00000000,	/* leavetry */
+	0x00000100,	/* ghbyname */
+	0x00001100,	/* ghbyaddr */
+	0x00000000,	/* ghostent */
+	0x00000100,	/* gnbyname */
+	0x00001100,	/* gnbyaddr */
+	0x00000000,	/* gnetent */
+	0x00000100,	/* gpbyname */
+	0x00000100,	/* gpbynumber */
+	0x00000000,	/* gprotoent */
+	0x00001100,	/* gsbyname */
+	0x00001100,	/* gsbyport */
+	0x00000000,	/* gservent */
+	0x00000114,	/* shostent */
+	0x00000114,	/* snetent */
+	0x00000114,	/* sprotoent */
+	0x00000114,	/* sservent */
+	0x00000014,	/* ehostent */
+	0x00000014,	/* enetent */
+	0x00000014,	/* eprotoent */
+	0x00000014,	/* eservent */
+	0x00000100,	/* gpwnam */
+	0x00000100,	/* gpwuid */
+	0x00000000,	/* gpwent */
+	0x00000014,	/* spwent */
+	0x00000014,	/* epwent */
+	0x00000100,	/* ggrnam */
+	0x00000100,	/* ggrgid */
+	0x00000000,	/* ggrent */
+	0x00000014,	/* sgrent */
+	0x00000014,	/* egrent */
+	0x0000000c,	/* getlogin */
+	0x0000211d,	/* syscall */
+};
+#endif
diff --git a/gnu/usr.bin/perl/opcode.pl b/gnu/usr.bin/perl/opcode.pl
new file mode 100644
index 00000000000..fddf6462a94
--- /dev/null
+++ b/gnu/usr.bin/perl/opcode.pl
@@ -0,0 +1,648 @@
+#!/usr/bin/perl
+
+open(OC, ">opcode.h") || die "Can't create opcode.h: $!\n";
+select OC;
+
+# Read data.
+
+while (<DATA>) {
+    chop;
+    next unless $_;
+    next if /^#/;
+    ($key, $desc, $check, $flags, $args) = split(/\t+/, $_, 5);
+
+    warn qq[Description "$desc" duplicates $seen{$desc}\n] if $seen{$desc};
+    die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key};
+    $seen{$desc} = qq[description of opcode "$key"];
+    $seen{$key} = qq[opcode "$key"];
+
+    push(@ops, $key);
+    $desc{$key} = $desc;
+    $check{$key} = $check;
+    $ckname{$check}++;
+    $flags{$key} = $flags;
+    $args{$key} = $args;
+}
+
+# Emit defines.
+
+$i = 0;
+print <<"END";
+#define pp_i_preinc pp_preinc
+#define pp_i_predec pp_predec
+#define pp_i_postinc pp_postinc
+#define pp_i_postdec pp_postdec
+
+typedef enum {
+END
+for (@ops) {
+    print "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n";
+}
+print "\t", &tab(3,"OP_max"), "\n";
+print "} opcode;\n";
+print "\n#define MAXO ", scalar @ops, "\n\n"; 
+
+# Emit op names and descriptions.
+
+print <<END;
+#ifndef DOINIT
+EXT char *op_name[];
+#else
+EXT char *op_name[] = {
+END
+
+for (@ops) {
+    print qq(\t"$_",\n);
+}
+
+print <<END;
+};
+#endif
+
+END
+
+print <<END;
+#ifndef DOINIT
+EXT char *op_desc[];
+#else
+EXT char *op_desc[] = {
+END
+
+for (@ops) {
+    print qq(\t"$desc{$_}",\n);
+}
+
+print <<END;
+};
+#endif
+
+END
+
+# Emit function declarations.
+
+for (sort keys %ckname) {
+    print "OP *\t", &tab(3,$_),"_((OP* op));\n";
+}
+
+print "\n";
+
+for (@ops) {
+    print "OP *\t", &tab(3, "pp_\L$_"), "_((void));\n";
+}
+
+# Emit ppcode switch array.
+
+print <<END;
+
+#ifndef DOINIT
+EXT OP * (*ppaddr[])();
+#else
+EXT OP * (*ppaddr[])() = {
+END
+
+for (@ops) {
+    print "\tpp_\L$_,\n";
+}
+
+print <<END;
+};
+#endif
+
+END
+
+# Emit check routines.
+
+print <<END;
+#ifndef DOINIT
+EXT OP * (*check[])();
+#else
+EXT OP * (*check[])() = {
+END
+
+for (@ops) {
+    print "\t", &tab(3, "$check{$_},"), "/* \L$_ */\n";
+}
+
+print <<END;
+};
+#endif
+
+END
+
+# Emit allowed argument types.
+
+print <<END;
+#ifndef DOINIT
+EXT U32 opargs[];
+#else
+EXT U32 opargs[] = {
+END
+
+%argnum = (
+    S,	1,		# scalar
+    L,	2,		# list
+    A,	3,		# array value
+    H,	4,		# hash value
+    C,	5,		# code value
+    F,	6,		# file value
+    R,	7,		# scalar reference
+);
+
+for (@ops) {
+    $argsum = 0;
+    $flags = $flags{$_};
+    $argsum |= 1 if $flags =~ /m/;		# needs stack mark
+    $argsum |= 2 if $flags =~ /f/;		# fold constants
+    $argsum |= 4 if $flags =~ /s/;		# always produces scalar
+    $argsum |= 8 if $flags =~ /t/;		# needs target scalar
+    $argsum |= 16 if $flags =~ /i/;		# always produces integer
+    $argsum |= 32 if $flags =~ /I/;		# has corresponding int op
+    $argsum |= 64 if $flags =~ /d/;		# danger, unknown side effects
+    $argsum |= 128 if $flags =~ /u/;		# defaults to $_
+    $mul = 256;
+    for $arg (split(' ',$args{$_})) {
+	$argnum = ($arg =~ s/\?//) ? 8 : 0;
+	$argnum += $argnum{$arg};
+	$argsum += $argnum * $mul;
+	$mul <<= 4;
+    }
+    $argsum = sprintf("0x%08x", $argsum);
+    print "\t", &tab(3, "$argsum,"), "/* \L$_ */\n";
+}
+
+print <<END;
+};
+#endif
+END
+
+###########################################################################
+sub tab {
+    local($l, $t) = @_;
+    $t .= "\t" x ($l - (length($t) + 1) / 8);
+    $t;
+}
+###########################################################################
+__END__
+
+# Nothing.
+
+null		null operation		ck_null		0	
+stub		stub			ck_null		0
+scalar		scalar			ck_fun		s	S
+
+# Pushy stuff.
+
+pushmark	pushmark		ck_null		s	
+wantarray	wantarray		ck_null		is	
+
+const		constant item		ck_svconst	s	
+
+gvsv		scalar variable		ck_null		ds	
+gv		glob value		ck_null		ds	
+gelem		glob elem		ck_null		d	S S
+padsv		private variable	ck_null		ds
+padav		private array		ck_null		d
+padhv		private hash		ck_null		d
+padany		private something	ck_null		d
+
+pushre		push regexp		ck_null		0
+
+# References and stuff.
+
+rv2gv		ref-to-glob cast	ck_rvconst	ds	
+rv2sv		scalar deref		ck_rvconst	ds	
+av2arylen	array length		ck_null		is	
+rv2cv		subroutine deref	ck_rvconst	d
+anoncode	anonymous subroutine	ck_null		0	
+prototype	subroutine prototype	ck_null		s	S
+refgen		reference constructor	ck_spair	m	L
+srefgen		scalar ref constructor	ck_null		fs	S
+ref		reference-type operator	ck_fun		stu	S?
+bless		bless			ck_fun		s	S S?
+
+# Pushy I/O.
+
+backtick	backticks		ck_null		t	
+glob		glob			ck_glob		t	S S
+readline	<HANDLE>		ck_null		t	
+rcatline	append I/O operator	ck_null		t	
+
+# Bindable operators.
+
+regcmaybe	regexp comp once	ck_fun		s	S
+regcomp		regexp compilation	ck_null		s	S
+match		pattern match		ck_match	d
+subst		substitution		ck_null		dis	S
+substcont	substitution cont	ck_null		dis	
+trans		character translation	ck_null		is	S
+
+# Lvalue operators.
+
+sassign		scalar assignment	ck_null		s
+aassign		list assignment		ck_null		t	L L
+
+chop		chop			ck_spair	mts	L
+schop		scalar chop		ck_null		stu	S?
+chomp		safe chop		ck_spair	mts	L
+schomp		scalar safe chop	ck_null		stu	S?
+defined		defined operator	ck_rfun		isu	S?
+undef		undef operator		ck_lfun		s	S?
+study		study			ck_fun		su	S?
+pos		match position		ck_lfun		stu	S?
+
+preinc		preincrement		ck_lfun		dIs	S
+i_preinc	integer preincrement	ck_lfun		dis	S
+predec		predecrement		ck_lfun		dIs	S
+i_predec	integer predecrement	ck_lfun		dis	S
+postinc		postincrement		ck_lfun		dIst	S
+i_postinc	integer postincrement	ck_lfun		dist	S
+postdec		postdecrement		ck_lfun		dIst	S
+i_postdec	integer postdecrement	ck_lfun		dist	S
+
+# Ordinary operators.
+
+pow		exponentiation		ck_null		fst	S S
+
+multiply	multiplication		ck_null		Ifst	S S
+i_multiply	integer multiplication	ck_null		ifst	S S
+divide		division		ck_null		Ifst	S S
+i_divide	integer division	ck_null		ifst	S S
+modulo		modulus			ck_null		Iifst	S S
+i_modulo	integer modulus		ck_null		ifst	S S
+repeat		repeat			ck_repeat	mt	L S
+
+add		addition		ck_null		Ifst	S S
+i_add		integer addition	ck_null		ifst	S S
+subtract	subtraction		ck_null		Ifst	S S
+i_subtract	integer subtraction	ck_null		ifst	S S
+concat		concatenation		ck_concat	fst	S S
+stringify	string			ck_fun		fst	S
+
+left_shift	left bitshift		ck_null		ifst	S S
+right_shift	right bitshift		ck_null		ifst	S S
+
+lt		numeric lt		ck_null		Iifs	S S
+i_lt		integer lt		ck_null		ifs	S S
+gt		numeric gt		ck_null		Iifs	S S
+i_gt		integer gt		ck_null		ifs	S S
+le		numeric le		ck_null		Iifs	S S
+i_le		integer le		ck_null		ifs	S S
+ge		numeric ge		ck_null		Iifs	S S
+i_ge		integer ge		ck_null		ifs	S S
+eq		numeric eq		ck_null		Iifs	S S
+i_eq		integer eq		ck_null		ifs	S S
+ne		numeric ne		ck_null		Iifs	S S
+i_ne		integer ne		ck_null		ifs	S S
+ncmp		spaceship operator	ck_null		Iifst	S S
+i_ncmp		integer spaceship	ck_null		ifst	S S
+
+slt		string lt		ck_null		ifs	S S
+sgt		string gt		ck_null		ifs	S S
+sle		string le		ck_null		ifs	S S
+sge		string ge		ck_null		ifs	S S
+seq		string eq		ck_null		ifs	S S
+sne		string ne		ck_null		ifs	S S
+scmp		string comparison	ck_null		ifst	S S
+
+bit_and		bitwise and		ck_null		fst	S S
+bit_xor		bitwise xor		ck_null		fst	S S
+bit_or		bitwise or		ck_null		fst	S S
+
+negate		negate			ck_null		Ifst	S
+i_negate	integer negate		ck_null		ifst	S
+not		not			ck_null		ifs	S
+complement	1's complement		ck_null		fst	S
+
+# High falutin' math.
+
+atan2		atan2			ck_fun		fst	S S
+sin		sin			ck_fun		fstu	S?
+cos		cos			ck_fun		fstu	S?
+rand		rand			ck_fun		st	S?
+srand		srand			ck_fun		s	S?
+exp		exp			ck_fun		fstu	S?
+log		log			ck_fun		fstu	S?
+sqrt		sqrt			ck_fun		fstu	S?
+
+int		int			ck_fun		fstu	S?
+hex		hex			ck_fun		istu	S?
+oct		oct			ck_fun		istu	S?
+abs		abs			ck_fun		fstu	S?
+
+# String stuff.
+
+length		length			ck_lengthconst	istu	S?
+substr		substr			ck_fun		st	S S S?
+vec		vec			ck_fun		ist	S S S
+
+index		index			ck_index	ist	S S S?
+rindex		rindex			ck_index	ist	S S S?
+
+sprintf		sprintf			ck_fun		mst	S L
+formline	formline		ck_formline	ms	S L
+ord		ord			ck_fun		ifstu	S?
+chr		chr			ck_fun		fstu	S?
+crypt		crypt			ck_fun		fst	S S
+ucfirst		upper case first	ck_fun		fst	S
+lcfirst		lower case first	ck_fun		fst	S
+uc		upper case		ck_fun		fst	S
+lc		lower case		ck_fun		fst	S
+quotemeta	quote metachars		ck_fun		fst	S
+
+# Arrays.
+
+rv2av		array deref		ck_rvconst	dt	
+aelemfast	known array element	ck_null		s	A S
+aelem		array element		ck_null		s	A S
+aslice		array slice		ck_null		m	A L
+
+# Associative arrays.
+
+each		each			ck_fun		t	H
+values		values			ck_fun		t	H
+keys		keys			ck_fun		t	H
+delete		delete			ck_delete	s	S
+exists		exists operator		ck_delete	is	S
+rv2hv		associative array deref	ck_rvconst	dt	
+helem		associative array elem	ck_null		s	H S
+hslice		associative array slice	ck_null		m	H L
+
+# Explosives and implosives.
+
+unpack		unpack			ck_fun		0	S S
+pack		pack			ck_fun		mst	S L
+split		split			ck_split	t	S S S
+join		join			ck_fun		mst	S L
+
+# List operators.
+
+list		list			ck_null		m	L
+lslice		list slice		ck_null		0	H L L
+anonlist	anonymous list		ck_fun		ms	L
+anonhash	anonymous hash		ck_fun		ms	L
+
+splice		splice			ck_fun		m	A S? S? L
+push		push			ck_fun		imst	A L
+pop		pop			ck_shift	s	A
+shift		shift			ck_shift	s	A
+unshift		unshift			ck_fun		imst	A L
+sort		sort			ck_sort		m	C? L
+reverse		reverse			ck_fun		mt	L
+
+grepstart	grep			ck_grep		dm	C L
+grepwhile	grep iterator		ck_null		dt	
+
+mapstart	map			ck_grep		dm	C L
+mapwhile	map iterator		ck_null		dt
+
+# Range stuff.
+
+range		flipflop		ck_null		0	S S
+flip		range (or flip)		ck_null		0	S S
+flop		range (or flop)		ck_null		0
+
+# Control.
+
+and		logical and		ck_null		0	
+or		logical or		ck_null		0	
+xor		logical xor		ck_null		fs	S S	
+cond_expr	conditional expression	ck_null		d	
+andassign	logical and assignment	ck_null		s	
+orassign	logical or assignment	ck_null		s	
+
+method		method lookup		ck_null		d
+entersub	subroutine entry	ck_subr		dmt	L
+leavesub	subroutine exit		ck_null		0	
+caller		caller			ck_fun		t	S?
+warn		warn			ck_fun		imst	L
+die		die			ck_fun		dimst	L
+reset		reset			ck_fun		is	S?
+
+lineseq		line sequence		ck_null		0	
+nextstate	next statement		ck_null		s	
+dbstate		debug next statement	ck_null		s	
+unstack		unstack			ck_null		s
+enter		block entry		ck_null		0	
+leave		block exit		ck_null		0	
+scope		block			ck_null		0	
+enteriter	foreach loop entry	ck_null		d	
+iter		foreach loop iterator	ck_null		0	
+enterloop	loop entry		ck_null		d	
+leaveloop	loop exit		ck_null		0	
+return		return			ck_null		dm	L
+last		last			ck_null		ds	
+next		next			ck_null		ds	
+redo		redo			ck_null		ds	
+dump		dump			ck_null		ds	
+goto		goto			ck_null		ds	
+exit		exit			ck_fun		ds	S?
+
+#nswitch		numeric switch		ck_null		d	
+#cswitch		character switch	ck_null		d	
+
+# I/O.
+
+open		open			ck_fun		ist	F S?
+close		close			ck_fun		is	F?
+pipe_op		pipe			ck_fun		is	F F
+
+fileno		fileno			ck_fun		ist	F
+umask		umask			ck_fun		ist	S?
+binmode		binmode			ck_fun		s	F
+
+tie		tie			ck_fun		idms	R S L
+untie		untie			ck_fun		is	R
+tied		tied			ck_fun		s	R
+dbmopen		dbmopen			ck_fun		is	H S S
+dbmclose	dbmclose		ck_fun		is	H
+
+sselect		select system call	ck_select	t	S S S S
+select		select			ck_select	st	F?
+
+getc		getc			ck_eof		st	F?
+read		read			ck_fun		imst	F R S S?
+enterwrite	write			ck_fun		dis	F?
+leavewrite	write exit		ck_null		0	
+
+prtf		printf			ck_listiob	ims	F? L
+print		print			ck_listiob	ims	F? L
+
+sysopen		sysopen			ck_fun		s	F S S S?
+sysread		sysread			ck_fun		imst	F R S S?
+syswrite	syswrite		ck_fun		imst	F S S S?
+
+send		send			ck_fun		imst	F S S S?
+recv		recv			ck_fun		imst	F R S S
+
+eof		eof			ck_eof		is	F?
+tell		tell			ck_fun		st	F?
+seek		seek			ck_fun		s	F S S
+truncate	truncate		ck_trunc	is	S S
+
+fcntl		fcntl			ck_fun		st	F S S
+ioctl		ioctl			ck_fun		st	F S S
+flock		flock			ck_fun		ist	F S
+
+# Sockets.
+
+socket		socket			ck_fun		is	F S S S
+sockpair	socketpair		ck_fun		is	F F S S S
+
+bind		bind			ck_fun		is	F S
+connect		connect			ck_fun		is	F S
+listen		listen			ck_fun		is	F S
+accept		accept			ck_fun		ist	F F
+shutdown	shutdown		ck_fun		ist	F S
+
+gsockopt	getsockopt		ck_fun		is	F S S
+ssockopt	setsockopt		ck_fun		is	F S S S
+
+getsockname	getsockname		ck_fun		is	F
+getpeername	getpeername		ck_fun		is	F
+
+# Stat calls.
+
+lstat		lstat			ck_ftst		u	F
+stat		stat			ck_ftst		u	F
+ftrread		-R			ck_ftst		isu	F
+ftrwrite	-W			ck_ftst		isu	F
+ftrexec		-X			ck_ftst		isu	F
+fteread		-r			ck_ftst		isu	F
+ftewrite	-w			ck_ftst		isu	F
+fteexec		-x			ck_ftst		isu	F
+ftis		-e			ck_ftst		isu	F
+fteowned	-O			ck_ftst		isu	F
+ftrowned	-o			ck_ftst		isu	F
+ftzero		-z			ck_ftst		isu	F
+ftsize		-s			ck_ftst		istu	F
+ftmtime		-M			ck_ftst		stu	F
+ftatime		-A			ck_ftst		stu	F
+ftctime		-C			ck_ftst		stu	F
+ftsock		-S			ck_ftst		isu	F
+ftchr		-c			ck_ftst		isu	F
+ftblk		-b			ck_ftst		isu	F
+ftfile		-f			ck_ftst		isu	F
+ftdir		-d			ck_ftst		isu	F
+ftpipe		-p			ck_ftst		isu	F
+ftlink		-l			ck_ftst		isu	F
+ftsuid		-u			ck_ftst		isu	F
+ftsgid		-g			ck_ftst		isu	F
+ftsvtx		-k			ck_ftst		isu	F
+fttty		-t			ck_ftst		is	F
+fttext		-T			ck_ftst		isu	F
+ftbinary	-B			ck_ftst		isu	F
+
+# File calls.
+
+chdir		chdir			ck_fun		ist	S?
+chown		chown			ck_fun		imst	L
+chroot		chroot			ck_fun		istu	S?
+unlink		unlink			ck_fun		imstu	L
+chmod		chmod			ck_fun		imst	L
+utime		utime			ck_fun		imst	L
+rename		rename			ck_fun		ist	S S
+link		link			ck_fun		ist	S S
+symlink		symlink			ck_fun		ist	S S
+readlink	readlink		ck_fun		stu	S?
+mkdir		mkdir			ck_fun		ist	S S
+rmdir		rmdir			ck_fun		istu	S?
+
+# Directory calls.
+
+open_dir	opendir			ck_fun		is	F S
+readdir		readdir			ck_fun		0	F
+telldir		telldir			ck_fun		st	F
+seekdir		seekdir			ck_fun		s	F S
+rewinddir	rewinddir		ck_fun		s	F
+closedir	closedir		ck_fun		is	F
+
+# Process control.
+
+fork		fork			ck_null		ist	
+wait		wait			ck_null		ist	
+waitpid		waitpid			ck_fun		ist	S S
+system		system			ck_exec		imst	S? L
+exec		exec			ck_exec		dimst	S? L
+kill		kill			ck_fun		dimst	L
+getppid		getppid			ck_null		ist	
+getpgrp		getpgrp			ck_fun		ist	S?
+setpgrp		setpgrp			ck_fun		ist	S? S?
+getpriority	getpriority		ck_fun		ist	S S
+setpriority	setpriority		ck_fun		ist	S S S
+
+# Time calls.
+
+time		time			ck_null		ist	
+tms		times			ck_null		0	
+localtime	localtime		ck_fun		t	S?
+gmtime		gmtime			ck_fun		t	S?
+alarm		alarm			ck_fun		istu	S?
+sleep		sleep			ck_fun		ist	S?
+
+# Shared memory.
+
+shmget		shmget			ck_fun		imst	S S S
+shmctl		shmctl			ck_fun		imst	S S S
+shmread		shmread			ck_fun		imst	S S S S
+shmwrite	shmwrite		ck_fun		imst	S S S S
+
+# Message passing.
+
+msgget		msgget			ck_fun		imst	S S
+msgctl		msgctl			ck_fun		imst	S S S
+msgsnd		msgsnd			ck_fun		imst	S S S
+msgrcv		msgrcv			ck_fun		imst	S S S S S
+
+# Semaphores.
+
+semget		semget			ck_fun		imst	S S S
+semctl		semctl			ck_fun		imst	S S S S
+semop		semop			ck_fun		imst	S S
+
+# Eval.
+
+require		require			ck_require	du	S?
+dofile		do 'file'		ck_fun		d	S
+entereval	eval string		ck_eval		d	S
+leaveeval	eval exit		ck_null		0	S
+#evalonce	eval constant string	ck_null		d	S
+entertry	eval block		ck_null		0	
+leavetry	eval block exit		ck_null		0	
+
+# Get system info.
+
+ghbyname	gethostbyname		ck_fun		0	S
+ghbyaddr	gethostbyaddr		ck_fun		0	S S
+ghostent	gethostent		ck_null		0	
+gnbyname	getnetbyname		ck_fun		0	S
+gnbyaddr	getnetbyaddr		ck_fun		0	S S
+gnetent		getnetent		ck_null		0	
+gpbyname	getprotobyname		ck_fun		0	S
+gpbynumber	getprotobynumber	ck_fun		0	S
+gprotoent	getprotoent		ck_null		0	
+gsbyname	getservbyname		ck_fun		0	S S
+gsbyport	getservbyport		ck_fun		0	S S
+gservent	getservent		ck_null		0	
+shostent	sethostent		ck_fun		is	S
+snetent		setnetent		ck_fun		is	S
+sprotoent	setprotoent		ck_fun		is	S
+sservent	setservent		ck_fun		is	S
+ehostent	endhostent		ck_null		is	
+enetent		endnetent		ck_null		is	
+eprotoent	endprotoent		ck_null		is	
+eservent	endservent		ck_null		is	
+gpwnam		getpwnam		ck_fun		0	S
+gpwuid		getpwuid		ck_fun		0	S
+gpwent		getpwent		ck_null		0	
+spwent		setpwent		ck_null		is	
+epwent		endpwent		ck_null		is	
+ggrnam		getgrnam		ck_fun		0	S
+ggrgid		getgrgid		ck_fun		0	S
+ggrent		getgrent		ck_null		0	
+sgrent		setgrent		ck_null		is	
+egrent		endgrent		ck_null		is	
+getlogin	getlogin		ck_null		st	
+
+# Miscellaneous.
+
+syscall		syscall			ck_fun		imst	S L
diff --git a/gnu/usr.bin/perl/os2/Makefile.SHs b/gnu/usr.bin/perl/os2/Makefile.SHs
new file mode 100644
index 00000000000..bc99fd113b2
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/Makefile.SHs
@@ -0,0 +1,71 @@
+# This file is read by Makefile.SH to produce rules for $(perllib)
+# We insert perl5.def since I do not know how to generate it yet.
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+$(perllib): perl.imp perl.dll perl5.def
+	emximp -o $(perllib) perl.imp
+
+perl.imp: perl5.def
+	emximp -o perl.imp perl5.def
+
+perl.dll: $(obj) perl5.def perl$(OBJ_EXT)
+	$(LD) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) -lsocket perl5.def
+
+perl5.def: perl.linkexp
+	echo "LIBRARY 'Perl' INITINSTANCE TERMINSTANCE"	> $@
+	echo DESCRIPTION "'Perl interpreter, export autogenerated'"	>>$@
+	echo STACKSIZE 32768				>>$@
+	echo CODE LOADONCALL				>>$@
+	echo DATA LOADONCALL NONSHARED MULTIPLE		>>$@
+	echo EXPORTS					>>$@
+	echo '  "ctermid"'				>>$@
+	echo '  "Perl_OS2_init"'			>>$@
+	echo '  "OS2_Perl_data"'			>>$@
+!NO!SUBS!
+
+if [ ! -z "$myttyname" ] ; then
+  $spitshell >>Makefile <<'!NO!SUBS!'
+	echo '  "ttyname"'				>>$@
+!NO!SUBS!
+fi
+
+$spitshell >>Makefile <<'!NO!SUBS!'
+	cat perl.linkexp	>>$@
+
+#	grep -v '"\(malloc\|realloc\|free\)"' perl.linkexp	>>$@
+
+
+# We assume here that perl is available somewhere ...
+
+perl.exports: perl.exp EXTERN.h perl.h
+	(echo '#include "EXTERN.h"'; echo '#include "perl.h"' ; \
+			echo '#include "perl.exp"') | \
+		$(CC) -DEMBED  -E - | \
+		awk '{if ($$2 == "") print $$1}' | sort | uniq > $@
+
+#		perl -ne 'print if (/^#!/ .. /^#\s/) && s/^(\w+) *$$/$$1/' > $@
+
+perl.linkexp: perl.exports perl.map
+	cat perl.exports perl.map | sort | uniq -d | sed -e 's/\w\+/  "\0"/' > perl.linkexp
+
+perl.map: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT)
+	$(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o dummy.exe miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) -lsocket -lm -Zmap -Zlinker /map
+	awk '{if ($$3 == "") print $$2}' <dummy.map | sort | uniq > perl.map
+	rm dummy.exe dummy.map
+
+depend: os2ish.h
+
+# Stupid make? Needed...
+os2$(OBJ_EXT) : os2.c
+
+os2.c: os2/os2.c os2ish.h
+	cp $< $@
+
+os2ish.h: os2/os2ish.h
+	cp $< $@
+
+installcmd : 
+	perl -e 'die qq{Give the option INSTALLCMDDIR=... to make!} if $$ARGV[0] eq ""' $(INSTALLCMDDIR)
+	perl os2/perl2cmd.pl $(INSTALLCMDDIR)
+
+!NO!SUBS!
diff --git a/gnu/usr.bin/perl/os2/POSIX.mkfifo b/gnu/usr.bin/perl/os2/POSIX.mkfifo
new file mode 100644
index 00000000000..5bd820edfd1
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/POSIX.mkfifo
@@ -0,0 +1,16 @@
+diff -cr ..\perl5os2.patch\perl5.001m.andy/ext/POSIX/POSIX.xs ./ext/POSIX/POSIX.xs
+*** ../perl5os2.patch/perl5.001m.andy/ext/POSIX/POSIX.xs	Tue May 23 11:54:26 1995
+--- ./ext/POSIX/POSIX.xs	Thu Sep 28 00:00:16 1995
+***************
+*** 81,86 ****
+--- 81,90 ----
+  /* Possibly needed prototypes */
+  char *cuserid _((char *));
+  
++ #ifndef HAS_MKFIFO
++ #define mkfifo(a,b) not_here("mkfifo")
++ #endif
++ 
+  #ifndef HAS_CUSERID
+  #define cuserid(a) (char *) not_here("cuserid")
+  #endif
diff --git a/gnu/usr.bin/perl/os2/README b/gnu/usr.bin/perl/os2/README
new file mode 100644
index 00000000000..cd00a1f6032
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/README
@@ -0,0 +1,229 @@
+Current state of the patches here is with respect to perl5.002b1d ;-).
+
+========================================================
+
+The OS/2 patchkit was submitted by ilya@math.ohio-state.edu.  I have
+applied some parts that I suspect won't cause any problems.
+Others do things that I haven't had time to fully consider.
+
+Still other patches included here should perhaps be integrated with the
+metaconfig package that generates Configure.
+
+	Andy Dougherty		<doughera@lafcol.lafayette.edu>
+
+========================================================
+
+Notes on the patch:
+~~~~~~~~~~~~~~~~~~~
+patches should be applied as
+	patch -p0 <.....
+All the diff.* files and POSIX.mkfifo should be applied.
+
+Additional files are available on
+	ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2
+including patched pdksh and gnumake, needed for build.
+
+
+Target:
+~~~~~~~
+
+This is not supposed to make a perfect Perl on OS/2. This patch is
+concerned only with perfect _build_ of Perl on OS/2. A lot of good
+features from Andreas Kaiser port missed this patch.
+
+Annotations of changes: (part of what is below is already included by Andy,
+~~~~~~~~~~~~~~~~~~~~~~~ thus there are skips below)
+1) C files
+2) Configure
+3) MakeMaker
+4) Build tools
+
+1) C files
+	a) mkfifo macro added to Posix.c
+	b) Copyright notice for OS/2 port changed
+	c) MYMALLOC section in perl.h moved (why?)
+	d) setgrent grent and getgrent wrapped in ifdef
+	e) declarations for #if defined(MYMALLOC) && defined(HIDEMYMALLOC)
+		added
+	f) some diagnostics added to tests
+
+2) Configure 
+	b) Support for extraction from NE style libraries.
+	c) a lot of 
+			cc -o whatever
+		lines did not have $ldopts.
+	d) The above variables are used throughout the file for checks
+
+3) Build tools and libraries
+
+	
+	a) ln changed to $ln in some places
+	b) Makefiles and related scripts made to use $(O), $(A), $(AR)
+		using the vars found by Configure or defaulted to
+		some reasonable value.
+	c) $firstmakefile is the file make looks onto before Makefile
+	d) $plibext is the extension for the perl library
+	e) $archobjs is the list of additional object files needed for
+		local build.
+	l) Makefile.SH : added sh in front of some commands           
+	   if $d_shrplib is 'custom', looks into                      
+	        $osname/Makefile.$osname.SH to construct the section  
+	        on shared Perl library.            
+		!!!!!!	Also: installperl installman makedepend
+		!!!!!!		added as dependencies to the corresponding 
+		!!!!!!		targets.
+	m) clean target extended to delete some intermediate files    
+
+Notes on build on OS/2:
+~~~~~~~~~~~~~~~~~~~~~~~
+The change of C code in this patch is based on the ak port of 5.001+.
+
+a) Make sure your sort is not the broken OS/2 one, and that you have /tmp
+on the build partition.
+
+b) when extraction perl5.*.tar.gz you need to extract perl5.*/Configure
+separately, since by default perl5.001m/configure may overwrite it;
+	like this:
+		tar vzxf perl5.004.tar.gz --case-sensitive perl5.004/Configure
+
+c) Necessary manual intervention when compiling on OS/2:
+
+	Need to put perl.dll on LIBPATH after it is created.
+
+d) Compile summary:
+
+# Look for hints/os2.sh and correct what is different on your system
+# I have rather spartan configuration.
+
+	# Prefix means where to install:
+sh Configure -des -D prefix=f:/perl5.005
+make
+	# Will probably die after build of miniperl (unless you have DLL
+	# from previous compile). Need to move DLL where it belongs
+	#
+	# Somehow with 5.002b3 I needed to type another make after pod2man
+make
+	# some warnings in POSIX.c
+make test
+	# some tests fail, 9 or 10 on my system (see the list at end).
+	#
+	# before this you should create subdirs bin and lib in the 
+	# prefix directory (f:/perl5.005 above):
+make install
+
+e) At the end of August GNU make and pdksh were too buggy for compile.
+Both maintainers have patches that make it possible to compile perl.
+The binaries are included in
+	ftp://ftp.math.ohio-state.edu/pub/users/ilya/os2
+patches are available too.
+Note that the pdksh5.2.4 broke builds with -Zexe option because of a
+changed order of executable extensions. A patch is sent to maintainer.
+
+!!!!!!!!!!!!!!!!!
+If you see that some '/' became '\' in pdksh 5.2.3, you did not apply
+my patches!
+Same with segfaults in Make 3.74.
+!!!!!!!!!!!!!!!!!
+
+Problems reported: 
+
+a) one of the latest tr is broken, get an old one :-(
+	1.11 works. (On compuserver?)
+b) You need a perlglob.exe and link386.
+c) Get rid of invalid perl.dll on your LIBPATH.
+
+
+Send comments to ilya@math.ohio-state.edu.
+
+======================================================
+Requires 0.9b (well, provision are made to make it build under 0.9a6,
+but they are not tested, please inform me on success).
+(earlier than 0.9b ttyname was not present, it is hard to maintain this
+difference automatically, though I try).
+======================================================
+
+You may try building with a.out style by using `-D emxaout' on the Configure
+line (dynamic extensions should not use CRT (and/or any perl API) in this
+case, which prohibits most buildin extensions). Probably no extension is
+possible, since boot code should return the amount on stack.
+
+The reason why compiling with a.out style executables leads to problems
+with dynamic extensions is:
+	a) OS/2 does not export symbols from executables;
+	b) Thus if extension needs to import symbols from an application
+		the symbols for the application should reside in a .dll.
+	c) You cannot export data from a .dll compiled with a.out style.
+On the other hand, aout-style compiled extension enjoys all the 
+(dis)advantages of fork().
+
+======================================================
+Tests which fail with OMF compile:
+
+io/fs.t: 2-5, 7-11, 18  as they should.
+io/pipe: all, since open("|-") is not working (even with fork, so far).
+lib/"all the dbm".t: 1 test should fail (file permission).
+op/fork all fail, as they should
+op/stat 3 20 35 as they should, 39 (-t on /dev/null) ???? Sometimes 4 ????
+
+Segfault in socket ????, only if run with Testing tools.
+
+A lot of `bad free'... in databases, bug in DB confirmed on other
+platforms.
+
+Fail: Total 30 subtests (if stat:4 fails) in 10 scripts (one of 10
+is socket, which runs OK standalone).
+
+=======================================================
+
+Changes to calls to external programs:
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Due to a popular demand the perl external program calling has been changed.
+_If_ perl needs to call an external program via shell, the sh.exe will be
+called. The name of the shell is not overridable.
+
+Thus means that you need to pickup some copy of a sh.exe as well (I use one
+from pdksh).
+
+Reasons: a consensus on perl5-porters was that perl should use one 
+non-overridable shell per platform. The obvious choices for OS/2 are cmd.exe
+and sh.exe. Having perl build itself would be impossible with cmd.exe as
+a shell, thus I picked up sh.exe. Thus assures almost 100% compatibility
+with the scripts coming from *nix.
+
+Disadvantages: sh.exe calls external programs via fork/exec, and there is
+_no_ functioning exec on OS/2. exec is emulated by EMX by asyncroneous call
+while the caller waits for child completion (to pretend that pid did
+not change). This means that 1 _extra_ copy of sh.exe is made active via
+fork/exec, which may lead to some resources taken from the system.
+
+The long-term solution proposed on p5-p is to have a directive
+	use OS2::Cmd;
+which will override system(), exec(), ``, and open(,'   |'). With current
+perl you may override only system(), readpipe() - the explicit version
+of ``, and maybe exec(). The code will substitute a one-argument system
+by CORE::system('cmd.exe', '/c', shift).
+
+If you have some working code for OS2::Cmd.pm, please send it to me,
+I will include it into distribution. I have no need for such a module, so
+cannot test it.
+
+===================================================
+
+OS/2 extensions
+~~~~~~~~~~~~~~~
+I include 3 extensions by Andread Kaiser, OS2::REXX, OS2::UPM, and OS2::FTP, 
+into my ftp directory, mirrored on CPAN. I made
+some minor changes needed to compile them by standard tools. I cannot 
+test UPM and FTP, so I will appreciate your feedback.
+
+The -R switch of older perl is deprecated. If you need to call a REXX code
+which needs access to variables, include the call into a REXX compartment
+created by 
+	REXX_call {...block...};
+
+Two new functions are supported by REXX code, 
+	REXX_eval 'string';
+	REXX_eval_with 'string', REXX_function_name => \&perl_sub_reference;
+
+If you have some other extensions you want to share, send the code to me.
+Two jump to mind: tied access to EA's, and tied access to system databases.
diff --git a/gnu/usr.bin/perl/os2/diff.configure b/gnu/usr.bin/perl/os2/diff.configure
new file mode 100644
index 00000000000..53aa16b4a2e
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/diff.configure
@@ -0,0 +1,589 @@
+*** Configure.orig	Thu Dec 07 14:38:08 1995
+--- Configure	Mon Dec 18 19:16:22 1995
+***************
+*** 1377,1383 ****
+  	*)
+  		echo "I don't know where '$file' is, and my life depends on it." >&4
+  		echo "Go find a public domain implementation or fix your PATH setting!" >&4
+! 		exit 1
+  		;;
+  	esac
+  done
+--- 1377,1383 ----
+  	*)
+  		echo "I don't know where '$file' is, and my life depends on it." >&4
+  		echo "Go find a public domain implementation or fix your PATH setting!" >&4
+! 		#exit 1
+  		;;
+  	esac
+  done
+***************
+*** 1386,1392 ****
+  say=offhand
+  for file in $trylist; do
+  	xxx=`./loc $file $file $pth`
+! 	eval $file=$xxx
+  	eval _$file=$xxx
+  	case "$xxx" in
+  	/*)
+--- 1386,1394 ----
+  say=offhand
+  for file in $trylist; do
+  	xxx=`./loc $file $file $pth`
+! 	if test "X$file" != "X$xxx" ; then
+! 		eval $file=$xxx
+! 	fi
+  	eval _$file=$xxx
+  	case "$xxx" in
+  	/*)
+***************
+*** 3173,3179 ****
+  	exit(0);
+  }
+  EOM
+! if $cc -o gccvers gccvers.c >/dev/null 2>&1; then
+  	gccversion=`./gccvers`
+  	case "$gccversion" in
+  	'') echo "You are not using GNU cc." ;;
+--- 3175,3181 ----
+  	exit(0);
+  }
+  EOM
+! if $cc -o gccvers gccvers.c $ldflags  >/dev/null 2>&1; then
+  	gccversion=`./gccvers`
+  	case "$gccversion" in
+  	'') echo "You are not using GNU cc." ;;
+***************
+*** 3765,3770 ****
+--- 3767,3778 ----
+  		*"-l$thislib "*);;
+  		*) dflt="$dflt -l$thislib";;
+  		esac
++ 	elif xxx=`./loc $thislib.lib X $libpth`; $test -f "$xxx"; then
++ 		echo "Found -l$thislib."
++ 		case " $dflt " in
++ 		*"-l$thislib "*);;
++ 		*) dflt="$dflt -l$thislib";;
++ 		esac
+  	else
+  		echo "No -l$thislib."
+  	fi
+***************
+*** 3864,3870 ****
+  	esac
+  	;;
+  esac
+! libnames='';
+  case "$libs" in
+  '') ;;
+  *)  for thislib in $libs; do
+--- 3872,3878 ----
+  	esac
+  	;;
+  esac
+! #libnames='';
+  case "$libs" in
+  '') ;;
+  *)  for thislib in $libs; do
+***************
+*** 3878,3889 ****
+  			:
+  		elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then
+  			:
+! 		elif try=`./loc lib$thislib.a X $libpth`; $test -f "$try"; then
+  			:
+  		elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then
+  			:
+  		elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
+  			:
+  		elif try=`./loc Slib$thislib.a X $xlibpth`; $test -f "$try"; then
+  			:
+  		else
+--- 3886,3899 ----
+  			:
+  		elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then
+  			:
+! 		elif try=`./loc lib$thislib$lib_ext X $libpth`; $test -f "$try"; then
+  			:
+  		elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then
+  			:
+  		elif try=`./loc $thislib X $libpth`; $test -f "$try"; then
+  			:
++ 		elif try=`./loc $thislib$lib_ext X $libpth`; $test -f "$try"; then
++ 			:
+  		elif try=`./loc Slib$thislib.a X $xlibpth`; $test -f "$try"; then
+  			:
+  		else
+***************
+*** 3932,3942 ****
+  	fi
+  elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then
+  	echo "Your C library seems to be in $libc, as you said before."
+! elif $test -r $incpath/usr/lib/libc.a; then
+! 	libc=$incpath/usr/lib/libc.a;
+  	echo "Your C library seems to be in $libc.  That's fine."
+! elif $test -r /lib/libc.a; then
+! 	libc=/lib/libc.a;
+  	echo "Your C library seems to be in $libc.  You're normal."
+  else
+  	if tans=`./loc libc.a blurfl/dyick $libpth`; $test -r "$tans"; then
+--- 3942,3952 ----
+  	fi
+  elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then
+  	echo "Your C library seems to be in $libc, as you said before."
+! elif $test -r $incpath/usr/lib/libc$lib_ext; then
+! 	libc=$incpath/usr/lib/libc$lib_ext;
+  	echo "Your C library seems to be in $libc.  That's fine."
+! elif $test -r /lib/libc$lib_ext; then
+! 	libc=/lib/libc$lib_ext;
+  	echo "Your C library seems to be in $libc.  You're normal."
+  else
+  	if tans=`./loc libc.a blurfl/dyick $libpth`; $test -r "$tans"; then
+***************
+*** 4049,4054 ****
+--- 4059,4068 ----
+  	eval $xscan;\
+  	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
+  		eval $xrun
++ elif com="$sed -n -e 's/^[-0-9a-f ]*_\(.*\)=.*/\1/p'";\
++ 	eval $xscan;\
++ 	$contains '^fprintf$' libc.list >/dev/null 2>&1; then
++ 		eval $xrun
+  else
+  	nm -p $* 2>/dev/null >libc.tmp
+  	$grep fprintf libc.tmp > libc.ptf
+***************
+*** 4059,4081 ****
+  		eval $xrun
+  	else
+  		echo " "
+! 		echo "nm didn't seem to work right. Trying ar instead..." >&4
+  		com=''
+! 		if ar t $libc > libc.tmp; then
+  			for thisname in $libnames; do
+! 				ar t $thisname >>libc.tmp
+  			done
+! 			$sed -e 's/\.o$//' < libc.tmp > libc.list
+  			echo "Ok." >&4
+  		else
+! 			echo "ar didn't seem to work right." >&4
+  			echo "Maybe this is a Cray...trying bld instead..." >&4
+  			if bld t $libc | $sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list
+  			then
+  				for thisname in $libnames; do
+  					bld t $libnames | \
+  					$sed -e 's/.*\///' -e 's/\.o:.*$//' >>libc.list
+! 					ar t $thisname >>libc.tmp
+  				done
+  				echo "Ok." >&4
+  			else
+--- 4073,4096 ----
+  		eval $xrun
+  	else
+  		echo " "
+! 		echo "nm didn't seem to work right. Trying $ar instead..." >&4
+  		com=''
+! 		if test "X$osname" = "Xos2"; then ar_opt=tv ; else ar_opt=t ;fi
+! 		if $ar $ar_opt $libc > libc.tmp; then
+  			for thisname in $libnames; do
+! 				$ar $ar_opt $thisname >>libc.tmp
+  			done
+! 			$sed -e 's/\.o$//' -e 's/^ \+//' < libc.tmp | grep -v "^IMPORT#" > libc.list
+  			echo "Ok." >&4
+  		else
+! 			echo "$ar didn't seem to work right." >&4
+  			echo "Maybe this is a Cray...trying bld instead..." >&4
+  			if bld t $libc | $sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list
+  			then
+  				for thisname in $libnames; do
+  					bld t $libnames | \
+  					$sed -e 's/.*\///' -e 's/\.o:.*$//' >>libc.list
+! 					$ar t $thisname >>libc.tmp
+  				done
+  				echo "Ok." >&4
+  			else
+***************
+*** 4421,4427 ****
+  	exit(0);
+  }
+  EOCP
+! 	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+  		intsize=`./try`
+  		echo "Your integers are $intsize bytes long."
+  	else
+--- 4436,4442 ----
+  	exit(0);
+  }
+  EOCP
+! 	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+  		intsize=`./try`
+  		echo "Your integers are $intsize bytes long."
+  	else
+***************
+*** 4501,4507 ****
+  	exit(result);
+  }
+  EOCP
+! if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+  	./try
+  	yyy=$?
+  else
+--- 4516,4522 ----
+  	exit(result);
+  }
+  EOCP
+! if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
+  	./try
+  	yyy=$?
+  else
+***************
+*** 4582,4588 ****
+  
+  }
+  EOCP
+! if $cc -o try $ccflags try.c >/dev/null 2>&1; then
+  	./try
+  	castflags=$?
+  else
+--- 4597,4603 ----
+  
+  }
+  EOCP
+! if $cc -o try $ccflags try.c $ldflags >/dev/null 2>&1; then
+  	./try
+  	castflags=$?
+  else
+***************
+*** 4621,4627 ****
+  	exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
+  }
+  EOF
+! 	if $cc $ccflags vprintf.c -o vprintf >/dev/null 2>&1 && ./vprintf; then
+  		echo "Your vsprintf() returns (int)." >&4
+  		val2="$undef"
+  	else
+--- 4636,4642 ----
+  	exit((unsigned long)vsprintf(buf,"%s",args) > 10L);
+  }
+  EOF
+! 	if $cc $ccflags vprintf.c $ldflags -o vprintf >/dev/null 2>&1 && ./vprintf; then
+  		echo "Your vsprintf() returns (int)." >&4
+  		val2="$undef"
+  	else
+***************
+*** 4691,4697 ****
+  		cryptlib=-lcrypt
+  	fi
+  	if $test -z "$cryptlib"; then
+! 		cryptlib=`./loc libcrypt.a "" $libpth`
+  	else
+  		cryptlib=-lcrypt
+  	fi
+--- 4706,4712 ----
+  		cryptlib=-lcrypt
+  	fi
+  	if $test -z "$cryptlib"; then
+! 		cryptlib=`./loc libcrypt$lib_ext "" $libpth`
+  	else
+  		cryptlib=-lcrypt
+  	fi
+***************
+*** 5198,5204 ****
+  }
+  EOM
+  	if $cc $ccflags $cccdlflags -c dyna.c > /dev/null 2>&1 && 
+! 		$ld $lddlflags -o dyna.$dlext dyna.o > /dev/null 2>&1 && 
+  		$cc $ccflags $ldflags $cccdlflags $ccdlflags fred.c -o fred $libs > /dev/null 2>&1; then
+  		xxx=`./fred`
+  		case $xxx in
+--- 5213,5219 ----
+  }
+  EOM
+  	if $cc $ccflags $cccdlflags -c dyna.c > /dev/null 2>&1 && 
+! 		$ld $lddlflags -o dyna.$dlext dyna$obj_ext > /dev/null 2>&1 && 
+  		$cc $ccflags $ldflags $cccdlflags $ccdlflags fred.c -o fred $libs > /dev/null 2>&1; then
+  		xxx=`./fred`
+  		case $xxx in
+***************
+*** 5355,5361 ****
+  EOCP
+  : check sys/file.h first to get FREAD on Sun
+  if $test `./findhdr sys/file.h` && \
+! 		$cc $cppflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then
+  	h_sysfile=true;
+  	echo "<sys/file.h> defines the O_* constants..." >&4
+  	if ./open3; then
+--- 5370,5376 ----
+  EOCP
+  : check sys/file.h first to get FREAD on Sun
+  if $test `./findhdr sys/file.h` && \
+! 		$cc $cppflags $ldflags "-DI_SYS_FILE" open3.c -o open3 >/dev/null 2>&1 ; then
+  	h_sysfile=true;
+  	echo "<sys/file.h> defines the O_* constants..." >&4
+  	if ./open3; then
+***************
+*** 5366,5372 ****
+  		val="$undef"
+  	fi
+  elif $test `./findhdr fcntl.h` && \
+! 		$cc "-DI_FCNTL" open3.c -o open3 >/dev/null 2>&1 ; then
+  	h_fcntl=true;
+  	echo "<fcntl.h> defines the O_* constants..." >&4
+  	if ./open3; then
+--- 5381,5387 ----
+  		val="$undef"
+  	fi
+  elif $test `./findhdr fcntl.h` && \
+! 		$cc "-DI_FCNTL" $ldflags open3.c -o open3 >/dev/null 2>&1 ; then
+  	h_fcntl=true;
+  	echo "<fcntl.h> defines the O_* constants..." >&4
+  	if ./open3; then
+***************
+*** 5848,5854 ****
+  y*|true)
+  	usemymalloc='y'
+  	mallocsrc='malloc.c'
+! 	mallocobj='malloc.o'
+  	d_mymalloc="$define"
+  	case "$libs" in
+  	*-lmalloc*)
+--- 5863,5869 ----
+  y*|true)
+  	usemymalloc='y'
+  	mallocsrc='malloc.c'
+! 	mallocobj="malloc$obj_ext"
+  	d_mymalloc="$define"
+  	case "$libs" in
+  	*-lmalloc*)
+***************
+*** 6283,6292 ****
+  		: we will have to assume that it supports the 4.2 BSD interface
+  		d_oldsock="$undef"
+  	else
+! 		echo "You don't have Berkeley networking in libc.a..." >&4
+! 		if test -f /usr/lib/libnet.a; then
+! 			( (nm $nm_opt /usr/lib/libnet.a | eval $nm_extract) ||  \
+! 			ar t /usr/lib/libnet.a) 2>/dev/null >> libc.list
+  			if $contains socket libc.list >/dev/null 2>&1; then
+  			echo "...but the Wollongong group seems to have hacked it in." >&4
+  				socketlib="-lnet"
+--- 6298,6307 ----
+  		: we will have to assume that it supports the 4.2 BSD interface
+  		d_oldsock="$undef"
+  	else
+! 		echo "You don't have Berkeley networking in libc$lib_ext..." >&4
+! 		if test -f /usr/lib/libnet$lib_ext; then
+! 			( (nm $nm_opt /usr/lib/libnet$lib_ext | eval $nm_extract) ||  \
+! 			$ar t /usr/lib/libnet$lib_ext) 2>/dev/null >> libc.list
+  			if $contains socket libc.list >/dev/null 2>&1; then
+  			echo "...but the Wollongong group seems to have hacked it in." >&4
+  				socketlib="-lnet"
+***************
+*** 6299,6305 ****
+  					d_oldsock="$define"
+  				fi
+  			else
+! 				echo "or even in libnet.a, which is peculiar." >&4
+  				d_socket="$undef"
+  				d_oldsock="$undef"
+  			fi
+--- 6314,6320 ----
+  					d_oldsock="$define"
+  				fi
+  			else
+! 				echo "or even in libnet$lib_ext, which is peculiar." >&4
+  				d_socket="$undef"
+  				d_oldsock="$undef"
+  			fi
+***************
+*** 7055,7061 ****
+  	printf("%d\n", (char *)&try.bar - (char *)&try.foo);
+  }
+  EOCP
+! 	if $cc $ccflags try.c -o try >/dev/null 2>&1; then
+  		dflt=`./try`
+  	else
+  		dflt='8'
+--- 7070,7076 ----
+  	printf("%d\n", (char *)&try.bar - (char *)&try.foo);
+  }
+  EOCP
+! 	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1; then
+  		dflt=`./try`
+  	else
+  		dflt='8'
+***************
+*** 7080,7086 ****
+  '') obj_ext='.o';;
+  esac
+  case "$path_sep" in
+! '') path_sep=':';;
+  esac
+  : Which makefile gets called first.  This is used by make depend.
+  case "$firstmakefile" in
+--- 7095,7101 ----
+  '') obj_ext='.o';;
+  esac
+  case "$path_sep" in
+! '') path_sep="$p_";;
+  esac
+  : Which makefile gets called first.  This is used by make depend.
+  case "$firstmakefile" in
+***************
+*** 7120,7126 ****
+  }
+  EOCP
+  	xxx_prompt=y
+! 	if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+  		dflt=`./try`
+  		case "$dflt" in
+  		[1-4][1-4][1-4][1-4]|12345678|87654321)
+--- 7135,7141 ----
+  }
+  EOCP
+  	xxx_prompt=y
+! 	if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+  		dflt=`./try`
+  		case "$dflt" in
+  		[1-4][1-4][1-4][1-4]|12345678|87654321)
+***************
+*** 7470,7476 ****
+  	printf("%d\n",i);
+  }
+  EOCP
+! 	if $cc try.c -o try >/dev/null 2>&1 ; then
+  		dflt=`try`
+  	else
+  		dflt='?'
+--- 7485,7491 ----
+  	printf("%d\n",i);
+  }
+  EOCP
+! 	if $cc $ldflags try.c -o try >/dev/null 2>&1 ; then
+  		dflt=`try`
+  	else
+  		dflt='?'
+***************
+*** 7497,7514 ****
+  $cc $ccflags -c bar1.c >/dev/null 2>&1
+  $cc $ccflags -c bar2.c >/dev/null 2>&1
+  $cc $ccflags -c foo.c >/dev/null 2>&1
+! ar rc bar.a bar2.o bar1.o >/dev/null 2>&1
+! if $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+  	./foobar >/dev/null 2>&1; then
+! 	echo "ar appears to generate random libraries itself."
+  	orderlib=false
+  	ranlib=":"
+! elif ar ts bar.a >/dev/null 2>&1 &&
+! 	$cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 &&
+  	./foobar >/dev/null 2>&1; then
+  		echo "a table of contents needs to be added with 'ar ts'."
+  		orderlib=false
+! 		ranlib="ar ts"
+  else
+  	case "$ranlib" in
+  	:) ranlib='';;
+--- 7512,7529 ----
+  $cc $ccflags -c bar1.c >/dev/null 2>&1
+  $cc $ccflags -c bar2.c >/dev/null 2>&1
+  $cc $ccflags -c foo.c >/dev/null 2>&1
+! $ar rc bar$lib_ext bar2$obj_ext bar1$obj_ext >/dev/null 2>&1
+! if $cc $ccflags $ldflags -o foobar foo$obj_ext bar$lib_ext $libs > /dev/null 2>&1 &&
+  	./foobar >/dev/null 2>&1; then
+! 	echo "$ar appears to generate random libraries itself."
+  	orderlib=false
+  	ranlib=":"
+! elif $ar ts bar$lib_ext >/dev/null 2>&1 &&
+! 	$cc $ccflags $ldflags -o foobar foo$obj_ext bar$lib_ext $libs > /dev/null 2>&1 &&
+  	./foobar >/dev/null 2>&1; then
+  		echo "a table of contents needs to be added with 'ar ts'."
+  		orderlib=false
+! 		ranlib="$ar ts"
+  else
+  	case "$ranlib" in
+  	:) ranlib='';;
+***************
+*** 7580,7586 ****
+  	'') $echo $n ".$c"
+  		if $cc $ccflags \
+  		$i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
+! 		try.c -o try >/dev/null 2>&1 ; then
+  			set X $i_time $i_systime $i_systimek $sysselect $s_timeval
+  			shift
+  			flags="$*"
+--- 7595,7601 ----
+  	'') $echo $n ".$c"
+  		if $cc $ccflags \
+  		$i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \
+! 		try.c -o try $ldflags >/dev/null 2>&1 ; then
+  			set X $i_time $i_systime $i_systimek $sysselect $s_timeval
+  			shift
+  			flags="$*"
+***************
+*** 7649,7655 ****
+  #endif
+  }
+  EOCP
+! if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+  	d_fds_bits="$define"
+  	d_fd_set="$define"
+  	echo "Well, your system knows about the normal fd_set typedef..." >&4
+--- 7664,7670 ----
+  #endif
+  }
+  EOCP
+! if $cc $ccflags $ldflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+  	d_fds_bits="$define"
+  	d_fd_set="$define"
+  	echo "Well, your system knows about the normal fd_set typedef..." >&4
+***************
+*** 7666,7672 ****
+  	$cat <<'EOM'
+  Hmm, your compiler has some difficulty with fd_set.  Checking further...
+  EOM
+! 	if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+  		d_fds_bits="$undef"
+  		d_fd_set="$define"
+  		echo "Well, your system has some sort of fd_set available..." >&4
+--- 7681,7687 ----
+  	$cat <<'EOM'
+  Hmm, your compiler has some difficulty with fd_set.  Checking further...
+  EOM
+! 	if $cc $ccflags $ldflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then
+  		d_fds_bits="$undef"
+  		d_fd_set="$define"
+  		echo "Well, your system has some sort of fd_set available..." >&4
+***************
+*** 8380,8386 ****
+  else
+  	echo "false"
+  fi
+! $rm -f varargs.o
+  EOP
+  chmod +x varargs
+  
+--- 8395,8401 ----
+  else
+  	echo "false"
+  fi
+! $rm -f varargs$obj_ext
+  EOP
+  chmod +x varargs
+  
+***************
+*** 8744,8750 ****
+  	echo " "
+  	echo "Stripping down executable paths..." >&4
+  	for file in $loclist $trylist; do
+! 		eval $file="\$file"
+  	done
+  	;;
+  esac
+--- 8759,8765 ----
+  	echo " "
+  	echo "Stripping down executable paths..." >&4
+  	for file in $loclist $trylist; do
+! 		if test X$file != Xln -o X$osname != Xos2; then eval $file="\$file"; fi
+  	done
+  	;;
+  esac
diff --git a/gnu/usr.bin/perl/os2/diff.db_file b/gnu/usr.bin/perl/os2/diff.db_file
new file mode 100644
index 00000000000..7fcca0a7933
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/diff.db_file
@@ -0,0 +1,15 @@
+*** ext/DB_File/db_file.xs~	Tue Nov 14 11:14:36 1995
+--- ext/DB_File/DB_File.xs	Tue Dec 19 00:50:52 1995
+***************
+*** 424,429 ****
+--- 424,433 ----
+      }
+  
+  
++ #ifdef __EMX__
++     flags |= O_BINARY;
++ #endif /* __EMX__ */
++ 
+      RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
+  
+  #if 0
diff --git a/gnu/usr.bin/perl/os2/notes b/gnu/usr.bin/perl/os2/notes
new file mode 100644
index 00000000000..f8591878b6d
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/notes
@@ -0,0 +1,28 @@
+mv Makefile.SH Makefile.SHs
+exit 0
+
+Everything is updated to perl5.002b1d.
+
+I added a generally useful ;-) code to Makefile.SH to have dependencies
+on makedepend, installman and installperl (makedepend is the tricky one!).
+
+I did update MANIFEST with _all_ the added diff.* files, I hope
+some files will be just applied, thus not needed for MANIFEST. Well, the 
+patch for MANIFEST is in os2/diff.MANIFEST ;-).
+
+diff.init is just a suggestion to move system-specific code into headers.
+
+I think that 
+
+diff.Makefile 
+diff.installperl 
+diff.installman 
+diff.x2pMakefile
+diff.mkdep
+
+are ready for prime time, though big ;-(. 
+It is up to you what to do with them (They use long names like EXE_EXT now).
+
+diff.c2ph, diff.rest are small and should not break anything.
+
+diff.db_file adds binary mode.
diff --git a/gnu/usr.bin/perl/os2/os2.c b/gnu/usr.bin/perl/os2/os2.c
new file mode 100644
index 00000000000..a518c41d45f
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/os2.c
@@ -0,0 +1,384 @@
+#define INCL_DOS
+#define INCL_NOPM
+#define INCL_DOSFILEMGR
+#ifndef NO_SYS_ALLOC 
+#  define INCL_DOSMEMMGR
+#  define INCL_DOSERRORS
+#endif /* ! defined NO_SYS_ALLOC */
+#include <os2.h>
+
+/*
+ * Various Unix compatibility functions for OS/2
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <limits.h>
+#include <process.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/*****************************************************************************/
+/* priorities */
+
+int setpriority(int which, int pid, int val)
+{
+  return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS,
+			val >> 8, val & 0xFF, abs(pid));
+}
+
+int getpriority(int which /* ignored */, int pid)
+{
+  TIB *tib;
+  PIB *pib;
+  DosGetInfoBlocks(&tib, &pib);
+  return tib->tib_ptib2->tib2_ulpri;
+}
+
+/*****************************************************************************/
+/* spawn */
+
+static int
+result(int flag, int pid)
+{
+	int r, status;
+	Signal_t (*ihand)();     /* place to save signal during system() */
+	Signal_t (*qhand)();     /* place to save signal during system() */
+
+	if (pid < 0 || flag != 0) 
+		return pid;
+
+	ihand = signal(SIGINT, SIG_IGN);
+	qhand = signal(SIGQUIT, SIG_IGN);
+	do {
+	    r = wait4pid(pid, &status, 0);
+	} while (r == -1 && errno == EINTR);
+	signal(SIGINT, ihand);
+	signal(SIGQUIT, qhand);
+
+	statusvalue = (U16)status;
+	if (r < 0)
+		return -1;
+	return status & 0xFFFF;
+}
+
+int
+do_aspawn(really,mark,sp)
+SV *really;
+register SV **mark;
+register SV **sp;
+{
+    register char **a;
+    char *tmps;
+    int rc;
+    int flag = P_WAIT, trueflag;
+
+    if (sp > mark) {
+	New(401,Argv, sp - mark + 1, char*);
+	a = Argv;
+
+	if (mark < sp && SvIOKp(*(mark+1))) {
+		++mark;
+		flag = SvIVx(*mark);
+	}
+
+	while (++mark <= sp) {
+	    if (*mark)
+		*a++ = SvPVx(*mark, na);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+
+	trueflag = flag;
+	if (flag == P_WAIT)
+		flag = P_NOWAIT;
+
+	if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */
+	    TAINT_ENV();	/* testing IFS here is overkill, probably */
+	if (really && *(tmps = SvPV(really, na)))
+	    rc = result(trueflag, spawnvp(flag,tmps,Argv));
+	else
+	    rc = result(trueflag, spawnvp(flag,Argv[0],Argv));
+
+	if (rc < 0 && dowarn)
+	    warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
+	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+    } else
+    	rc = -1;
+    do_execfree();
+    return rc;
+}
+
+int
+do_spawn(cmd)
+char *cmd;
+{
+    register char **a;
+    register char *s;
+    char flags[10];
+    char *shell, *copt;
+    int rc;
+
+#ifdef TRYSHELL
+    if ((shell = getenv("EMXSHELL")) != NULL)
+    	copt = "-c";
+    else if ((shell = getenv("SHELL")) != NULL)
+    	copt = "-c";
+    else if ((shell = getenv("COMSPEC")) != NULL)
+    	copt = "/C";
+    else
+    	shell = "cmd.exe";
+#else
+    /* Consensus on perl5-porters is that it is _very_ important to
+       have a shell which will not change between computers with the
+       same architecture, to avoid "action on a distance". 
+       And to have simple build, this shell should be sh. */
+    shell = "sh.exe";
+    copt = "-c";
+#endif 
+
+    while (*cmd && isSPACE(*cmd))
+	cmd++;
+
+    /* save an extra exec if possible */
+    /* see if there are shell metacharacters in it */
+
+    if (*cmd == '.' && isSPACE(cmd[1]))
+	goto doshell;
+
+    if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
+	goto doshell;
+
+    for (s = cmd; *s && isALPHA(*s); s++) ;	/* catch VAR=val gizmo */
+    if (*s == '=')
+	goto doshell;
+
+    for (s = cmd; *s; s++) {
+	if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+	    if (*s == '\n' && !s[1]) {
+		*s = '\0';
+		break;
+	    }
+	  doshell:
+	    rc = result(P_WAIT,
+			  spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0));
+	    if (rc < 0 && dowarn)
+		warn("Can't spawn \"%s\": %s", shell, Strerror(errno));
+	    if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+	    return rc;
+	}
+    }
+
+    New(402,Argv, (s - cmd) / 2 + 2, char*);
+    Cmd = savepvn(cmd, s-cmd);
+    a = Argv;
+    for (s = Cmd; *s;) {
+	while (*s && isSPACE(*s)) s++;
+	if (*s)
+	    *(a++) = s;
+	while (*s && !isSPACE(*s)) s++;
+	if (*s)
+	    *s++ = '\0';
+    }
+    *a = Nullch;
+    if (Argv[0]) {
+	rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv));
+	if (rc < 0 && dowarn)
+	    warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno));
+	if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */
+    } else
+    	rc = -1;
+    do_execfree();
+    return rc;
+}
+
+FILE *
+my_popen(cmd,mode)
+char	*cmd;
+char	*mode;
+{
+    char *shell = getenv("EMXSHELL");
+    FILE *res;
+    
+    my_setenv("EMXSHELL", "sh.exe");
+    res = popen(cmd, mode);
+    my_setenv("EMXSHELL", shell);
+    return res;
+}
+
+/*****************************************************************************/
+
+#ifndef HAS_FORK
+int
+fork(void)
+{
+    die(no_func, "Unsupported function fork");
+    errno = EINVAL;
+    return -1;
+}
+#endif
+
+/*****************************************************************************/
+/* not implemented in EMX 0.9a */
+
+void *	ctermid(x)	{ return 0; }
+
+#ifdef MYTTYNAME /* was not in emx0.9a */
+void *	ttyname(x)	{ return 0; }
+#endif
+
+void *	gethostent()	{ return 0; }
+void *	getnetent()	{ return 0; }
+void *	getprotoent()	{ return 0; }
+void *	getservent()	{ return 0; }
+void	sethostent(x)	{}
+void	setnetent(x)	{}
+void	setprotoent(x)	{}
+void	setservent(x)	{}
+void	endhostent(x)	{}
+void	endnetent(x)	{}
+void	endprotoent(x)	{}
+void	endservent(x)	{}
+
+/*****************************************************************************/
+/* stat() hack for char/block device */
+
+#if OS2_STAT_HACK
+
+    /* First attempt used DosQueryFSAttach which crashed the system when
+       used with 5.001. Now just look for /dev/. */
+
+int
+os2_stat(char *name, struct stat *st)
+{
+    static int ino = SHRT_MAX;
+
+    if (stricmp(name, "/dev/con") != 0
+     && stricmp(name, "/dev/tty") != 0)
+	return stat(name, st);
+
+    memset(st, 0, sizeof *st);
+    st->st_mode = S_IFCHR|0666;
+    st->st_ino = (ino-- & 0x7FFF);
+    st->st_nlink = 1;
+    return 0;
+}
+
+#endif
+
+#ifndef NO_SYS_ALLOC
+
+static char *oldchunk;
+static long oldsize;
+
+#define _32_K (1<<15)
+#define _64_K (1<<16)
+
+/* The real problem is that DosAllocMem will grant memory on 64K-chunks
+ * boundaries only. Note that addressable space for application memory
+ * is around 240M, thus we will run out of addressable space if we
+ * allocate around 14M worth of 4K segments.
+ * Thus we allocate memory in 64K chunks, and abandon the rest of the old
+ * chunk if the new is bigger than that rest. Also, we just allocate
+ * whatever is requested if the size is bigger that 32K. With this strategy
+ * we cannot lose more than 1/2 of addressable space. */
+
+void *
+sbrk(int size)
+{
+    char *got;
+    APIRET rc;
+    int small, reqsize;
+
+    if (!size) return 0;
+    else if (size <= oldsize) {
+	got = oldchunk;
+	oldchunk += size;
+	oldsize -= size;
+	return (void *)got;
+    } else if (size >= _32_K) {
+	small = 0;
+    } else {
+	reqsize = size;
+	size = _64_K;
+	small = 1;
+    }
+    rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE);
+    if (rc == ERROR_NOT_ENOUGH_MEMORY) {
+	return (void *) -1;
+    } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc);
+    if (small) {
+	/* Chunk is small, register the rest for future allocs. */
+	oldchunk = got + reqsize;
+	oldsize = size - reqsize;
+    }
+    return (void *)got;
+}
+#endif /* ! defined NO_SYS_ALLOC */
+
+/* tmp path */
+
+char *tmppath = TMPPATH1;
+
+void
+settmppath()
+{
+    char *p = getenv("TMP"), *tpath;
+    int len;
+
+    if (!p) p = getenv("TEMP");
+    if (!p) return;
+    len = strlen(p);
+    tpath = (char *)malloc(len + strlen(TMPPATH1) + 2);
+    strcpy(tpath, p);
+    tpath[len] = '/';
+    strcpy(tpath + len + 1, TMPPATH1);
+    tmppath = tpath;
+}
+
+#include "XSUB.h"
+
+XS(XS_File__Copy_syscopy)
+{
+    dXSARGS;
+    if (items < 2 || items > 3)
+	croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
+    {
+	char *	src = (char *)SvPV(ST(0),na);
+	char *	dst = (char *)SvPV(ST(1),na);
+	U32	flag;
+	int	RETVAL, rc;
+
+	if (items < 3)
+	    flag = 0;
+	else {
+	    flag = (unsigned long)SvIV(ST(2));
+	}
+
+	errno = DosCopy(src, dst, flag);
+	RETVAL = !errno;
+	ST(0) = sv_newmortal();
+	sv_setiv(ST(0), (IV)RETVAL);
+    }
+    XSRETURN(1);
+}
+
+OS2_Perl_data_t OS2_Perl_data;
+
+int
+Xs_OS2_init()
+{
+    char *file = __FILE__;
+    {
+        newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file);
+    }
+}
+
+void
+Perl_OS2_init()
+{
+    settmppath();
+    OS2_Perl_data.xs_init = &Xs_OS2_init;
+}
diff --git a/gnu/usr.bin/perl/os2/os2ish.h b/gnu/usr.bin/perl/os2/os2ish.h
new file mode 100644
index 00000000000..41caa422b14
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/os2ish.h
@@ -0,0 +1,109 @@
+#include <signal.h>
+
+/* HAS_IOCTL:
+ *	This symbol, if defined, indicates that the ioctl() routine is
+ *	available to set I/O characteristics
+ */
+#define	HAS_IOCTL		/**/
+ 
+/* HAS_UTIME:
+ *	This symbol, if defined, indicates that the routine utime() is
+ *	available to update the access and modification times of files.
+ */
+#define HAS_UTIME		/**/
+
+#define HAS_KILL
+#define HAS_WAIT
+
+#ifndef SIGABRT
+#    define SIGABRT SIGILL
+#endif
+#ifndef SIGILL
+#    define SIGILL 6         /* blech */
+#endif
+#define ABORT() kill(getpid(),SIGABRT);
+
+#define BIT_BUCKET "/dev/null"  /* Will this work? */
+
+void Perl_OS2_init();
+
+#define PERL_SYS_INIT(argcp, argvp) STMT_START {	\
+    _response(argcp, argvp);			\
+    _wildcard(argcp, argvp);			\
+    Perl_OS2_init();	} STMT_END
+
+#define PERL_SYS_TERM()
+
+#define dXSUB_SYS int fake = OS2_XS_init()
+
+#define TMPPATH tmppath
+#define TMPPATH1 "plXXXXXX"
+extern char *tmppath;
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define my_getenv(var) getenv(var)
+
+/*****************************************************************************/
+
+#include <stdlib.h>	/* before the following definitions */
+#include <unistd.h>	/* before the following definitions */
+
+#define chdir	_chdir2
+#define getcwd	_getcwd2
+
+/* This guy is needed for quick stdstd  */
+
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+#  define _filbuf _fill
+	/* Perl uses ungetc only with successful return */
+#  define ungetc(c,fp) \
+	(FILE_ptr(fp) > FILE_base(fp) && c == (int)*(FILE_ptr(fp) - 1) \
+	 ? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp))
+#endif
+
+#define OP_BINARY O_BINARY
+
+#define OS2_STAT_HACK 1
+#if OS2_STAT_HACK
+
+#define Stat(fname,bufptr) os2_stat((fname),(bufptr))
+#define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
+
+#undef S_IFBLK
+#undef S_ISBLK
+#define S_IFBLK		0120000
+#define S_ISBLK(mode)	(((mode) & S_IFMT) == S_IFBLK)
+
+#else
+
+#define Stat(fname,bufptr) stat((fname),(bufptr))
+#define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
+
+#endif
+
+/* Our private OS/2 specific data. */
+
+typedef struct OS2_Perl_data {
+  unsigned long flags;
+  unsigned long phab;
+  int (*xs_init)();
+} OS2_Perl_data_t;
+
+extern OS2_Perl_data_t OS2_Perl_data;
+
+#define hab		((HAB)OS2_Perl_data->phab)
+#define OS2_Perl_flag	(OS2_Perl_data->flag)
+#define Perl_HAB_set_f	1
+#define Perl_HAB_set	(OS2_Perl_flag & Perl_HAB_set_f)
+#define set_Perl_HAB_f	(OS2_Perl_flag |= Perl_HAB_set_f)
+#define set_Perl_HAB(h) (set_Perl_HAB_f, hab = h)
+#define OS2_XS_init() (*OS2_Perl_data.xs_init)()
diff --git a/gnu/usr.bin/perl/os2/perl2cmd.pl b/gnu/usr.bin/perl/os2/perl2cmd.pl
new file mode 100644
index 00000000000..aa1c353f136
--- /dev/null
+++ b/gnu/usr.bin/perl/os2/perl2cmd.pl
@@ -0,0 +1,28 @@
+# This will put installed perl files into some other location
+# Note that we cannot put hashbang to be extproc to make Configure work.
+
+use Config;
+
+$dir = shift;
+$dir =~ s|/|\\|g ;
+$nowarn = 1, $dir = shift if $dir eq '-n';
+
+die <<EOU unless defined $dir and -d $dir;
+usage:	$^X $0 [-n] directory-to-install
+  -n	do not check whether the directory is not on path
+EOU
+
+@path = split /;/, $ENV{PATH};
+$idir = $Config{installbin};
+$indir =~ s|\\|/|g ;
+
+foreach $file (<$idir/*.>) {
+  $base = $file;
+  $base =~ s/\.$//;		# just in case...
+  $base =~ s|.*/||;
+  $file =~ s|/|\\|g ;
+  print "Processing $file => $dir\\$base.cmd\n";
+  system 'cmd.exe', '/c', "echo extproc perl -Sx > $dir\\$base.cmd";
+  system 'cmd.exe', '/c', "type $file >> $dir\\$base.cmd";
+}
+
diff --git a/gnu/usr.bin/perl/patchlevel.h b/gnu/usr.bin/perl/patchlevel.h
new file mode 100644
index 00000000000..5d4b324d7e1
--- /dev/null
+++ b/gnu/usr.bin/perl/patchlevel.h
@@ -0,0 +1,45 @@
+#define PATCHLEVEL 3
+#define SUBVERSION 0
+
+/*
+	local_patches -- list of locally applied less-than-subversion patches.
+	If you're distributing such a patch, please give it a name and a
+	one-line description, placed just before the last NULL in the array
+	below.  If your patch fixes a bug in the perlbug database, please
+	mention the bugid.  If your patch *IS* dependent on a prior patch,
+	please place your applied patch line after its dependencies. This
+	will help tracking of patch dependencies.
+
+	Please edit the hunk of diff which adds your patch to this list,
+	to remove context lines which would give patch problems.  For instance,
+	if the original context diff is
+	   *** patchlevel.h.orig	<date here>
+	   --- patchlevel.h	<date here>
+	   *** 38,43 ***
+	   --- 38,44 ---
+	     	,"FOO1235 - some patch"
+	     	,"BAR3141 - another patch"
+	     	,"BAZ2718 - and another patch"
+	   + 	,"MINE001 - my new patch"
+	     	,NULL
+	     };
+	
+	please change it to 
+	   *** patchlevel.h.orig	<date here>
+	   --- patchlevel.h	<date here>
+	   *** 41,43 ***
+	   --- 41,44 ---
+	   + 	,"MINE001 - my new patch"
+	     };
+	
+	(Note changes to line numbers as well as removal of context lines.)
+	This will prevent patch from choking if someone has previously
+	applied different patches than you.
+ */
+static	char	*local_patches[] = {
+	NULL
+	,NULL
+};
+
+#define	LOCAL_PATCH_COUNT	\
+	(sizeof(local_patches)/sizeof(local_patches[0])-2)
diff --git a/gnu/usr.bin/perl/perl.c b/gnu/usr.bin/perl/perl.c
new file mode 100644
index 00000000000..6c7723ace38
--- /dev/null
+++ b/gnu/usr.bin/perl/perl.c
@@ -0,0 +1,2105 @@
+/*    perl.c
+ *
+ *    Copyright (c) 1987-1996 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.
+ *
+ */
+
+/*
+ * "A ship then new they built for him/of mithril and of elven glass" --Bilbo
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "patchlevel.h"
+
+/* Omit -- it causes too much grief on mixed systems.
+#ifdef I_UNISTD
+#include <unistd.h>
+#endif
+*/
+
+dEXT char rcsid[] = "perl.c\nPatch level: ###\n";
+
+#ifdef IAMSUID
+#ifndef DOSUID
+#define DOSUID
+#endif
+#endif
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef DOSUID
+#undef DOSUID
+#endif
+#endif
+
+static void find_beginning _((void));
+static void incpush _((char *));
+static void init_ids _((void));
+static void init_debugger _((void));
+static void init_lexer _((void));
+static void init_main_stash _((void));
+static void init_perllib _((void));
+static void init_postdump_symbols _((int, char **, char **));
+static void init_predump_symbols _((void));
+static void init_stacks _((void));
+static void open_script _((char *, bool, SV *));
+static void usage _((char *));
+static void validate_suid _((char *, char*));
+
+static int fdscript = -1;
+
+PerlInterpreter *
+perl_alloc()
+{
+    PerlInterpreter *sv_interp;
+
+    curinterp = 0;
+    New(53, sv_interp, 1, PerlInterpreter);
+    return sv_interp;
+}
+
+void
+perl_construct( sv_interp )
+register PerlInterpreter *sv_interp;
+{
+    if (!(curinterp = sv_interp))
+	return;
+
+#ifdef MULTIPLICITY
+    Zero(sv_interp, 1, PerlInterpreter);
+#endif
+
+    /* Init the real globals? */
+    if (!linestr) {
+	linestr = NEWSV(65,80);
+	sv_upgrade(linestr,SVt_PVIV);
+
+	SvREADONLY_on(&sv_undef);
+
+	sv_setpv(&sv_no,No);
+	SvNV(&sv_no);
+	SvREADONLY_on(&sv_no);
+
+	sv_setpv(&sv_yes,Yes);
+	SvNV(&sv_yes);
+	SvREADONLY_on(&sv_yes);
+
+	nrs = newSVpv("\n", 1);
+	rs = SvREFCNT_inc(nrs);
+
+#ifdef MSDOS
+	/*
+	 * There is no way we can refer to them from Perl so close them to save
+	 * space.  The other alternative would be to provide STDAUX and STDPRN
+	 * filehandles.
+	 */
+	(void)fclose(stdaux);
+	(void)fclose(stdprn);
+#endif
+    }
+
+#ifdef MULTIPLICITY
+    chopset	= " \n-";
+    copline	= NOLINE;
+    curcop	= &compiling;
+    dbargs	= 0;
+    dlmax	= 128;
+    laststatval	= -1;
+    laststype	= OP_STAT;
+    maxscream	= -1;
+    maxsysfd	= MAXSYSFD;
+    rsfp	= Nullfp;
+    statname	= Nullsv;
+    tmps_floor	= -1;
+#endif
+
+    init_ids();
+
+#if defined(SUBVERSION) && SUBVERSION > 0
+    sprintf(patchlevel, "%7.5f", 5.0 + (PATCHLEVEL / 1000.0)
+				     + (SUBVERSION / 100000.0));
+#else
+    sprintf(patchlevel, "%5.3f", 5.0 + (PATCHLEVEL / 1000.0));
+#endif
+
+#if defined(LOCAL_PATCH_COUNT)
+    Ilocalpatches = local_patches;	/* For possible -v */
+#endif
+
+    fdpid = newAV();	/* for remembering popen pids by fd */
+    pidstatus = newHV();/* for remembering status of dead pids */
+
+    init_stacks();
+    ENTER;
+}
+
+void
+perl_destruct(sv_interp)
+register PerlInterpreter *sv_interp;
+{
+    int destruct_level;  /* 0=none, 1=full, 2=full with checks */
+    I32 last_sv_count;
+    HV *hv;
+
+    if (!(curinterp = sv_interp))
+	return;
+
+    destruct_level = perl_destruct_level;
+#ifdef DEBUGGING
+    {
+	char *s;
+	if (s = getenv("PERL_DESTRUCT_LEVEL"))
+	    destruct_level = atoi(s);
+    }
+#endif
+
+    LEAVE;
+    FREETMPS;
+
+    if (sv_objcount) {
+	/* We must account for everything.  First the syntax tree. */
+	if (main_root) {
+	    curpad = AvARRAY(comppad);
+	    op_free(main_root);
+	    main_root = 0;
+	}
+    }
+    if (sv_objcount) {
+	/*
+	 * Try to destruct global references.  We do this first so that the
+	 * destructors and destructees still exist.  Some sv's might remain.
+	 * Non-referenced objects are on their own.
+	 */
+    
+	dirty = TRUE;
+	sv_clean_objs();
+    }
+
+    if (destruct_level == 0){
+
+	DEBUG_P(debprofdump());
+    
+	/* The exit() function will do everything that needs doing. */
+	return;
+    }
+    
+    /* Prepare to destruct main symbol table.  */
+    hv = defstash;
+    defstash = 0;
+    SvREFCNT_dec(hv);
+
+    FREETMPS;
+    if (destruct_level >= 2) {
+	if (scopestack_ix != 0)
+	    warn("Unbalanced scopes: %d more ENTERs than LEAVEs\n", scopestack_ix);
+	if (savestack_ix != 0)
+	    warn("Unbalanced saves: %d more saves than restores\n", savestack_ix);
+	if (tmps_floor != -1)
+	    warn("Unbalanced tmps: %d more allocs than frees\n", tmps_floor + 1);
+	if (cxstack_ix != -1)
+	    warn("Unbalanced context: %d more PUSHes than POPs\n", cxstack_ix + 1);
+    }
+
+    /* Now absolutely destruct everything, somehow or other, loops or no. */
+    last_sv_count = 0;
+    while (sv_count != 0 && sv_count != last_sv_count) {
+	last_sv_count = sv_count;
+	sv_clean_all();
+    }
+    if (sv_count != 0)
+	warn("Scalars leaked: %d\n", sv_count);
+    sv_free_arenas();
+    
+    DEBUG_P(debprofdump());
+}
+
+void
+perl_free(sv_interp)
+PerlInterpreter *sv_interp;
+{
+    if (!(curinterp = sv_interp))
+	return;
+    Safefree(sv_interp);
+}
+#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
+char *getenv _((char *)); /* Usually in <stdlib.h> */
+#endif
+
+int
+perl_parse(sv_interp, xsinit, argc, argv, env)
+PerlInterpreter *sv_interp;
+void (*xsinit)_((void));
+int argc;
+char **argv;
+char **env;
+{
+    register SV *sv;
+    register char *s;
+    char *scriptname = NULL;
+    VOL bool dosearch = FALSE;
+    char *validarg = "";
+    AV* comppadlist;
+
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+#ifdef IAMSUID
+#undef IAMSUID
+    croak("suidperl is no longer needed since the kernel can now execute\n\
+setuid perl scripts securely.\n");
+#endif
+#endif
+
+    if (!(curinterp = sv_interp))
+	return 255;
+
+    origargv = argv;
+    origargc = argc;
+#ifndef VMS  /* VMS doesn't have environ array */
+    origenviron = environ;
+#endif
+    e_tmpname = Nullch;
+
+    if (do_undump) {
+
+	/* Come here if running an undumped a.out. */
+
+	origfilename = savepv(argv[0]);
+	do_undump = FALSE;
+	cxstack_ix = -1;		/* start label stack again */
+	init_ids();
+	init_postdump_symbols(argc,argv,env);
+	return 0;
+    }
+
+    if (main_root)
+	op_free(main_root);
+    main_root = 0;
+
+    switch (Sigsetjmp(top_env,1)) {
+    case 1:
+#ifdef VMS
+	statusvalue = 255;
+#else
+	statusvalue = 1;
+#endif
+    case 2:
+	curstash = defstash;
+	if (endav)
+	    calllist(endav);
+	return(statusvalue);	/* my_exit() was called */
+    case 3:
+	fprintf(stderr, "panic: top_env\n");
+	return 1;
+    }
+
+    sv_setpvn(linestr,"",0);
+    sv = newSVpv("",0);		/* first used for -I flags */
+    SAVEFREESV(sv);
+    init_main_stash();
+    for (argc--,argv++; argc > 0; argc--,argv++) {
+	if (argv[0][0] != '-' || !argv[0][1])
+	    break;
+#ifdef DOSUID
+    if (*validarg)
+	validarg = " PHOOEY ";
+    else
+	validarg = argv[0];
+#endif
+	s = argv[0]+1;
+      reswitch:
+	switch (*s) {
+	case '0':
+	case 'F':
+	case 'a':
+	case 'c':
+	case 'd':
+	case 'D':
+	case 'h':
+	case 'i':
+	case 'l':
+	case 'M':
+	case 'm':
+	case 'n':
+	case 'p':
+	case 's':
+	case 'T':
+	case 'u':
+	case 'U':
+	case 'v':
+	case 'w':
+	    if (s = moreswitches(s))
+		goto reswitch;
+	    break;
+
+	case 'e':
+	    if (euid != uid || egid != gid)
+		croak("No -e allowed in setuid scripts");
+	    if (!e_fp) {
+	        e_tmpname = savepv(TMPPATH);
+		(void)mktemp(e_tmpname);
+		if (!*e_tmpname)
+		    croak("Can't mktemp()");
+		e_fp = fopen(e_tmpname,"w");
+		if (!e_fp)
+		    croak("Cannot open temporary file");
+	    }
+	    if (argv[1]) {
+		fputs(argv[1],e_fp);
+		argc--,argv++;
+	    }
+	    (void)putc('\n', e_fp);
+	    break;
+	case 'I':
+	    taint_not("-I");
+	    sv_catpv(sv,"-");
+	    sv_catpv(sv,s);
+	    sv_catpv(sv," ");
+	    if (*++s) {
+		av_push(GvAVn(incgv),newSVpv(s,0));
+	    }
+	    else if (argv[1]) {
+		av_push(GvAVn(incgv),newSVpv(argv[1],0));
+		sv_catpv(sv,argv[1]);
+		argc--,argv++;
+		sv_catpv(sv," ");
+	    }
+	    break;
+	case 'P':
+	    taint_not("-P");
+	    preprocess = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'S':
+	    taint_not("-S");
+	    dosearch = TRUE;
+	    s++;
+	    goto reswitch;
+	case 'V':
+	    if (!preambleav)
+		preambleav = newAV();
+	    av_push(preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
+	    if (*++s != ':')  {
+		Sv = newSVpv("print myconfig(),'@INC: '.\"@INC\\n\"",0);
+	    }
+	    else {
+		Sv = newSVpv("config_vars(qw(",0);
+		sv_catpv(Sv, ++s);
+		sv_catpv(Sv, "))");
+		s += strlen(s);
+	    }
+	    av_push(preambleav, Sv);
+	    scriptname = BIT_BUCKET;	/* don't look for script or read stdin */
+	    goto reswitch;
+	case 'x':
+	    doextract = TRUE;
+	    s++;
+	    if (*s)
+		cddir = savepv(s);
+	    break;
+	case '-':
+	    argc--,argv++;
+	    goto switch_end;
+	case 0:
+	    break;
+	default:
+	    croak("Unrecognized switch: -%s",s);
+	}
+    }
+  switch_end:
+    if (!scriptname)
+	scriptname = argv[0];
+    if (e_fp) {
+	if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
+	    croak("Can't write to temp file for -e: %s", Strerror(errno));
+	e_fp = Nullfp;
+	argc++,argv--;
+	scriptname = e_tmpname;
+    }
+    else if (scriptname == Nullch) {
+#ifdef MSDOS
+	if ( isatty(fileno(stdin)) )
+	    moreswitches("v");
+#endif
+	scriptname = "-";
+    }
+
+    init_perllib();
+
+    open_script(scriptname,dosearch,sv);
+
+    validate_suid(validarg, scriptname);
+
+    if (doextract)
+	find_beginning();
+
+    compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)compcv, SVt_PVCV);
+
+    pad = newAV();
+    comppad = pad;
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
+    padname = newAV();
+    comppad_name = padname;
+    comppad_name_fill = 0;
+    min_intro_pending = 0;
+    padix = 0;
+
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, (SV*)comppad_name);
+    av_store(comppadlist, 1, (SV*)comppad);
+    CvPADLIST(compcv) = comppadlist;
+
+    if (xsinit)
+	(*xsinit)();	/* in case linked C routines want magical variables */
+#ifdef VMS
+    init_os_extras();
+#endif
+
+    init_predump_symbols();
+    if (!do_undump)
+	init_postdump_symbols(argc,argv,env);
+
+    init_lexer();
+
+    /* now parse the script */
+
+    error_count = 0;
+    if (yyparse() || error_count) {
+	if (minus_c)
+	    croak("%s had compilation errors.\n", origfilename);
+	else {
+	    croak("Execution of %s aborted due to compilation errors.\n",
+		origfilename);
+	}
+    }
+    curcop->cop_line = 0;
+    curstash = defstash;
+    preprocess = FALSE;
+    if (e_tmpname) {
+	(void)UNLINK(e_tmpname);
+	Safefree(e_tmpname);
+	e_tmpname = Nullch;
+    }
+
+    /* now that script is parsed, we can modify record separator */
+    SvREFCNT_dec(rs);
+    rs = SvREFCNT_inc(nrs);
+    sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
+
+    if (do_undump)
+	my_unexec();
+
+    if (dowarn)
+	gv_check(defstash);
+
+    LEAVE;
+    FREETMPS;
+
+#ifdef DEBUGGING_MSTATS
+    if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+	dump_mstats("after compilation:");
+#endif
+
+    ENTER;
+    restartop = 0;
+    return 0;
+}
+
+int
+perl_run(sv_interp)
+PerlInterpreter *sv_interp;
+{
+    if (!(curinterp = sv_interp))
+	return 255;
+    switch (Sigsetjmp(top_env,1)) {
+    case 1:
+	cxstack_ix = -1;		/* start context stack again */
+	break;
+    case 2:
+	curstash = defstash;
+	if (endav)
+	    calllist(endav);
+	FREETMPS;
+#ifdef DEBUGGING_MSTATS
+	if (getenv("PERL_DEBUG_MSTATS"))
+	    dump_mstats("after execution:  ");
+#endif
+	return(statusvalue);		/* my_exit() was called */
+    case 3:
+	if (!restartop) {
+	    fprintf(stderr, "panic: restartop\n");
+	    FREETMPS;
+	    return 1;
+	}
+	if (stack != mainstack) {
+	    dSP;
+	    SWITCHSTACK(stack, mainstack);
+	}
+	break;
+    }
+
+    if (!restartop) {
+	DEBUG_x(dump_all());
+	DEBUG(fprintf(stderr,"\nEXECUTING...\n\n"));
+
+	if (minus_c) {
+	    fprintf(stderr,"%s syntax OK\n", origfilename);
+	    my_exit(0);
+	}
+	if (perldb && DBsingle)
+	   sv_setiv(DBsingle, 1); 
+    }
+
+    /* do it */
+
+    if (restartop) {
+	op = restartop;
+	restartop = 0;
+	runops();
+    }
+    else if (main_start) {
+	op = main_start;
+	runops();
+    }
+
+    my_exit(0);
+    return 0;
+}
+
+void
+my_exit(status)
+U32 status;
+{
+    register CONTEXT *cx;
+    I32 gimme;
+    SV **newsp;
+
+    statusvalue = FIXSTATUS(status);
+    if (cxstack_ix >= 0) {
+	if (cxstack_ix > 0)
+	    dounwind(0);
+	POPBLOCK(cx,curpm);
+	LEAVE;
+    }
+    Siglongjmp(top_env, 2);
+}
+
+SV*
+perl_get_sv(name, create)
+char* name;
+I32 create;
+{
+    GV* gv = gv_fetchpv(name, create, SVt_PV);
+    if (gv)
+	return GvSV(gv);
+    return Nullsv;
+}
+
+AV*
+perl_get_av(name, create)
+char* name;
+I32 create;
+{
+    GV* gv = gv_fetchpv(name, create, SVt_PVAV);
+    if (create)
+    	return GvAVn(gv);
+    if (gv)
+	return GvAV(gv);
+    return Nullav;
+}
+
+HV*
+perl_get_hv(name, create)
+char* name;
+I32 create;
+{
+    GV* gv = gv_fetchpv(name, create, SVt_PVHV);
+    if (create)
+    	return GvHVn(gv);
+    if (gv)
+	return GvHV(gv);
+    return Nullhv;
+}
+
+CV*
+perl_get_cv(name, create)
+char* name;
+I32 create;
+{
+    GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+    if (create && !GvCV(gv))
+    	return newSUB(start_subparse(),
+		      newSVOP(OP_CONST, 0, newSVpv(name,0)),
+		      Nullop,
+		      Nullop);
+    if (gv)
+	return GvCV(gv);
+    return Nullcv;
+}
+
+/* Be sure to refetch the stack pointer after calling these routines. */
+
+I32
+perl_call_argv(subname, flags, argv)
+char *subname;
+I32 flags;		/* See G_* flags in cop.h */
+register char **argv;	/* null terminated arg list */
+{
+    dSP;
+
+    PUSHMARK(sp);
+    if (argv) {
+	while (*argv) {
+	    XPUSHs(sv_2mortal(newSVpv(*argv,0)));
+	    argv++;
+	}
+	PUTBACK;
+    }
+    return perl_call_pv(subname, flags);
+}
+
+I32
+perl_call_pv(subname, flags)
+char *subname;		/* name of the subroutine */
+I32 flags;		/* See G_* flags in cop.h */
+{
+    return perl_call_sv((SV*)perl_get_cv(subname, TRUE), flags);
+}
+
+I32
+perl_call_method(methname, flags)
+char *methname;		/* name of the subroutine */
+I32 flags;		/* See G_* flags in cop.h */
+{
+    dSP;
+    OP myop;
+    if (!op)
+	op = &myop;
+    XPUSHs(sv_2mortal(newSVpv(methname,0)));
+    PUTBACK;
+    pp_method();
+    return perl_call_sv(*stack_sp--, flags);
+}
+
+/* May be called with any of a CV, a GV, or an SV containing the name. */
+I32
+perl_call_sv(sv, flags)
+SV* sv;
+I32 flags;		/* See G_* flags in cop.h */
+{
+    LOGOP myop;		/* fake syntax tree node */
+    SV** sp = stack_sp;
+    I32 oldmark = TOPMARK;
+    I32 retval;
+    Sigjmp_buf oldtop;
+    I32 oldscope;
+    
+    if (flags & G_DISCARD) {
+	ENTER;
+	SAVETMPS;
+    }
+
+    SAVESPTR(op);
+    op = (OP*)&myop;
+    Zero(op, 1, LOGOP);
+    EXTEND(stack_sp, 1);
+    *++stack_sp = sv;
+    oldscope = scopestack_ix;
+
+    if (!(flags & G_NOARGS))
+	myop.op_flags = OPf_STACKED;
+    myop.op_next = Nullop;
+    myop.op_flags |= OPf_KNOW;
+    if (flags & G_ARRAY)
+      myop.op_flags |= OPf_LIST;
+
+    if (flags & G_EVAL) {
+	Copy(top_env, oldtop, 1, Sigjmp_buf);
+
+	cLOGOP->op_other = op;
+	markstack_ptr--;
+	/* we're trying to emulate pp_entertry() here */
+	{
+	    register CONTEXT *cx;
+	    I32 gimme = GIMME;
+	    
+	    ENTER;
+	    SAVETMPS;
+	    
+	    push_return(op->op_next);
+	    PUSHBLOCK(cx, CXt_EVAL, stack_sp);
+	    PUSHEVAL(cx, 0, 0);
+	    eval_root = op;             /* Only needed so that goto works right. */
+	    
+	    in_eval = 1;
+	    if (flags & G_KEEPERR)
+		in_eval |= 4;
+	    else
+		sv_setpv(GvSV(errgv),"");
+	}
+	markstack_ptr++;
+
+    restart:
+	switch (Sigsetjmp(top_env,1)) {
+	case 0:
+	    break;
+	case 1:
+#ifdef VMS
+	    statusvalue = 255;	/* XXX I don't think we use 1 anymore. */
+#else
+	statusvalue = 1;
+#endif
+	    /* FALL THROUGH */
+	case 2:
+	    /* my_exit() was called */
+	    curstash = defstash;
+	    FREETMPS;
+	    Copy(oldtop, top_env, 1, Sigjmp_buf);
+	    if (statusvalue)
+		croak("Callback called exit");
+	    my_exit(statusvalue);
+	    /* NOTREACHED */
+	case 3:
+	    if (restartop) {
+		op = restartop;
+		restartop = 0;
+		goto restart;
+	    }
+	    stack_sp = stack_base + oldmark;
+	    if (flags & G_ARRAY)
+		retval = 0;
+	    else {
+		retval = 1;
+		*++stack_sp = &sv_undef;
+	    }
+	    goto cleanup;
+	}
+    }
+
+    if (op == (OP*)&myop)
+	op = pp_entersub();
+    if (op)
+	runops();
+    retval = stack_sp - (stack_base + oldmark);
+    if ((flags & G_EVAL) && !(flags & G_KEEPERR))
+	sv_setpv(GvSV(errgv),"");
+
+  cleanup:
+    if (flags & G_EVAL) {
+	if (scopestack_ix > oldscope) {
+	    SV **newsp;
+	    PMOP *newpm;
+	    I32 gimme;
+	    register CONTEXT *cx;
+	    I32 optype;
+
+	    POPBLOCK(cx,newpm);
+	    POPEVAL(cx);
+	    pop_return();
+	    curpm = newpm;
+	    LEAVE;
+	}
+	Copy(oldtop, top_env, 1, Sigjmp_buf);
+    }
+    if (flags & G_DISCARD) {
+	stack_sp = stack_base + oldmark;
+	retval = 0;
+	FREETMPS;
+	LEAVE;
+    }
+    return retval;
+}
+
+/* Eval a string. */
+
+I32
+perl_eval_sv(sv, flags)
+SV* sv;
+I32 flags;		/* See G_* flags in cop.h */
+{
+    UNOP myop;		/* fake syntax tree node */
+    SV** sp = stack_sp;
+    I32 oldmark = sp - stack_base;
+    I32 retval;
+    Sigjmp_buf oldtop;
+    I32 oldscope;
+    
+    if (flags & G_DISCARD) {
+	ENTER;
+	SAVETMPS;
+    }
+
+    SAVESPTR(op);
+    op = (OP*)&myop;
+    Zero(op, 1, UNOP);
+    EXTEND(stack_sp, 1);
+    *++stack_sp = sv;
+    oldscope = scopestack_ix;
+
+    if (!(flags & G_NOARGS))
+	myop.op_flags = OPf_STACKED;
+    myop.op_next = Nullop;
+    myop.op_flags |= OPf_KNOW;
+    if (flags & G_ARRAY)
+      myop.op_flags |= OPf_LIST;
+
+    Copy(top_env, oldtop, 1, Sigjmp_buf);
+
+restart:
+    switch (Sigsetjmp(top_env,1)) {
+    case 0:
+	break;
+    case 1:
+#ifdef VMS
+	statusvalue = 255;	/* XXX I don't think we use 1 anymore. */
+#else
+    statusvalue = 1;
+#endif
+	/* FALL THROUGH */
+    case 2:
+	/* my_exit() was called */
+	curstash = defstash;
+	FREETMPS;
+	Copy(oldtop, top_env, 1, Sigjmp_buf);
+	if (statusvalue)
+	    croak("Callback called exit");
+	my_exit(statusvalue);
+	/* NOTREACHED */
+    case 3:
+	if (restartop) {
+	    op = restartop;
+	    restartop = 0;
+	    goto restart;
+	}
+	stack_sp = stack_base + oldmark;
+	if (flags & G_ARRAY)
+	    retval = 0;
+	else {
+	    retval = 1;
+	    *++stack_sp = &sv_undef;
+	}
+	goto cleanup;
+    }
+
+    if (op == (OP*)&myop)
+	op = pp_entereval();
+    if (op)
+	runops();
+    retval = stack_sp - (stack_base + oldmark);
+    if ((flags & G_EVAL) && !(flags & G_KEEPERR))
+	sv_setpv(GvSV(errgv),"");
+
+  cleanup:
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
+    if (flags & G_DISCARD) {
+	stack_sp = stack_base + oldmark;
+	retval = 0;
+	FREETMPS;
+	LEAVE;
+    }
+    return retval;
+}
+
+/* Require a module. */
+
+void
+perl_require_pv(pv)
+char* pv;
+{
+    SV* sv = sv_newmortal();
+    sv_setpv(sv, "require '");
+    sv_catpv(sv, pv);
+    sv_catpv(sv, "'");
+    perl_eval_sv(sv, G_DISCARD);
+}
+
+void
+magicname(sym,name,namlen)
+char *sym;
+char *name;
+I32 namlen;
+{
+    register GV *gv;
+
+    if (gv = gv_fetchpv(sym,TRUE, SVt_PV))
+	sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
+}
+
+#if defined(DOSISH)
+#    define PERLLIB_SEP ';'
+#else
+#  if defined(VMS)
+#    define PERLLIB_SEP '|'
+#  else
+#    define PERLLIB_SEP ':'
+#  endif
+#endif
+
+static void
+incpush(p)
+char *p;
+{
+    char *s;
+
+    if (!p)
+	return;
+
+    /* Break at all separators */
+    while (*p) {
+	/* First, skip any consecutive separators */
+	while ( *p == PERLLIB_SEP ) {
+	    /* Uncomment the next line for PATH semantics */
+	    /* av_push(GvAVn(incgv), newSVpv(".", 1)); */
+	    p++;
+	}
+	if ( (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
+	    av_push(GvAVn(incgv), newSVpv(p, (STRLEN)(s - p)));
+	    p = s + 1;
+	} else {
+	    av_push(GvAVn(incgv), newSVpv(p, 0));
+	    break;
+	}
+    }
+}
+
+static void
+usage(name)		/* XXX move this out into a module ? */
+char *name;
+{
+    /* This message really ought to be max 23 lines.
+     * Removed -h because the user already knows that opton. Others? */
+    printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
+    printf("\n  -0[octal]       specify record separator (\\0, if no argument)");
+    printf("\n  -a              autosplit mode with -n or -p (splits $_ into @F)");
+    printf("\n  -c              check syntax only (runs BEGIN and END blocks)");
+    printf("\n  -d[:debugger]   run scripts under debugger");
+    printf("\n  -D[number/list] set debugging flags (argument is a bit mask or flags)");
+    printf("\n  -e 'command'    one line of script. Several -e's allowed. Omit [programfile].");
+    printf("\n  -F/pattern/     split() pattern for autosplit (-a). The //'s are optional.");
+    printf("\n  -i[extension]   edit <> files in place (make backup if extension supplied)");
+    printf("\n  -Idirectory     specify @INC/#include directory (may be used more then once)");
+    printf("\n  -l[octal]       enable line ending processing, specifies line teminator");
+    printf("\n  -[mM][-]module.. executes `use/no module...' before executing your script.");
+    printf("\n  -n              assume 'while (<>) { ... }' loop arround your script");
+    printf("\n  -p              assume loop like -n but print line also like sed");
+    printf("\n  -P              run script through C preprocessor before compilation");
+#ifdef OS2
+    printf("\n  -R              enable REXX variable pool");
+#endif      
+    printf("\n  -s              enable some switch parsing for switches after script name");
+    printf("\n  -S              look for the script using PATH environment variable");
+    printf("\n  -T              turn on tainting checks");
+    printf("\n  -u              dump core after parsing script");
+    printf("\n  -U              allow unsafe operations");
+    printf("\n  -v              print version number and patchlevel of perl");
+    printf("\n  -V[:variable]   print perl configuration information");
+    printf("\n  -w              TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT.");
+    printf("\n  -x[directory]   strip off text before #!perl line and perhaps cd to directory\n");
+}
+
+/* This routine handles any switches that can be given during run */
+
+char *
+moreswitches(s)
+char *s;
+{
+    I32 numlen;
+    U32 rschar;
+
+    switch (*s) {
+    case '0':
+	rschar = scan_oct(s, 4, &numlen);
+	SvREFCNT_dec(nrs);
+	if (rschar & ~((U8)~0))
+	    nrs = &sv_undef;
+	else if (!rschar && numlen >= 2)
+	    nrs = newSVpv("", 0);
+	else {
+	    char ch = rschar;
+	    nrs = newSVpv(&ch, 1);
+	}
+	return s + numlen;
+    case 'F':
+	minus_F = TRUE;
+	splitstr = savepv(s + 1);
+	s += strlen(s);
+	return s;
+    case 'a':
+	minus_a = TRUE;
+	s++;
+	return s;
+    case 'c':
+	minus_c = TRUE;
+	s++;
+	return s;
+    case 'd':
+	taint_not("-d");
+	s++;
+	if (*s == ':' || *s == '=')  {
+	    sprintf(buf, "use Devel::%s;", ++s);
+	    s += strlen(s);
+	    my_setenv("PERL5DB",buf);
+	}
+	if (!perldb) {
+	    perldb = TRUE;
+	    init_debugger();
+	}
+	return s;
+    case 'D':
+#ifdef DEBUGGING
+	taint_not("-D");
+	if (isALPHA(s[1])) {
+	    static char debopts[] = "psltocPmfrxuLHXD";
+	    char *d;
+
+	    for (s++; *s && (d = strchr(debopts,*s)); s++)
+		debug |= 1 << (d - debopts);
+	}
+	else {
+	    debug = atoi(s+1);
+	    for (s++; isDIGIT(*s); s++) ;
+	}
+	debug |= 0x80000000;
+#else
+	warn("Recompile perl with -DDEBUGGING to use -D switch\n");
+	for (s++; isALNUM(*s); s++) ;
+#endif
+	/*SUPPRESS 530*/
+	return s;
+    case 'h':
+	usage(origargv[0]);    
+	exit(0);
+    case 'i':
+	if (inplace)
+	    Safefree(inplace);
+	inplace = savepv(s+1);
+	/*SUPPRESS 530*/
+	for (s = inplace; *s && !isSPACE(*s); s++) ;
+	*s = '\0';
+	break;
+    case 'I':
+	taint_not("-I");
+	if (*++s) {
+	    char *e;
+	    for (e = s; *e && !isSPACE(*e); e++) ;
+	    av_push(GvAVn(incgv),newSVpv(s,e-s));
+	    if (*e)
+		return e;
+	}
+	else
+	    croak("No space allowed after -I");
+	break;
+    case 'l':
+	minus_l = TRUE;
+	s++;
+	if (ors)
+	    Safefree(ors);
+	if (isDIGIT(*s)) {
+	    ors = savepv("\n");
+	    orslen = 1;
+	    *ors = scan_oct(s, 3 + (*s == '0'), &numlen);
+	    s += numlen;
+	}
+	else {
+	    if (RsPARA(nrs)) {
+		ors = savepvn("\n\n", 2);
+		orslen = 2;
+	    }
+	    else
+		ors = SvPV(nrs, orslen);
+	}
+	return s;
+    case 'M':
+	taint_not("-M");	/* XXX ? */
+	/* FALL THROUGH */
+    case 'm':
+	taint_not("-m");	/* XXX ? */
+	if (*++s) {
+	    char *start;
+	    char *use = "use ";
+	    /* -M-foo == 'no foo'	*/
+	    if (*s == '-') { use = "no "; ++s; }
+	    Sv = newSVpv(use,0);
+	    start = s;
+	    /* We allow -M'Module qw(Foo Bar)'	*/
+	    while(isALNUM(*s) || *s==':') ++s;
+	    if (*s != '=') {
+		sv_catpv(Sv, start);
+		if (*(start-1) == 'm') {
+		    if (*s != '\0')
+			croak("Can't use '%c' after -mname", *s);
+		    sv_catpv( Sv, " ()");
+		}
+	    } else {
+		sv_catpvn(Sv, start, s-start);
+		sv_catpv(Sv, " split(/,/,q{");
+		sv_catpv(Sv, ++s);
+		sv_catpv(Sv,    "})");
+	    }
+	    s += strlen(s);
+	    if (preambleav == NULL)
+		preambleav = newAV();
+	    av_push(preambleav, Sv);
+	}
+	else
+	    croak("No space allowed after -%c", *(s-1));
+	return s;
+    case 'n':
+	minus_n = TRUE;
+	s++;
+	return s;
+    case 'p':
+	minus_p = TRUE;
+	s++;
+	return s;
+    case 's':
+	taint_not("-s");
+	doswitches = TRUE;
+	s++;
+	return s;
+    case 'T':
+	tainting = TRUE;
+	s++;
+	return s;
+    case 'u':
+	do_undump = TRUE;
+	s++;
+	return s;
+    case 'U':
+	unsafe = TRUE;
+	s++;
+	return s;
+    case 'v':
+#if defined(SUBVERSION) && SUBVERSION > 0
+	printf("\nThis is perl, version 5.%03d_%02d", PATCHLEVEL, SUBVERSION);
+#else
+	printf("\nThis is perl, version %s",patchlevel);
+#endif
+
+#if defined(DEBUGGING) || defined(EMBED) || defined(MULTIPLICITY)
+	fputs(" with", stdout);
+#ifdef DEBUGGING
+	fputs(" DEBUGGING", stdout);
+#endif
+#ifdef EMBED
+	fputs(" EMBED", stdout);
+#endif
+#ifdef MULTIPLICITY
+	fputs(" MULTIPLICITY", stdout);
+#endif
+#endif
+
+#if defined(LOCAL_PATCH_COUNT)
+    if (LOCAL_PATCH_COUNT > 0)
+    {	int i;
+	fputs("\n\tLocally applied patches:\n", stdout);
+	for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
+		if (Ilocalpatches[i])
+			fprintf(stdout, "\t  %s\n", Ilocalpatches[i]);
+	}
+    }
+#endif
+    printf("\n\tbuilt under %s",OSNAME);
+#ifdef __DATE__
+#  ifdef __TIME__
+	printf(" at %s %s",__DATE__,__TIME__);
+#  else
+	printf(" on %s",__DATE__);
+#  endif
+#endif
+	fputs("\n\t+ suidperl security patch", stdout);
+	fputs("\n\nCopyright 1987-1996, Larry Wall\n",stdout);
+#ifdef MSDOS
+	fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
+	stdout);
+#endif
+#ifdef OS2
+	fputs("OS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
+	    "Version 5 port Copyright (c) 1994-1995, Andreas Kaiser\n", stdout);
+#endif
+#ifdef atarist
+	fputs("atariST series port, ++jrb  bammi@cadence.com\n", stdout);
+#endif
+	fputs("\n\
+Perl may be copied only under the terms of either the Artistic License or the\n\
+GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n",stdout);
+#ifdef MSDOS
+        usage(origargv[0]);
+#endif
+	exit(0);
+    case 'w':
+	dowarn = TRUE;
+	s++;
+	return s;
+    case '*':
+    case ' ':
+	if (s[1] == '-')	/* Additional switches on #! line. */
+	    return s+2;
+	break;
+    case '-':
+    case 0:
+    case '\n':
+    case '\t':
+	break;
+    case 'P':
+	if (preprocess)
+	    return s+1;
+	/* FALL THROUGH */
+    default:
+	croak("Can't emulate -%.1s on #! line",s);
+    }
+    return Nullch;
+}
+
+/* compliments of Tom Christiansen */
+
+/* unexec() can be found in the Gnu emacs distribution */
+
+void
+my_unexec()
+{
+#ifdef UNEXEC
+    int    status;
+    extern int etext;
+
+    sprintf (buf, "%s.perldump", origfilename);
+    sprintf (tokenbuf, "%s/perl", BIN);
+
+    status = unexec(buf, tokenbuf, &etext, sbrk(0), 0);
+    if (status)
+	fprintf(stderr, "unexec of %s into %s failed!\n", tokenbuf, buf);
+    exit(status);
+#else
+#  ifdef VMS
+#    include <lib$routines.h>
+     lib$signal(SS$_DEBUG);  /* ssdef.h #included from vmsish.h */
+#else
+    ABORT();		/* for use with undump */
+#endif
+#endif
+}
+
+static void
+init_main_stash()
+{
+    GV *gv;
+    curstash = defstash = newHV();
+    curstname = newSVpv("main",4);
+    gv = gv_fetchpv("main::",TRUE, SVt_PVHV);
+    SvREFCNT_dec(GvHV(gv));
+    GvHV(gv) = (HV*)SvREFCNT_inc(defstash);
+    SvREADONLY_on(gv);
+    HvNAME(defstash) = savepv("main");
+    incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
+    GvMULTI_on(incgv);
+    defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
+    curstash = defstash;
+    compiling.cop_stash = defstash;
+    debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+    /* We must init $/ before switches are processed. */
+    sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
+}
+
+#ifdef CAN_PROTOTYPE
+static void
+open_script(char *scriptname, bool dosearch, SV *sv)
+#else
+static void
+open_script(scriptname,dosearch,sv)
+char *scriptname;
+bool dosearch;
+SV *sv;
+#endif
+{
+    char *xfound = Nullch;
+    char *xfailed = Nullch;
+    register char *s;
+    I32 len;
+    int retval;
+#if defined(DOSISH) && !defined(OS2) && !defined(atarist)
+#define SEARCH_EXTS ".bat", ".cmd", NULL
+#endif
+#ifdef VMS
+#  define SEARCH_EXTS ".pl", ".com", NULL
+#endif
+    /* additional extensions to try in each dir if scriptname not found */
+#ifdef SEARCH_EXTS
+    char *ext[] = { SEARCH_EXTS };
+    int extidx = (strchr(scriptname,'.')) ? -1 : 0; /* has ext already */
+#endif
+
+#ifdef VMS
+    if (dosearch && !strpbrk(scriptname,":[</") && (my_getenv("DCL$PATH"))) {
+	int idx = 0;
+
+	while (my_trnlnm("DCL$PATH",tokenbuf,idx++)) {
+	    strcat(tokenbuf,scriptname);
+#else  /* !VMS */
+    if (dosearch && !strchr(scriptname, '/') && (s = getenv("PATH"))) {
+
+	bufend = s + strlen(s);
+	while (*s) {
+#ifndef DOSISH
+	    s = cpytill(tokenbuf,s,bufend,':',&len);
+#else
+#ifdef atarist
+	    for (len = 0; *s && *s != ',' && *s != ';'; tokenbuf[len++] = *s++);
+	    tokenbuf[len] = '\0';
+#else
+	    for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
+	    tokenbuf[len] = '\0';
+#endif
+#endif
+	    if (*s)
+		s++;
+#ifndef DOSISH
+	    if (len && tokenbuf[len-1] != '/')
+#else
+#ifdef atarist
+	    if (len && ((tokenbuf[len-1] != '\\') && (tokenbuf[len-1] != '/')))
+#else
+	    if (len && tokenbuf[len-1] != '\\')
+#endif
+#endif
+		(void)strcat(tokenbuf+len,"/");
+	    (void)strcat(tokenbuf+len,scriptname);
+#endif  /* !VMS */
+
+#ifdef SEARCH_EXTS
+	    len = strlen(tokenbuf);
+	    if (extidx > 0)	/* reset after previous loop */
+		extidx = 0;
+	    do {
+#endif
+		DEBUG_p(fprintf(stderr,"Looking for %s\n",tokenbuf));
+		retval = Stat(tokenbuf,&statbuf);
+#ifdef SEARCH_EXTS
+	    } while (  retval < 0		/* not there */
+		    && extidx>=0 && ext[extidx]	/* try an extension? */
+		    && strcpy(tokenbuf+len, ext[extidx++])
+		);
+#endif
+	    if (retval < 0)
+		continue;
+	    if (S_ISREG(statbuf.st_mode)
+	     && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
+		xfound = tokenbuf;              /* bingo! */
+		break;
+	    }
+	    if (!xfailed)
+		xfailed = savepv(tokenbuf);
+	}
+	if (!xfound)
+	    croak("Can't execute %s", xfailed ? xfailed : scriptname );
+	if (xfailed)
+	    Safefree(xfailed);
+	scriptname = xfound;
+    }
+
+    if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
+	char *s = scriptname + 8;
+	fdscript = atoi(s);
+	while (isDIGIT(*s))
+	    s++;
+	if (*s)
+	    scriptname = s + 1;
+    }
+    else
+	fdscript = -1;
+    origfilename = savepv(e_tmpname ? "-e" : scriptname);
+    curcop->cop_filegv = gv_fetchfile(origfilename);
+    if (strEQ(origfilename,"-"))
+	scriptname = "";
+    if (fdscript >= 0) {
+	rsfp = fdopen(fdscript,"r");
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	fcntl(fileno(rsfp),F_SETFD,1);	/* ensure close-on-exec */
+#endif
+    }
+    else if (preprocess) {
+	char *cpp = CPPSTDIN;
+
+	if (strEQ(cpp,"cppstdin"))
+	    sprintf(tokenbuf, "%s/%s", SCRIPTDIR, cpp);
+	else
+	    sprintf(tokenbuf, "%s", cpp);
+	sv_catpv(sv,"-I");
+	sv_catpv(sv,PRIVLIB_EXP);
+#ifdef MSDOS
+	(void)sprintf(buf, "\
+sed %s -e \"/^[^#]/b\" \
+ -e \"/^#[ 	]*include[ 	]/b\" \
+ -e \"/^#[ 	]*define[ 	]/b\" \
+ -e \"/^#[ 	]*if[ 	]/b\" \
+ -e \"/^#[ 	]*ifdef[ 	]/b\" \
+ -e \"/^#[ 	]*ifndef[ 	]/b\" \
+ -e \"/^#[ 	]*else/b\" \
+ -e \"/^#[ 	]*elif[ 	]/b\" \
+ -e \"/^#[ 	]*undef[ 	]/b\" \
+ -e \"/^#[ 	]*endif/b\" \
+ -e \"s/^#.*//\" \
+ %s | %s -C %s %s",
+	  (doextract ? "-e \"1,/^#/d\n\"" : ""),
+#else
+	(void)sprintf(buf, "\
+%s %s -e '/^[^#]/b' \
+ -e '/^#[ 	]*include[ 	]/b' \
+ -e '/^#[ 	]*define[ 	]/b' \
+ -e '/^#[ 	]*if[ 	]/b' \
+ -e '/^#[ 	]*ifdef[ 	]/b' \
+ -e '/^#[ 	]*ifndef[ 	]/b' \
+ -e '/^#[ 	]*else/b' \
+ -e '/^#[ 	]*elif[ 	]/b' \
+ -e '/^#[ 	]*undef[ 	]/b' \
+ -e '/^#[ 	]*endif/b' \
+ -e 's/^[ 	]*#.*//' \
+ %s | %s -C %s %s",
+#ifdef LOC_SED
+	  LOC_SED,
+#else
+	  "sed",
+#endif
+	  (doextract ? "-e '1,/^#/d\n'" : ""),
+#endif
+	  scriptname, tokenbuf, SvPV(sv, na), CPPMINUS);
+	doextract = FALSE;
+#ifdef IAMSUID				/* actually, this is caught earlier */
+	if (euid != uid && !euid) {	/* if running suidperl */
+#ifdef HAS_SETEUID
+	    (void)seteuid(uid);		/* musn't stay setuid root */
+#else
+#ifdef HAS_SETREUID
+	    (void)setreuid((Uid_t)-1, uid);
+#else
+#ifdef HAS_SETRESUID
+	    (void)setresuid((Uid_t)-1, uid, (Uid_t)-1);
+#else
+	    setuid(uid);
+#endif
+#endif
+#endif
+	    if (geteuid() != uid)
+		croak("Can't do seteuid!\n");
+	}
+#endif /* IAMSUID */
+	rsfp = my_popen(buf,"r");
+    }
+    else if (!*scriptname) {
+	taint_not("program input from stdin");
+	rsfp = stdin;
+    }
+    else {
+	rsfp = fopen(scriptname,"r");
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+	fcntl(fileno(rsfp),F_SETFD,1);	/* ensure close-on-exec */
+#endif
+    }
+    if ((FILE*)rsfp == Nullfp) {
+#ifdef DOSUID
+#ifndef IAMSUID		/* in case script is not readable before setuid */
+	if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
+	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
+	    execv(buf, origargv);	/* try again */
+	    croak("Can't do setuid\n");
+	}
+#endif
+#endif
+	croak("Can't open perl script \"%s\": %s\n",
+	  SvPVX(GvSV(curcop->cop_filegv)), Strerror(errno));
+    }
+}
+
+static void
+validate_suid(validarg, scriptname)
+char *validarg;
+char *scriptname;
+{
+    int which;
+
+    /* do we need to emulate setuid on scripts? */
+
+    /* This code is for those BSD systems that have setuid #! scripts disabled
+     * in the kernel because of a security problem.  Merely defining DOSUID
+     * in perl will not fix that problem, but if you have disabled setuid
+     * scripts in the kernel, this will attempt to emulate setuid and setgid
+     * on scripts that have those now-otherwise-useless bits set.  The setuid
+     * root version must be called suidperl or sperlN.NNN.  If regular perl
+     * discovers that it has opened a setuid script, it calls suidperl with
+     * the same argv that it had.  If suidperl finds that the script it has
+     * just opened is NOT setuid root, it sets the effective uid back to the
+     * uid.  We don't just make perl setuid root because that loses the
+     * effective uid we had before invoking perl, if it was different from the
+     * uid.
+     *
+     * DOSUID must be defined in both perl and suidperl, and IAMSUID must
+     * be defined in suidperl only.  suidperl must be setuid root.  The
+     * Configure script will set this up for you if you want it.
+     */
+
+#ifdef DOSUID
+    char *s;
+
+    if (Fstat(fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
+	croak("Can't stat script \"%s\"",origfilename);
+    if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
+	I32 len;
+
+#ifdef IAMSUID
+#ifndef HAS_SETREUID
+	/* On this access check to make sure the directories are readable,
+	 * there is actually a small window that the user could use to make
+	 * filename point to an accessible directory.  So there is a faint
+	 * chance that someone could execute a setuid script down in a
+	 * non-accessible directory.  I don't know what to do about that.
+	 * But I don't think it's too important.  The manual lies when
+	 * it says access() is useful in setuid programs.
+	 */
+	if (access(SvPVX(GvSV(curcop->cop_filegv)),1))	/*double check*/
+	    croak("Permission denied");
+#else
+	/* If we can swap euid and uid, then we can determine access rights
+	 * with a simple stat of the file, and then compare device and
+	 * inode to make sure we did stat() on the same file we opened.
+	 * Then we just have to make sure he or she can execute it.
+	 */
+	{
+	    struct stat tmpstatbuf;
+
+	    if (
+#ifdef HAS_SETREUID
+		setreuid(euid,uid) < 0
+#else
+# if HAS_SETRESUID
+		setresuid(euid,uid,(Uid_t)-1) < 0
+# endif
+#endif
+		|| getuid() != euid || geteuid() != uid)
+		croak("Can't swap uid and euid");	/* really paranoid */
+	    if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
+		croak("Permission denied");	/* testing full pathname here */
+	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
+		tmpstatbuf.st_ino != statbuf.st_ino) {
+		(void)fclose(rsfp);
+		if (rsfp = my_popen("/bin/mail root","w")) {	/* heh, heh */
+		    fprintf(rsfp,
+"User %d tried to run dev %d ino %d in place of dev %d ino %d!\n\
+(Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
+			uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
+			statbuf.st_dev, statbuf.st_ino,
+			SvPVX(GvSV(curcop->cop_filegv)),
+			statbuf.st_uid, statbuf.st_gid);
+		    (void)my_pclose(rsfp);
+		}
+		croak("Permission denied\n");
+	    }
+	    if (
+#ifdef HAS_SETREUID
+              setreuid(uid,euid) < 0
+#else
+# if defined(HAS_SETRESUID)
+              setresuid(uid,euid,(Uid_t)-1) < 0
+# endif
+#endif
+              || getuid() != uid || geteuid() != euid)
+		croak("Can't reswap uid and euid");
+	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
+		croak("Permission denied\n");
+	}
+#endif /* HAS_SETREUID */
+#endif /* IAMSUID */
+
+	if (!S_ISREG(statbuf.st_mode))
+	    croak("Permission denied");
+	if (statbuf.st_mode & S_IWOTH)
+	    croak("Setuid/gid script is writable by world");
+	doswitches = FALSE;		/* -s is insecure in suid */
+	curcop->cop_line++;
+	if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
+	  strnNE(tokenbuf,"#!",2) )	/* required even on Sys V */
+	    croak("No #! line");
+	s = tokenbuf+2;
+	if (*s == ' ') s++;
+	while (!isSPACE(*s)) s++;
+	if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
+	    croak("Not a perl script");
+	while (*s == ' ' || *s == '\t') s++;
+	/*
+	 * #! arg must be what we saw above.  They can invoke it by
+	 * mentioning suidperl explicitly, but they may not add any strange
+	 * arguments beyond what #! says if they do invoke suidperl that way.
+	 */
+	len = strlen(validarg);
+	if (strEQ(validarg," PHOOEY ") ||
+	    strnNE(s,validarg,len) || !isSPACE(s[len]))
+	    croak("Args must match #! line");
+
+#ifndef IAMSUID
+	if (euid != uid && (statbuf.st_mode & S_ISUID) &&
+	    euid == statbuf.st_uid)
+	    if (!do_undump)
+		croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
+#endif /* IAMSUID */
+
+	if (euid) {	/* oops, we're not the setuid root perl */
+	    (void)fclose(rsfp);
+#ifndef IAMSUID
+	    (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel);
+	    execv(buf, origargv);	/* try again */
+#endif
+	    croak("Can't do setuid\n");
+	}
+
+	if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) {
+#ifdef HAS_SETEGID
+	    (void)setegid(statbuf.st_gid);
+#else
+#ifdef HAS_SETREGID
+           (void)setregid((Gid_t)-1,statbuf.st_gid);
+#else
+#ifdef HAS_SETRESGID
+           (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1);
+#else
+	    setgid(statbuf.st_gid);
+#endif
+#endif
+#endif
+	    if (getegid() != statbuf.st_gid)
+		croak("Can't do setegid!\n");
+	}
+	if (statbuf.st_mode & S_ISUID) {
+	    if (statbuf.st_uid != euid)
+#ifdef HAS_SETEUID
+		(void)seteuid(statbuf.st_uid);	/* all that for this */
+#else
+#ifdef HAS_SETREUID
+                (void)setreuid((Uid_t)-1,statbuf.st_uid);
+#else
+#ifdef HAS_SETRESUID
+                (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1);
+#else
+		setuid(statbuf.st_uid);
+#endif
+#endif
+#endif
+	    if (geteuid() != statbuf.st_uid)
+		croak("Can't do seteuid!\n");
+	}
+	else if (uid) {			/* oops, mustn't run as root */
+#ifdef HAS_SETEUID
+          (void)seteuid((Uid_t)uid);
+#else
+#ifdef HAS_SETREUID
+          (void)setreuid((Uid_t)-1,(Uid_t)uid);
+#else
+#ifdef HAS_SETRESUID
+          (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1);
+#else
+          setuid((Uid_t)uid);
+#endif
+#endif
+#endif
+	    if (geteuid() != uid)
+		croak("Can't do seteuid!\n");
+	}
+	init_ids();
+	if (!cando(S_IXUSR,TRUE,&statbuf))
+	    croak("Permission denied\n");	/* they can't do this */
+    }
+#ifdef IAMSUID
+    else if (preprocess)
+	croak("-P not allowed for setuid/setgid script\n");
+    else if (fdscript >= 0)
+	croak("fd script not allowed in suidperl\n");
+    else
+	croak("Script is not setuid/setgid in suidperl\n");
+
+    /* We absolutely must clear out any saved ids here, so we */
+    /* exec the real perl, substituting fd script for scriptname. */
+    /* (We pass script name as "subdir" of fd, which perl will grok.) */
+    rewind(rsfp);
+    for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
+    if (!origargv[which])
+	croak("Permission denied");
+    (void)sprintf(buf, "/dev/fd/%d/%.127s", fileno(rsfp), origargv[which]);
+    origargv[which] = buf;
+
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+    fcntl(fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+#endif
+
+    (void)sprintf(tokenbuf, "%s/perl%s", BIN, patchlevel);
+    execv(tokenbuf, origargv);	/* try again */
+    croak("Can't do setuid\n");
+#endif /* IAMSUID */
+#else /* !DOSUID */
+    if (euid != uid || egid != gid) {	/* (suidperl doesn't exist, in fact) */
+#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+	Fstat(fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
+	if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
+	    ||
+	    (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
+	   )
+	    if (!do_undump)
+		croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
+#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
+	/* not set-id, must be wrapped */
+    }
+#endif /* DOSUID */
+}
+
+static void
+find_beginning()
+{
+    register char *s;
+
+    /* skip forward in input to the real script? */
+
+    taint_not("-x");
+    while (doextract) {
+	if ((s = sv_gets(linestr, rsfp, 0)) == Nullch)
+	    croak("No Perl script found in input\n");
+	if (*s == '#' && s[1] == '!' && instr(s,"perl")) {
+	    ungetc('\n',rsfp);		/* to keep line count right */
+	    doextract = FALSE;
+	    if (s = instr(s,"perl -")) {
+		s += 6;
+		/*SUPPRESS 530*/
+		while (s = moreswitches(s)) ;
+	    }
+	    if (cddir && chdir(cddir) < 0)
+		croak("Can't chdir to %s",cddir);
+	}
+    }
+}
+
+static void
+init_ids()
+{
+    uid = (int)getuid();
+    euid = (int)geteuid();
+    gid = (int)getgid();
+    egid = (int)getegid();
+#ifdef VMS
+    uid |= gid << 16;
+    euid |= egid << 16;
+#endif
+    tainting |= (uid && (euid != uid || egid != gid));
+}
+
+static void
+init_debugger()
+{
+    curstash = debstash;
+    dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
+    AvREAL_off(dbargs);
+    DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
+    DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
+    DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+    DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
+    sv_setiv(DBsingle, 0); 
+    DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
+    sv_setiv(DBtrace, 0); 
+    DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
+    sv_setiv(DBsignal, 0); 
+    curstash = defstash;
+}
+
+static void
+init_stacks()
+{
+    stack = newAV();
+    mainstack = stack;			/* remember in case we switch stacks */
+    AvREAL_off(stack);			/* not a real array */
+    av_extend(stack,127);
+
+    stack_base = AvARRAY(stack);
+    stack_sp = stack_base;
+    stack_max = stack_base + 127;
+
+    New(54,markstack,64,I32);
+    markstack_ptr = markstack;
+    markstack_max = markstack + 64;
+
+    New(54,scopestack,32,I32);
+    scopestack_ix = 0;
+    scopestack_max = 32;
+
+    New(54,savestack,128,ANY);
+    savestack_ix = 0;
+    savestack_max = 128;
+
+    New(54,retstack,16,OP*);
+    retstack_ix = 0;
+    retstack_max = 16;
+
+    cxstack_max = 8192 / sizeof(CONTEXT) - 2;	/* Use most of 8K. */
+    New(50,cxstack,cxstack_max + 1,CONTEXT);
+    cxstack_ix	= -1;
+
+    New(50,tmps_stack,128,SV*);
+    tmps_ix = -1;
+    tmps_max = 128;
+
+    DEBUG( {
+	New(51,debname,128,char);
+	New(52,debdelim,128,char);
+    } )
+}
+
+static FILE *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
+static void
+init_lexer()
+{
+    tmpfp = rsfp;
+
+    lex_start(linestr);
+    rsfp = tmpfp;
+    subname = newSVpv("main",4);
+}
+
+static void
+init_predump_symbols()
+{
+    GV *tmpgv;
+    GV *othergv;
+
+    sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
+
+    stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
+    GvMULTI_on(stdingv);
+    IoIFP(GvIOp(stdingv)) = stdin;
+    tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(stdingv));
+
+    tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
+    GvMULTI_on(tmpgv);
+    IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = stdout;
+    setdefout(tmpgv);
+    tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(defoutgv));
+
+    othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
+    GvMULTI_on(othergv);
+    IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = stderr;
+    tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
+    GvMULTI_on(tmpgv);
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
+
+    statname = NEWSV(66,0);		/* last filename we did stat on */
+
+    osname = savepv(OSNAME);
+}
+
+static void
+init_postdump_symbols(argc,argv,env)
+register int argc;
+register char **argv;
+register char **env;
+{
+    char *s;
+    SV *sv;
+    GV* tmpgv;
+
+    argc--,argv++;	/* skip name of script */
+    if (doswitches) {
+	for (; argc > 0 && **argv == '-'; argc--,argv++) {
+	    if (!argv[0][1])
+		break;
+	    if (argv[0][1] == '-') {
+		argc--,argv++;
+		break;
+	    }
+	    if (s = strchr(argv[0], '=')) {
+		*s++ = '\0';
+		sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+	    }
+	    else
+		sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
+	}
+    }
+    toptarget = NEWSV(0,0);
+    sv_upgrade(toptarget, SVt_PVFM);
+    sv_setpvn(toptarget, "", 0);
+    bodytarget = NEWSV(0,0);
+    sv_upgrade(bodytarget, SVt_PVFM);
+    sv_setpvn(bodytarget, "", 0);
+    formtarget = bodytarget;
+
+    tainted = 1;
+    if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
+	sv_setpv(GvSV(tmpgv),origfilename);
+	magicname("0", "0", 1);
+    }
+    if (tmpgv = gv_fetchpv("\024",TRUE, SVt_PV))
+	time(&basetime);
+    if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
+	sv_setpv(GvSV(tmpgv),origargv[0]);
+    if (argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) {
+	GvMULTI_on(argvgv);
+	(void)gv_AVadd(argvgv);
+	av_clear(GvAVn(argvgv));
+	for (; argc > 0; argc--,argv++) {
+	    av_push(GvAVn(argvgv),newSVpv(argv[0],0));
+	}
+    }
+    if (envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
+	HV *hv;
+	GvMULTI_on(envgv);
+	hv = GvHVn(envgv);
+	hv_clear(hv);
+#ifndef VMS  /* VMS doesn't have environ array */
+	/* Note that if the supplied env parameter is actually a copy
+	   of the global environ then it may now point to free'd memory
+	   if the environment has been modified since. To avoid this
+	   problem we treat env==NULL as meaning 'use the default'
+	*/
+	if (!env)
+	    env = environ;
+	if (env != environ) {
+	    environ[0] = Nullch;
+	    hv_magic(hv, envgv, 'E');
+	}
+	for (; *env; env++) {
+	    if (!(s = strchr(*env,'=')))
+		continue;
+	    *s++ = '\0';
+	    sv = newSVpv(s--,0);
+	    sv_magic(sv, sv, 'e', *env, s - *env);
+	    (void)hv_store(hv, *env, s - *env, sv, 0);
+	    *s = '=';
+	}
+#endif
+#ifdef DYNAMIC_ENV_FETCH
+	HvNAME(hv) = savepv(ENV_HV_NAME);
+#endif
+	hv_magic(hv, envgv, 'E');
+    }
+    tainted = 0;
+    if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
+	sv_setiv(GvSV(tmpgv),(I32)getpid());
+
+}
+
+static void
+init_perllib()
+{
+    char *s;
+    if (!tainting) {
+	s = getenv("PERL5LIB");
+	if (s)
+	    incpush(s);
+	else
+	    incpush(getenv("PERLLIB"));
+    }
+
+#ifdef APPLLIB_EXP
+    incpush(APPLLIB_EXP);
+#endif
+
+#ifdef ARCHLIB_EXP
+    incpush(ARCHLIB_EXP);
+#endif
+#ifndef PRIVLIB_EXP
+#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
+#endif
+    incpush(PRIVLIB_EXP);
+
+#ifdef SITEARCH_EXP
+    incpush(SITEARCH_EXP);
+#endif
+#ifdef SITELIB_EXP
+    incpush(SITELIB_EXP);
+#endif
+#ifdef OLDARCHLIB_EXP  /* 5.00[01] compatibility */
+    incpush(OLDARCHLIB_EXP);
+#endif
+    
+    if (!tainting)
+	incpush(".");
+}
+
+void
+calllist(list)
+AV* list;
+{
+    Sigjmp_buf oldtop;
+    STRLEN len;
+    line_t oldline = curcop->cop_line;
+
+    Copy(top_env, oldtop, 1, Sigjmp_buf);
+
+    while (AvFILL(list) >= 0) {
+	CV *cv = (CV*)av_shift(list);
+
+	SAVEFREESV(cv);
+
+	switch (Sigsetjmp(top_env,1)) {
+	case 0: {
+		SV* atsv = GvSV(errgv);
+		PUSHMARK(stack_sp);
+		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
+		(void)SvPV(atsv, len);
+		if (len) {
+		    Copy(oldtop, top_env, 1, Sigjmp_buf);
+		    curcop = &compiling;
+		    curcop->cop_line = oldline;
+		    if (list == beginav)
+			sv_catpv(atsv, "BEGIN failed--compilation aborted");
+		    else
+			sv_catpv(atsv, "END failed--cleanup aborted");
+		    croak("%s", SvPVX(atsv));
+		}
+	    }
+	    break;
+	case 1:
+#ifdef VMS
+	    statusvalue = 255;	/* XXX I don't think we use 1 anymore. */
+#else
+	statusvalue = 1;
+#endif
+	    /* FALL THROUGH */
+	case 2:
+	    /* my_exit() was called */
+	    curstash = defstash;
+	    if (endav)
+		calllist(endav);
+	    FREETMPS;
+	    Copy(oldtop, top_env, 1, Sigjmp_buf);
+	    curcop = &compiling;
+	    curcop->cop_line = oldline;
+	    if (statusvalue) {
+		if (list == beginav)
+		    croak("BEGIN failed--compilation aborted");
+		else
+		    croak("END failed--cleanup aborted");
+	    }
+	    my_exit(statusvalue);
+	    /* NOTREACHED */
+	    return;
+	case 3:
+	    if (!restartop) {
+		fprintf(stderr, "panic: restartop\n");
+		FREETMPS;
+		break;
+	    }
+	    Copy(oldtop, top_env, 1, Sigjmp_buf);
+	    curcop = &compiling;
+	    curcop->cop_line = oldline;
+	    Siglongjmp(top_env, 3);
+	}
+    }
+
+    Copy(oldtop, top_env, 1, Sigjmp_buf);
+}
+
diff --git a/gnu/usr.bin/perl/perl.h b/gnu/usr.bin/perl/perl.h
new file mode 100644
index 00000000000..bfb921034c8
--- /dev/null
+++ b/gnu/usr.bin/perl/perl.h
@@ -0,0 +1,1618 @@
+/*    perl.h
+ *
+ *    Copyright (c) 1987-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.
+ *
+ */
+#ifndef H_PERL
+#define H_PERL 1
+#define OVERLOAD
+
+/*
+ * STMT_START { statements; } STMT_END;
+ * can be used as a single statement, as in
+ * if (x) STMT_START { ... } STMT_END; else ...
+ *
+ * Trying to select a version that gives no warnings...
+ */
+#if !(defined(STMT_START) && defined(STMT_END))
+# if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+#   define STMT_START	(void)(	/* gcc supports ``({ STATEMENTS; })'' */
+#   define STMT_END	)
+# else
+   /* Now which other defined()s do we need here ??? */
+#  if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
+#   define STMT_START	if (1)
+#   define STMT_END	else (void)0
+#  else
+#   define STMT_START	do
+#   define STMT_END	while (0)
+#  endif
+# endif
+#endif
+
+#include "embed.h"
+
+#define VOIDUSED 1
+#include "config.h"
+
+#ifndef BYTEORDER
+#   define BYTEORDER 0x1234
+#endif
+
+/* Overall memory policy? */
+#ifndef CONSERVATIVE
+#   define LIBERAL 1
+#endif
+
+/*
+ * 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...
+ */
+
+/* define this once if either system, instead of cluttering up the src */
+#if defined(MSDOS) || defined(atarist)
+#define DOSISH 1
+#endif
+
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
+#if defined(HASVOLATILE) || defined(STANDARD_C)
+#   ifdef __cplusplus
+#	define VOL		// to temporarily suppress warnings
+#   else
+#	define VOL volatile
+#   endif
+#else
+#   define VOL
+#endif
+
+#define TAINT_IF(c)	(tainted |= (c))
+#define TAINT_NOT	(tainted = 0)
+#define TAINT_PROPER(s)	if (tainting) taint_proper(no_security, s)
+#define TAINT_ENV()	if (tainting) taint_env()
+
+#ifdef USE_BSDPGRP
+#   ifdef HAS_GETPGRP
+#       define BSD_GETPGRP(pid) getpgrp((pid))
+#   endif
+#   ifdef HAS_SETPGRP
+#       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
+#   endif
+#else
+#   ifdef HAS_GETPGRP2
+#       define BSD_GETPGRP(pid) getpgrp2((pid))
+#       ifndef HAS_GETPGRP
+#    	    define HAS_GETPGRP
+#    	endif
+#   endif
+#   ifdef HAS_SETPGRP2
+#       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
+#       ifndef HAS_SETPGRP
+#    	    define HAS_SETPGRP
+#    	endif
+#   endif
+#endif
+
+#include <stdio.h>
+#ifdef USE_NEXT_CTYPE
+#include <appkit/NXCType.h>
+#else
+#include <ctype.h>
+#endif
+
+#ifdef I_LOCALE
+#include <locale.h>
+#endif
+
+#ifdef METHOD 	/* Defined by OSF/1 v3.0 by ctype.h */
+#undef METHOD
+#endif
+
+#include <setjmp.h>
+
+#ifdef I_SYS_PARAM
+#   ifdef PARAM_NEEDS_TYPES
+#	include <sys/types.h>
+#   endif
+#   include <sys/param.h>
+#endif
+
+
+/* Use all the "standard" definitions? */
+#if defined(STANDARD_C) && defined(I_STDLIB)
+#   include <stdlib.h>
+#endif /* STANDARD_C */
+
+/* Maybe this comes after <stdlib.h> so we don't try to change 
+   the standard library prototypes?.  We'll use our own in 
+   proto.h instead.  I guess.  The patch had no explanation.
+*/
+#ifdef MYMALLOC
+#   ifdef HIDEMYMALLOC
+#	define malloc Mymalloc
+#	define realloc Myremalloc
+#	define free Myfree
+#   endif
+#   define safemalloc malloc
+#   define saferealloc realloc
+#   define safefree free
+#endif
+
+#define MEM_SIZE Size_t
+
+#if defined(I_STRING) || defined(__cplusplus)
+#   include <string.h>
+#else
+#   include <strings.h>
+#endif
+
+#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
+#define strchr index
+#define strrchr rindex
+#endif
+
+#if defined(mips) && defined(ultrix) && !defined(__STDC__)
+#   undef HAS_MEMCMP
+#endif
+
+#ifdef I_MEMORY
+#  include <memory.h>
+#endif
+
+#ifdef HAS_MEMCPY
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcpy
+        extern char * memcpy _((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 _((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 */
+
+#ifdef HAS_MEMCMP
+#  if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+#    ifndef memcmp
+	extern int memcmp _((char*, char*, int));
+#    endif
+#  endif
+#else
+#   ifndef memcmp
+#	define memcmp 	my_memcmp
+#   endif
+#endif /* HAS_MEMCMP */
+
+/* XXX we prefer bcmp slightly for comparisons that don't care about ordering */
+#ifndef HAS_BCMP
+#   ifndef bcmp
+#	define bcmp(s1,s2,l) memcmp(s1,s2,l)
+#   endif
+#endif /* HAS_BCMP */
+
+#if !defined(HAS_MEMMOVE) && !defined(memmove)
+#   if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
+#	define memmove(d,s,l) bcopy(s,d,l)
+#   else
+#	if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
+#	    define memmove(d,s,l) memcpy(d,s,l)
+#	else
+#	    define memmove(d,s,l) my_bcopy(s,d,l)
+#	endif
+#   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
+
+#ifdef I_NETINET_IN
+#   include <netinet/in.h>
+#endif
+
+#ifdef I_SYS_STAT
+#include <sys/stat.h>
+#endif
+
+/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
+   like UTekV) are broken, sometimes giving false positives.  Undefine
+   them here and let the code below set them to proper values.
+
+   The ghs macro stands for GreenHills Software C-1.8.5 which
+   is the C compiler for sysV88 and the various derivatives.
+   This header file bug is corrected in gcc-2.5.8 and later versions.
+   --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94.  */
+
+#if defined(uts) || (defined(m88k) && defined(ghs))
+#   undef S_ISDIR
+#   undef S_ISCHR
+#   undef S_ISBLK
+#   undef S_ISREG
+#   undef S_ISFIFO
+#   undef S_ISLNK
+#endif
+
+#ifdef I_TIME
+#   include <time.h>
+#endif
+
+#ifdef I_SYS_TIME
+#   ifdef I_SYS_TIME_KERNEL
+#	define KERNEL
+#   endif
+#   include <sys/time.h>
+#   ifdef I_SYS_TIME_KERNEL
+#	undef KERNEL
+#   endif
+#endif
+
+#ifndef MSDOS
+#  if defined(HAS_TIMES) && defined(I_SYS_TIMES)
+#    include <sys/times.h>
+#  endif
+#endif
+
+#if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR))
+#   undef HAS_STRERROR
+#endif
+
+#ifndef HAS_MKFIFO
+#  ifndef mkfifo
+#    define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
+#  endif
+#endif /* !HAS_MKFIFO */
+
+#include <errno.h>
+#ifdef HAS_SOCKET
+#   ifdef I_NET_ERRNO
+#     include <net/errno.h>
+#   endif
+#endif
+#ifndef VMS
+#   define FIXSTATUS(sts)  (U_L((sts) & 0xffff))
+#   define SHIFTSTATUS(sts) ((sts) >> 8)
+#   define SETERRNO(errcode,vmserrcode) errno = (errcode)
+#else
+#   define FIXSTATUS(sts)  (U_L(sts))
+#   define SHIFTSTATUS(sts) (sts)
+#   define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END
+#endif
+
+#ifndef MSDOS
+#   ifndef errno
+	extern int errno;     /* ANSI allows errno to be an lvalue expr */
+#   endif
+#endif
+
+#ifdef HAS_STRERROR
+#       ifdef VMS
+	char *strerror _((int,...));
+#       else
+	char *strerror _((int));
+#       endif
+#       ifndef Strerror
+#           define Strerror strerror
+#       endif
+#else
+#    ifdef HAS_SYS_ERRLIST
+	extern int sys_nerr;
+	extern char *sys_errlist[];
+#       ifndef Strerror
+#           define Strerror(e) \
+		((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+#       endif
+#   endif
+#endif
+
+#ifdef I_SYS_IOCTL
+#   ifndef _IOCTL_
+#	include <sys/ioctl.h>
+#   endif
+#endif
+
+#if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
+#   ifdef HAS_SOCKETPAIR
+#	undef HAS_SOCKETPAIR
+#   endif
+#   ifdef I_NDBM
+#	undef I_NDBM
+#   endif
+#endif
+
+#if INTSIZE == 2
+#   define htoni htons
+#   define ntohi ntohs
+#else
+#   define htoni htonl
+#   define ntohi ntohl
+#endif
+
+/* Configure already sets Direntry_t */
+#if defined(I_DIRENT)
+#   include <dirent.h>
+#   if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
+#	include <sys/dir.h>
+#   endif
+#else
+#   ifdef I_SYS_NDIR
+#	include <sys/ndir.h>
+#   else
+#	ifdef I_SYS_DIR
+#	    ifdef hp9000s500
+#		include <ndir.h>	/* may be wrong in the future */
+#	    else
+#		include <sys/dir.h>
+#	    endif
+#	endif
+#   endif
+#endif
+
+#ifdef FPUTS_BOTCH
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
+#   ifndef fputs
+#	define fputs(sv,fp) fprintf(fp,"%s",sv)
+#   endif
+#endif
+
+/*
+ * The following gobbledygook brought to you on behalf of __STDC__.
+ * (I could just use #ifndef __STDC__, but this is more bulletproof
+ * in the face of half-implementations.)
+ */
+
+#ifndef S_IFMT
+#   ifdef _S_IFMT
+#	define S_IFMT _S_IFMT
+#   else
+#	define S_IFMT 0170000
+#   endif
+#endif
+
+#ifndef S_ISDIR
+#   define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
+#endif
+
+#ifndef S_ISCHR
+#   define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
+#endif
+
+#ifndef S_ISBLK
+#   ifdef S_IFBLK
+#	define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
+#   else
+#	define S_ISBLK(m) (0)
+#   endif
+#endif
+
+#ifndef S_ISREG
+#   define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef S_ISFIFO
+#   ifdef S_IFIFO
+#	define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
+#   else
+#	define S_ISFIFO(m) (0)
+#   endif
+#endif
+
+#ifndef S_ISLNK
+#   ifdef _S_ISLNK
+#	define S_ISLNK(m) _S_ISLNK(m)
+#   else
+#	ifdef _S_IFLNK
+#	    define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+#	else
+#	    ifdef S_IFLNK
+#		define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+#	    else
+#		define S_ISLNK(m) (0)
+#	    endif
+#	endif
+#   endif
+#endif
+
+#ifndef S_ISSOCK
+#   ifdef _S_ISSOCK
+#	define S_ISSOCK(m) _S_ISSOCK(m)
+#   else
+#	ifdef _S_IFSOCK
+#	    define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+#	else
+#	    ifdef S_IFSOCK
+#		define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+#	    else
+#		define S_ISSOCK(m) (0)
+#	    endif
+#	endif
+#   endif
+#endif
+
+#ifndef S_IRUSR
+#   ifdef S_IREAD
+#	define S_IRUSR S_IREAD
+#	define S_IWUSR S_IWRITE
+#	define S_IXUSR S_IEXEC
+#   else
+#	define S_IRUSR 0400
+#	define S_IWUSR 0200
+#	define S_IXUSR 0100
+#   endif
+#   define S_IRGRP (S_IRUSR>>3)
+#   define S_IWGRP (S_IWUSR>>3)
+#   define S_IXGRP (S_IXUSR>>3)
+#   define S_IROTH (S_IRUSR>>6)
+#   define S_IWOTH (S_IWUSR>>6)
+#   define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_ISUID
+#   define S_ISUID 04000
+#endif
+
+#ifndef S_ISGID
+#   define S_ISGID 02000
+#endif
+
+#ifdef ff_next
+#   undef ff_next
+#endif
+
+#if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
+#   define SLOPPYDIVIDE
+#endif
+
+#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
+#   define HAS_QUAD
+#endif
+
+#ifdef UV
+#undef UV
+#endif
+
+#ifdef HAS_QUAD
+#   ifdef cray
+#	define Quad_t int
+#   else
+#	if defined(convex) || defined (uts)
+#	    define Quad_t long long
+#	else
+#	    define Quad_t long
+#	endif
+#   endif
+    typedef Quad_t IV;
+    typedef unsigned Quad_t UV;
+#else
+    typedef long IV;
+    typedef unsigned long UV;
+#endif
+
+typedef MEM_SIZE STRLEN;
+
+typedef struct op OP;
+typedef struct cop COP;
+typedef struct unop UNOP;
+typedef struct binop BINOP;
+typedef struct listop LISTOP;
+typedef struct logop LOGOP;
+typedef struct condop CONDOP;
+typedef struct pmop PMOP;
+typedef struct svop SVOP;
+typedef struct gvop GVOP;
+typedef struct pvop PVOP;
+typedef struct loop LOOP;
+
+typedef struct Outrec Outrec;
+typedef struct interpreter PerlInterpreter;
+typedef struct ff FF;
+typedef struct sv SV;
+typedef struct av AV;
+typedef struct hv HV;
+typedef struct cv CV;
+typedef struct regexp REGEXP;
+typedef struct gp GP;
+typedef struct sv GV;
+typedef struct io IO;
+typedef struct context CONTEXT;
+typedef struct block BLOCK;
+
+typedef struct magic MAGIC;
+typedef struct xrv XRV;
+typedef struct xpv XPV;
+typedef struct xpviv XPVIV;
+typedef struct xpvnv XPVNV;
+typedef struct xpvmg XPVMG;
+typedef struct xpvlv XPVLV;
+typedef struct xpvav XPVAV;
+typedef struct xpvhv XPVHV;
+typedef struct xpvgv XPVGV;
+typedef struct xpvcv XPVCV;
+typedef struct xpvbm XPVBM;
+typedef struct xpvfm XPVFM;
+typedef struct xpvio XPVIO;
+typedef struct mgvtbl MGVTBL;
+typedef union any ANY;
+
+#include "handy.h"
+
+typedef I32 (*filter_t) _((int, SV *, int));
+#define FILTER_READ(idx, sv, len)  filter_read(idx, sv, len)
+#define FILTER_DATA(idx)	   (AvARRAY(rsfp_filters)[idx])
+#define FILTER_ISREADER(idx)	   (idx >= AvFILL(rsfp_filters))
+
+#ifdef DOSISH
+# if defined(OS2)
+#   include "os2ish.h"
+# else
+#   include "dosish.h"
+# endif
+#else
+# if defined(VMS)
+#   include "vmsish.h"
+# else
+#   include "unixish.h"
+# endif
+#endif
+
+#ifndef HAS_PAUSE
+#define pause() sleep((32767<<16)+32767)
+#endif
+
+#ifndef IOCPARM_LEN
+#   ifdef IOCPARM_MASK
+	/* on BSDish systes we're safe */
+#	define IOCPARM_LEN(x)  (((x) >> 16) & IOCPARM_MASK)
+#   else
+	/* otherwise guess at what's safe */
+#	define IOCPARM_LEN(x)	256
+#   endif
+#endif
+
+union any {
+    void*	any_ptr;
+    I32		any_i32;
+    IV		any_iv;
+    long	any_long;
+    void	(*any_dptr) _((void*));
+};
+
+#include "regexp.h"
+#include "sv.h"
+#include "util.h"
+#include "form.h"
+#include "gv.h"
+#include "cv.h"
+#include "opcode.h"
+#include "op.h"
+#include "cop.h"
+#include "av.h"
+#include "hv.h"
+#include "mg.h"
+#include "scope.h"
+
+/* work around some libPW problems */
+#ifdef DOINIT
+EXT char Error[1];
+#endif
+
+#if defined(iAPX286) || defined(M_I286) || defined(I80286)
+#   define I286
+#endif
+
+#if defined(htonl) && !defined(HAS_HTONL)
+#define HAS_HTONL
+#endif
+#if defined(htons) && !defined(HAS_HTONS)
+#define HAS_HTONS
+#endif
+#if defined(ntohl) && !defined(HAS_NTOHL)
+#define HAS_NTOHL
+#endif
+#if defined(ntohs) && !defined(HAS_NTOHS)
+#define HAS_NTOHS
+#endif
+#ifndef HAS_HTONL
+#if (BYTEORDER & 0xffff) != 0x4321
+#define HAS_HTONS
+#define HAS_HTONL
+#define HAS_NTOHS
+#define HAS_NTOHL
+#define MYSWAP
+#define htons my_swap
+#define htonl my_htonl
+#define ntohs my_swap
+#define ntohl my_ntohl
+#endif
+#else
+#if (BYTEORDER & 0xffff) == 0x4321
+#undef HAS_HTONS
+#undef HAS_HTONL
+#undef HAS_NTOHS
+#undef HAS_NTOHL
+#endif
+#endif
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * -DWS
+ */
+#if BYTEORDER != 0x1234
+# define HAS_VTOHL
+# define HAS_VTOHS
+# define HAS_HTOVL
+# define HAS_HTOVS
+# if BYTEORDER == 0x4321
+#  define vtohl(x)	((((x)&0xFF)<<24)	\
+			+(((x)>>24)&0xFF)	\
+			+(((x)&0x0000FF00)<<8)	\
+			+(((x)&0x00FF0000)>>8)	)
+#  define vtohs(x)	((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
+#  define htovl(x)	vtohl(x)
+#  define htovs(x)	vtohs(x)
+# endif
+	/* otherwise default to functions in util.c */
+#endif
+
+#ifdef CASTNEGFLOAT
+#define U_S(what) ((U16)(what))
+#define U_I(what) ((unsigned int)(what))
+#define U_L(what) ((U32)(what))
+#else
+U32 cast_ulong _((double));
+#define U_S(what) ((U16)cast_ulong((double)(what)))
+#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
+#define U_L(what) (cast_ulong((double)(what)))
+#endif
+
+#ifdef CASTI32
+#define I_32(what) ((I32)(what))
+#define I_V(what) ((IV)(what))
+#define U_V(what) ((UV)(what))
+#else
+I32 cast_i32 _((double));
+#define I_32(what) (cast_i32((double)(what)))
+IV cast_iv _((double));
+#define I_V(what) (cast_iv((double)(what)))
+UV cast_uv _((double));
+#define U_V(what) (cast_uv((double)(what)))
+#endif
+
+struct Outrec {
+    I32		o_lines;
+    char	*o_str;
+    U32		o_len;
+};
+
+#ifndef MAXSYSFD
+#   define MAXSYSFD 2
+#endif
+
+#ifndef TMPPATH
+#  define TMPPATH "/tmp/perl-eXXXXXX"
+#endif
+
+#ifndef __cplusplus
+Uid_t getuid _((void));
+Uid_t geteuid _((void));
+Gid_t getgid _((void));
+Gid_t getegid _((void));
+#endif
+
+#ifdef DEBUGGING
+#define YYDEBUG 1
+#define DEB(a)     			a
+#define DEBUG(a)   if (debug)		a
+#define DEBUG_p(a) if (debug & 1)	a
+#define DEBUG_s(a) if (debug & 2)	a
+#define DEBUG_l(a) if (debug & 4)	a
+#define DEBUG_t(a) if (debug & 8)	a
+#define DEBUG_o(a) if (debug & 16)	a
+#define DEBUG_c(a) if (debug & 32)	a
+#define DEBUG_P(a) if (debug & 64)	a
+#define DEBUG_m(a) if (debug & 128)	a
+#define DEBUG_f(a) if (debug & 256)	a
+#define DEBUG_r(a) if (debug & 512)	a
+#define DEBUG_x(a) if (debug & 1024)	a
+#define DEBUG_u(a) if (debug & 2048)	a
+#define DEBUG_L(a) if (debug & 4096)	a
+#define DEBUG_H(a) if (debug & 8192)	a
+#define DEBUG_X(a) if (debug & 16384)	a
+#define DEBUG_D(a) if (debug & 32768)	a
+#else
+#define DEB(a)
+#define DEBUG(a)
+#define DEBUG_p(a)
+#define DEBUG_s(a)
+#define DEBUG_l(a)
+#define DEBUG_t(a)
+#define DEBUG_o(a)
+#define DEBUG_c(a)
+#define DEBUG_P(a)
+#define DEBUG_m(a)
+#define DEBUG_f(a)
+#define DEBUG_r(a)
+#define DEBUG_x(a)
+#define DEBUG_u(a)
+#define DEBUG_L(a)
+#define DEBUG_H(a)
+#define DEBUG_X(a)
+#define DEBUG_D(a)
+#endif
+#define YYMAXDEPTH 300
+
+#define assert(what)	DEB( {						\
+	if (!(what)) {							\
+	    croak("Assertion failed: file \"%s\", line %d",		\
+		__FILE__, __LINE__);					\
+	    exit(1);							\
+	}})
+
+struct ufuncs {
+    I32 (*uf_val)_((IV, SV*));
+    I32 (*uf_set)_((IV, SV*));
+    IV uf_index;
+};
+
+/* Fix these up for __STDC__ */
+#ifndef __cplusplus
+char *mktemp _((char*));
+double atof _((const char*));
+#endif
+
+#ifndef STANDARD_C
+/* All of these are in stdlib.h or time.h for ANSI C */
+Time_t time();
+struct tm *gmtime(), *localtime();
+char *strchr(), *strrchr();
+char *strcpy(), *strcat();
+#endif /* ! STANDARD_C */
+
+
+#ifdef I_MATH
+#    include <math.h>
+#else
+#   ifdef __cplusplus
+	extern "C" {
+#   endif
+	    double exp _((double));
+	    double log _((double));
+	    double sqrt _((double));
+	    double modf _((double,double*));
+	    double sin _((double));
+	    double cos _((double));
+	    double atan2 _((double,double));
+	    double pow _((double,double));
+#   ifdef __cplusplus
+	};
+#   endif
+#endif
+
+#ifndef __cplusplus
+char *crypt _((const char*, const char*));
+char *getenv _((const char*));
+Off_t lseek _((int,Off_t,int));
+char *getlogin _((void));
+#endif
+
+#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
+#define UNLINK unlnk
+I32 unlnk _((char*));
+#else
+#define UNLINK unlink
+#endif
+
+#ifndef HAS_SETREUID
+#  ifdef HAS_SETRESUID
+#    define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
+#    define HAS_SETREUID
+#  endif
+#endif
+#ifndef HAS_SETREGID
+#  ifdef HAS_SETRESGID
+#    define setregid(r,e) setresgid(r,e,(Gid_t)-1)
+#    define HAS_SETREGID
+#  endif
+#endif
+
+#define SCAN_DEF 0
+#define SCAN_TR 1
+#define SCAN_REPL 2
+
+#ifdef DEBUGGING
+# ifndef register
+#  define register
+# endif
+# ifdef MYMALLOC
+# define DEBUGGING_MSTATS
+# endif
+# define PAD_SV(po) pad_sv(po)
+#else
+# define PAD_SV(po) curpad[po]
+#endif
+
+/****************/
+/* Truly global */
+/****************/
+
+/* global state */
+EXT PerlInterpreter *	curinterp;	/* currently running interpreter */
+#ifndef VMS  /* VMS doesn't use environ array */
+extern char **	environ;	/* environment variables supplied via exec */
+#endif
+EXT int		uid;		/* current real user id */
+EXT int		euid;		/* current effective user id */
+EXT int		gid;		/* current real group id */
+EXT int		egid;		/* current effective group id */
+EXT bool	nomemok;	/* let malloc context handle nomem */
+EXT U32		an;		/* malloc sequence number */
+EXT U32		cop_seqmax;	/* statement sequence number */
+EXT U16		op_seqmax;	/* op sequence number */
+EXT U32		evalseq;	/* eval sequence number */
+EXT U32		sub_generation;	/* inc to force methods to be looked up again */
+EXT char **	origenviron;
+EXT U32		origalen;
+EXT U32 *	profiledata;
+EXT int		maxo INIT(MAXO);/* Number of ops */
+EXT char *	osname;		/* operating system */
+
+EXT XPV*	xiv_arenaroot;	/* list of allocated xiv areas */
+EXT IV **	xiv_root;	/* free xiv list--shared by interpreters */
+EXT double *	xnv_root;	/* free xnv list--shared by interpreters */
+EXT XRV *	xrv_root;	/* free xrv list--shared by interpreters */
+EXT XPV *	xpv_root;	/* free xpv list--shared by interpreters */
+EXT HE *	he_root;	/* free he list--shared by interpreters */
+EXT char *	nice_chunk;	/* a nice chunk of memory to reuse */
+EXT U32		nice_chunk_size;/* how nice the chunk of memory is */
+
+/* Stack for currently executing thread--context switch must handle this.     */
+EXT SV **	stack_base;	/* stack->array_ary */
+EXT SV **	stack_sp;	/* stack pointer now */
+EXT SV **	stack_max;	/* stack->array_ary + stack->array_max */
+
+/* likewise for these */
+
+EXT OP *	op;		/* current op--oughta be in a global register */
+
+EXT I32 *	scopestack;	/* blocks we've entered */
+EXT I32		scopestack_ix;
+EXT I32		scopestack_max;
+
+EXT ANY*	savestack;	/* to save non-local values on */
+EXT I32		savestack_ix;
+EXT I32		savestack_max;
+
+EXT OP **	retstack;	/* returns we've pushed */
+EXT I32		retstack_ix;
+EXT I32		retstack_max;
+
+EXT I32 *	markstack;	/* stackmarks we're remembering */
+EXT I32 *	markstack_ptr;	/* stackmarks we're remembering */
+EXT I32 *	markstack_max;	/* stackmarks we're remembering */
+
+EXT SV **	curpad;
+
+/* temp space */
+EXT SV *	Sv;
+EXT XPV *	Xpv;
+EXT char	buf[2048];	/* should be longer than PATH_MAX */
+EXT char	tokenbuf[256];
+EXT struct stat	statbuf;
+#ifdef HAS_TIMES
+EXT struct tms	timesbuf;
+#endif
+EXT STRLEN na;		/* for use in SvPV when length is Not Applicable */
+
+/* for tmp use in stupid debuggers */
+EXT int *	di;
+EXT short *	ds;
+EXT char *	dc;
+
+/* handy constants */
+EXT char *	Yes INIT("1");
+EXT char *	No INIT("");
+EXT char *	hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
+EXT char *	patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
+EXT char *	vert INIT("|");
+
+EXT char	warn_uninit[]
+  INIT("Use of uninitialized value");
+EXT char	warn_nosemi[]
+  INIT("Semicolon seems to be missing");
+EXT char	warn_reserved[]
+  INIT("Unquoted string \"%s\" may clash with future reserved word");
+EXT char	warn_nl[]
+  INIT("Unsuccessful %s on filename containing newline");
+EXT char	no_wrongref[]
+  INIT("Can't use %s ref as %s ref");
+EXT char	no_symref[]
+  INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
+EXT char	no_usym[]
+  INIT("Can't use an undefined value as %s reference");
+EXT char	no_aelem[]
+  INIT("Modification of non-creatable array value attempted, subscript %d");
+EXT char	no_helem[]
+  INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
+EXT char	no_modify[]
+  INIT("Modification of a read-only value attempted");
+EXT char	no_mem[]
+  INIT("Out of memory!\n");
+EXT char	no_security[]
+  INIT("Insecure dependency in %s%s");
+EXT char	no_sock_func[]
+  INIT("Unsupported socket function \"%s\" called");
+EXT char	no_dir_func[]
+  INIT("Unsupported directory function \"%s\" called");
+EXT char	no_func[]
+  INIT("The %s function is unimplemented");
+EXT char	no_myglob[]
+  INIT("\"my\" variable %s can't be in a package");
+
+EXT SV		sv_undef;
+EXT SV		sv_no;
+EXT SV		sv_yes;
+#ifdef CSH
+    EXT char *	cshname INIT(CSH);
+    EXT I32	cshlen;
+#endif
+
+#ifdef DOINIT
+EXT char *sig_name[] = { SIG_NAME };
+EXT int   sig_num[]  = { SIG_NUM };
+#else
+EXT char *sig_name[];
+EXT int   sig_num[];
+#endif
+
+#ifdef DOINIT
+EXT unsigned char fold[] = {	/* fast case folding table */
+	0,	1,	2,	3,	4,	5,	6,	7,
+	8,	9,	10,	11,	12,	13,	14,	15,
+	16,	17,	18,	19,	20,	21,	22,	23,
+	24,	25,	26,	27,	28,	29,	30,	31,
+	32,	33,	34,	35,	36,	37,	38,	39,
+	40,	41,	42,	43,	44,	45,	46,	47,
+	48,	49,	50,	51,	52,	53,	54,	55,
+	56,	57,	58,	59,	60,	61,	62,	63,
+	64,	'a',	'b',	'c',	'd',	'e',	'f',	'g',
+	'h',	'i',	'j',	'k',	'l',	'm',	'n',	'o',
+	'p',	'q',	'r',	's',	't',	'u',	'v',	'w',
+	'x',	'y',	'z',	91,	92,	93,	94,	95,
+	96,	'A',	'B',	'C',	'D',	'E',	'F',	'G',
+	'H',	'I',	'J',	'K',	'L',	'M',	'N',	'O',
+	'P',	'Q',	'R',	'S',	'T',	'U',	'V',	'W',
+	'X',	'Y',	'Z',	123,	124,	125,	126,	127,
+	128,	129,	130,	131,	132,	133,	134,	135,
+	136,	137,	138,	139,	140,	141,	142,	143,
+	144,	145,	146,	147,	148,	149,	150,	151,
+	152,	153,	154,	155,	156,	157,	158,	159,
+	160,	161,	162,	163,	164,	165,	166,	167,
+	168,	169,	170,	171,	172,	173,	174,	175,
+	176,	177,	178,	179,	180,	181,	182,	183,
+	184,	185,	186,	187,	188,	189,	190,	191,
+	192,	193,	194,	195,	196,	197,	198,	199,
+	200,	201,	202,	203,	204,	205,	206,	207,
+	208,	209,	210,	211,	212,	213,	214,	215,
+	216,	217,	218,	219,	220,	221,	222,	223,	
+	224,	225,	226,	227,	228,	229,	230,	231,
+	232,	233,	234,	235,	236,	237,	238,	239,
+	240,	241,	242,	243,	244,	245,	246,	247,
+	248,	249,	250,	251,	252,	253,	254,	255
+};
+#else
+EXT unsigned char fold[];
+#endif
+
+#ifdef DOINIT
+EXT unsigned char freq[] = {	/* letter frequencies for mixed English/C */
+	1,	2,	84,	151,	154,	155,	156,	157,
+	165,	246,	250,	3,	158,	7,	18,	29,
+	40,	51,	62,	73,	85,	96,	107,	118,
+	129,	140,	147,	148,	149,	150,	152,	153,
+	255,	182,	224,	205,	174,	176,	180,	217,
+	233,	232,	236,	187,	235,	228,	234,	226,
+	222,	219,	211,	195,	188,	193,	185,	184,
+	191,	183,	201,	229,	181,	220,	194,	162,
+	163,	208,	186,	202,	200,	218,	198,	179,
+	178,	214,	166,	170,	207,	199,	209,	206,
+	204,	160,	212,	216,	215,	192,	175,	173,
+	243,	172,	161,	190,	203,	189,	164,	230,
+	167,	248,	227,	244,	242,	255,	241,	231,
+	240,	253,	169,	210,	245,	237,	249,	247,
+	239,	168,	252,	251,	254,	238,	223,	221,
+	213,	225,	177,	197,	171,	196,	159,	4,
+	5,	6,	8,	9,	10,	11,	12,	13,
+	14,	15,	16,	17,	19,	20,	21,	22,
+	23,	24,	25,	26,	27,	28,	30,	31,
+	32,	33,	34,	35,	36,	37,	38,	39,
+	41,	42,	43,	44,	45,	46,	47,	48,
+	49,	50,	52,	53,	54,	55,	56,	57,
+	58,	59,	60,	61,	63,	64,	65,	66,
+	67,	68,	69,	70,	71,	72,	74,	75,
+	76,	77,	78,	79,	80,	81,	82,	83,
+	86,	87,	88,	89,	90,	91,	92,	93,
+	94,	95,	97,	98,	99,	100,	101,	102,
+	103,	104,	105,	106,	108,	109,	110,	111,
+	112,	113,	114,	115,	116,	117,	119,	120,
+	121,	122,	123,	124,	125,	126,	127,	128,
+	130,	131,	132,	133,	134,	135,	136,	137,
+	138,	139,	141,	142,	143,	144,	145,	146
+};
+#else
+EXT unsigned char freq[];
+#endif
+
+#ifdef DEBUGGING
+#ifdef DOINIT
+EXT char* block_type[] = {
+	"NULL",
+	"SUB",
+	"EVAL",
+	"LOOP",
+	"SUBST",
+	"BLOCK",
+};
+#else
+EXT char* block_type[];
+#endif
+#endif
+
+/*****************************************************************************/
+/* This lexer/parser stuff is currently global since yacc is hard to reenter */
+/*****************************************************************************/
+/* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */
+
+#include "perly.h"
+
+typedef enum {
+    XOPERATOR,
+    XTERM,
+    XREF,
+    XSTATE,
+    XBLOCK,
+    XTERMBLOCK
+} expectation;
+
+EXT U32		lex_state;	/* next token is determined */
+EXT U32		lex_defer;	/* state after determined token */
+EXT expectation	lex_expect;	/* expect after determined token */
+EXT I32		lex_brackets;	/* bracket count */
+EXT I32		lex_formbrack;	/* bracket count at outer format level */
+EXT I32		lex_fakebrack;	/* outer bracket is mere delimiter */
+EXT I32		lex_casemods;	/* casemod count */
+EXT I32		lex_dojoin;	/* doing an array interpolation */
+EXT I32		lex_starts;	/* how many interps done on level */
+EXT SV *	lex_stuff;	/* runtime pattern from m// or s/// */
+EXT SV *	lex_repl;	/* runtime replacement from s/// */
+EXT OP *	lex_op;		/* extra info to pass back on op */
+EXT OP *	lex_inpat;	/* in pattern $) and $| are special */
+EXT I32		lex_inwhat;	/* what kind of quoting are we in */
+EXT char *	lex_brackstack;	/* what kind of brackets to pop */
+EXT char *	lex_casestack;	/* what kind of case mods in effect */
+
+/* What we know when we're in LEX_KNOWNEXT state. */
+EXT YYSTYPE	nextval[5];	/* value of next token, if any */
+EXT I32		nexttype[5];	/* type of next token */
+EXT I32		nexttoke;
+
+EXT FILE * VOL	rsfp INIT(Nullfp);
+EXT SV *	linestr;
+EXT char *	bufptr;
+EXT char *	oldbufptr;
+EXT char *	oldoldbufptr;
+EXT char *	bufend;
+EXT expectation expect INIT(XSTATE);	/* how to interpret ambiguous tokens */
+EXT AV * 	rsfp_filters;
+
+EXT I32		multi_start;	/* 1st line of multi-line string */
+EXT I32		multi_end;	/* last line of multi-line string */
+EXT I32		multi_open;	/* delimiter of said string */
+EXT I32		multi_close;	/* delimiter of said string */
+
+EXT GV *	scrgv;
+EXT I32		error_count;	/* how many errors so far, max 10 */
+EXT I32		subline;	/* line this subroutine began on */
+EXT SV *	subname;	/* name of current subroutine */
+
+EXT CV *	compcv;		/* currently compiling subroutine */
+EXT AV *	comppad;	/* storage for lexically scoped temporaries */
+EXT AV *	comppad_name;	/* variable names for "my" variables */
+EXT I32		comppad_name_fill;/* last "introduced" variable offset */
+EXT I32		min_intro_pending;/* start of vars to introduce */
+EXT I32		max_intro_pending;/* end of vars to introduce */
+EXT I32		padix;		/* max used index in current "register" pad */
+EXT I32		padix_floor;	/* how low may inner block reset padix */
+EXT I32		pad_reset_pending; /* reset pad on next attempted alloc */
+EXT COP		compiling;
+
+EXT I32		thisexpr;	/* name id for nothing_in_common() */
+EXT char *	last_uni;	/* position of last named-unary operator */
+EXT char *	last_lop;	/* position of last list operator */
+EXT OPCODE	last_lop_op;	/* last list operator */
+EXT bool	in_my;		/* we're compiling a "my" declaration */
+#ifdef FCRYPT
+EXT I32		cryptseen;	/* has fast crypt() been initialized? */
+#endif
+
+EXT U32		hints;		/* various compilation flags */
+
+				/* Note: the lowest 8 bits are reserved for
+				   stuffing into op->op_private */
+#define HINT_INTEGER		0x00000001
+#define HINT_STRICT_REFS	0x00000002
+
+#define HINT_BLOCK_SCOPE	0x00000100
+#define HINT_STRICT_SUBS	0x00000200
+#define HINT_STRICT_VARS	0x00000400
+
+/**************************************************************************/
+/* This regexp stuff is global since it always happens within 1 expr eval */
+/**************************************************************************/
+
+EXT char *	regprecomp;	/* uncompiled string. */
+EXT char *	regparse;	/* Input-scan pointer. */
+EXT char *	regxend;	/* End of input for compile */
+EXT I32		regnpar;	/* () count. */
+EXT char *	regcode;	/* Code-emit pointer; &regdummy = don't. */
+EXT I32		regsize;	/* Code size. */
+EXT I32		regnaughty;	/* How bad is this pattern? */
+EXT I32		regsawback;	/* Did we see \1, ...? */
+
+EXT char *	reginput;	/* String-input pointer. */
+EXT char *	regbol;		/* Beginning of input, for ^ check. */
+EXT char *	regeol;		/* End of input, for $ check. */
+EXT char **	regstartp;	/* Pointer to startp array. */
+EXT char **	regendp;	/* Ditto for endp. */
+EXT U32 *	reglastparen;	/* Similarly for lastparen. */
+EXT char *	regtill;	/* How far we are required to go. */
+EXT U16		regflags;	/* are we folding, multilining? */
+EXT char	regprev;	/* char before regbol, \n if none */
+
+/***********************************************/
+/* Global only to current interpreter instance */
+/***********************************************/
+
+#ifdef MULTIPLICITY
+#define IEXT
+#define IINIT(x)
+struct interpreter {
+#else
+#define IEXT EXT
+#define IINIT(x) INIT(x)
+#endif
+
+/* pseudo environmental stuff */
+IEXT int	Iorigargc;
+IEXT char **	Iorigargv;
+IEXT GV *	Ienvgv;
+IEXT GV *	Isiggv;
+IEXT GV *	Iincgv;
+IEXT char *	Iorigfilename;
+IEXT SV *	Idiehook;
+IEXT SV *	Iwarnhook;
+IEXT SV *	Iparsehook;
+
+/* Various states of an input record separator SV (rs, nrs) */
+#define RsSNARF(sv)   (! SvOK(sv))
+#define RsSIMPLE(sv)  (SvOK(sv) && SvCUR(sv))
+#define RsPARA(sv)    (SvOK(sv) && ! SvCUR(sv))
+
+/* switches */
+IEXT char *	Icddir;
+IEXT bool	Iminus_c;
+IEXT char	Ipatchlevel[10];
+IEXT char **	Ilocalpatches;
+IEXT SV *	Inrs;
+IEXT char *	Isplitstr IINIT(" ");
+IEXT bool	Ipreprocess;
+IEXT bool	Iminus_n;
+IEXT bool	Iminus_p;
+IEXT bool	Iminus_l;
+IEXT bool	Iminus_a;
+IEXT bool	Iminus_F;
+IEXT bool	Idoswitches;
+IEXT bool	Idowarn;
+IEXT bool	Idoextract;
+IEXT bool	Isawampersand;	/* must save all match strings */
+IEXT bool	Isawstudy;	/* do fbm_instr on all strings */
+IEXT bool	Isawi;		/* study must assume case insensitive */
+IEXT bool	Isawvec;
+IEXT bool	Iunsafe;
+IEXT bool	Ido_undump;		/* -u or dump seen? */
+IEXT char *	Iinplace;
+IEXT char *	Ie_tmpname;
+IEXT FILE *	Ie_fp;
+IEXT VOL U32	Idebug;
+IEXT U32	Iperldb;
+	/* This value may be raised by extensions for testing purposes */
+IEXT int	Iperl_destruct_level;	/* 0=none, 1=full, 2=full with checks */
+
+/* magical thingies */
+IEXT Time_t	Ibasetime;		/* $^T */
+IEXT SV *	Iformfeed;		/* $^L */
+IEXT char *	Ichopset IINIT(" \n-");	/* $: */
+IEXT SV *	Irs;			/* $/ */
+IEXT char *	Iofs;			/* $, */
+IEXT STRLEN	Iofslen;
+IEXT char *	Iors;			/* $\ */
+IEXT STRLEN	Iorslen;
+IEXT char *	Iofmt;			/* $# */
+IEXT I32	Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */
+IEXT int	Imultiline;	  /* $*--do strings hold >1 line? */
+IEXT U32	Istatusvalue;	/* $? */
+
+IEXT struct stat Istatcache;		/* _ */
+IEXT GV *	Istatgv;
+IEXT SV *	Istatname IINIT(Nullsv);
+
+/* shortcuts to various I/O objects */
+IEXT GV *	Istdingv;
+IEXT GV *	Ilast_in_gv;
+IEXT GV *	Idefgv;
+IEXT GV *	Iargvgv;
+IEXT GV *	Idefoutgv;
+IEXT GV *	Iargvoutgv;
+
+/* shortcuts to regexp stuff */
+IEXT GV *	Ileftgv;
+IEXT GV *	Iampergv;
+IEXT GV *	Irightgv;
+IEXT PMOP *	Icurpm;		/* what to do \ interps from */
+IEXT I32 *	Iscreamfirst;
+IEXT I32 *	Iscreamnext;
+IEXT I32	Imaxscream IINIT(-1);
+IEXT SV *	Ilastscream;
+
+/* shortcuts to misc objects */
+IEXT GV *	Ierrgv;
+
+/* shortcuts to debugging objects */
+IEXT GV *	IDBgv;
+IEXT GV *	IDBline;
+IEXT GV *	IDBsub;
+IEXT SV *	IDBsingle;
+IEXT SV *	IDBtrace;
+IEXT SV *	IDBsignal;
+IEXT AV *	Ilineary;	/* lines of script for debugger */
+IEXT AV *	Idbargs;	/* args to call listed by caller function */
+
+/* symbol tables */
+IEXT HV *	Idefstash;	/* main symbol table */
+IEXT HV *	Icurstash;	/* symbol table for current package */
+IEXT HV *	Idebstash;	/* symbol table for perldb package */
+IEXT SV *	Icurstname;	/* name of current package */
+IEXT AV *	Ibeginav;	/* names of BEGIN subroutines */
+IEXT AV *	Iendav;		/* names of END subroutines */
+IEXT AV *	Ipad;		/* storage for lexically scoped temporaries */
+IEXT AV *	Ipadname;	/* variable names for "my" variables */
+
+/* memory management */
+IEXT SV **	Itmps_stack;
+IEXT I32	Itmps_ix IINIT(-1);
+IEXT I32	Itmps_floor IINIT(-1);
+IEXT I32	Itmps_max;
+IEXT I32	Isv_count;	/* how many SV* are currently allocated */
+IEXT I32	Isv_objcount;	/* how many objects are currently allocated */
+IEXT SV*	Isv_root;	/* storage for SVs belonging to interp */
+IEXT SV*	Isv_arenaroot;	/* list of areas for garbage collection */
+
+/* funky return mechanisms */
+IEXT I32	Ilastspbase;
+IEXT I32	Ilastsize;
+IEXT int	Iforkprocess;	/* so do_open |- can return proc# */
+
+/* subprocess state */
+IEXT AV *	Ifdpid;		/* keep fd-to-pid mappings for my_popen */
+IEXT HV *	Ipidstatus;	/* keep pid-to-status mappings for waitpid */
+
+/* internal state */
+IEXT VOL int	Iin_eval;	/* trap "fatal" errors? */
+IEXT OP *	Irestartop;	/* Are we propagating an error from croak? */
+IEXT int	Idelaymagic;	/* ($<,$>) = ... */
+IEXT bool	Idirty;		/* In the middle of tearing things down? */
+IEXT U8		Ilocalizing;	/* are we processing a local() list? */
+IEXT bool	Itainted;	/* using variables controlled by $< */
+IEXT bool	Itainting;	/* doing taint checks */
+IEXT char *	Iop_mask IINIT(NULL);	/* masked operations for safe evals */
+
+/* trace state */
+IEXT I32	Idlevel;
+IEXT I32	Idlmax IINIT(128);
+IEXT char *	Idebname;
+IEXT char *	Idebdelim;
+
+/* current interpreter roots */
+IEXT CV *	Imain_cv;
+IEXT OP *	Imain_root;
+IEXT OP *	Imain_start;
+IEXT OP *	Ieval_root;
+IEXT OP *	Ieval_start;
+
+/* runtime control stuff */
+IEXT COP * VOL	Icurcop IINIT(&compiling);
+IEXT line_t	Icopline IINIT(NOLINE);
+IEXT CONTEXT *	Icxstack;
+IEXT I32	Icxstack_ix IINIT(-1);
+IEXT I32	Icxstack_max IINIT(128);
+IEXT Sigjmp_buf	Itop_env;
+IEXT I32	Irunlevel;
+
+/* stack stuff */
+IEXT AV *	Istack;		/* THE STACK */
+IEXT AV *	Imainstack;	/* the stack when nothing funny is happening */
+IEXT SV **	Imystack_base;	/* stack->array_ary */
+IEXT SV **	Imystack_sp;	/* stack pointer now */
+IEXT SV **	Imystack_max;	/* stack->array_ary + stack->array_max */
+
+/* format accumulators */
+IEXT SV *	Iformtarget;
+IEXT SV *	Ibodytarget;
+IEXT SV *	Itoptarget;
+
+/* statics moved here for shared library purposes */
+IEXT SV		Istrchop;	/* return value from chop */
+IEXT int	Ifilemode;	/* so nextargv() can preserve mode */
+IEXT int	Ilastfd;	/* what to preserve mode on */
+IEXT char *	Ioldname;	/* what to preserve mode on */
+IEXT char **	IArgv;		/* stuff to free from do_aexec, vfork safe */
+IEXT char *	ICmd;		/* stuff to free from do_aexec, vfork safe */
+IEXT OP *	Isortcop;	/* user defined sort routine */
+IEXT HV *	Isortstash;	/* which is in some package or other */
+IEXT GV *	Ifirstgv;	/* $a */
+IEXT GV *	Isecondgv;	/* $b */
+IEXT AV *	Isortstack;	/* temp stack during pp_sort() */
+IEXT AV *	Isignalstack;	/* temp stack during sighandler() */
+IEXT SV *	Imystrk;	/* temp key string for do_each() */
+IEXT I32	Idumplvl;	/* indentation level on syntax tree dump */
+IEXT PMOP *	Ioldlastpm;	/* for saving regexp context during debugger */
+IEXT I32	Igensym;	/* next symbol for getsym() to define */
+IEXT bool	Ipreambled;
+IEXT AV *	Ipreambleav;
+IEXT int	Ilaststatval IINIT(-1);
+IEXT I32	Ilaststype IINIT(OP_STAT);
+
+#undef IEXT
+#undef IINIT
+
+#ifdef MULTIPLICITY
+};
+#else
+struct interpreter {
+    char broiled;
+};
+#endif
+
+#include "pp.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef __cplusplus
+#  ifndef I_STDARG
+#    define I_STDARG 1
+#  endif
+#endif
+
+#ifdef I_STDARG
+#  include <stdarg.h>
+#else
+#  ifdef I_VARARGS
+#    include <varargs.h>
+#  endif
+#endif
+
+#include "proto.h"
+
+#ifdef EMBED
+#define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
+#define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
+#else
+#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
+#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
+#endif
+
+#ifdef __cplusplus
+};
+#endif
+
+/* The following must follow proto.h */
+
+#ifdef DOINIT
+EXT MGVTBL vtbl_sv =	{magic_get,
+				magic_set,
+					magic_len,
+						0,	0};
+EXT MGVTBL vtbl_env =	{0,	0,	0,	0,	0};
+EXT MGVTBL vtbl_envelem =	{0,	magic_setenv,
+					0,	magic_clearenv,
+							0};
+EXT MGVTBL vtbl_sig =	{0,	0,		 0, 0, 0};
+EXT MGVTBL vtbl_sigelem =	{0,	magic_setsig,
+					0,	0,	0};
+EXT MGVTBL vtbl_pack =	{0,	0,	0,	magic_wipepack,
+							0};
+EXT MGVTBL vtbl_packelem =	{magic_getpack,
+				magic_setpack,
+					0,	magic_clearpack,
+							0};
+EXT MGVTBL vtbl_dbline =	{0,	magic_setdbline,
+					0,	0,	0};
+EXT MGVTBL vtbl_isa =	{0,	magic_setisa,
+					0,	0,	0};
+EXT MGVTBL vtbl_isaelem =	{0,	magic_setisa,
+					0,	0,	0};
+EXT MGVTBL vtbl_arylen =	{magic_getarylen,
+				magic_setarylen,
+					0,	0,	0};
+EXT MGVTBL vtbl_glob =	{magic_getglob,
+				magic_setglob,
+					0,	0,	0};
+EXT MGVTBL vtbl_mglob =	{0,	magic_setmglob,
+					0,	0,	0};
+EXT MGVTBL vtbl_taint =	{magic_gettaint,magic_settaint,
+					0,	0,	0};
+EXT MGVTBL vtbl_substr =	{0,	magic_setsubstr,
+					0,	0,	0};
+EXT MGVTBL vtbl_vec =	{0,	magic_setvec,
+					0,	0,	0};
+EXT MGVTBL vtbl_pos =	{magic_getpos,
+				magic_setpos,
+					0,	0,	0};
+EXT MGVTBL vtbl_bm =	{0,	magic_setbm,
+					0,	0,	0};
+EXT MGVTBL vtbl_uvar =	{magic_getuvar,
+				magic_setuvar,
+					0,	0,	0};
+
+#ifdef OVERLOAD
+EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
+                                        0,      0,      magic_setamagic};
+EXT MGVTBL vtbl_amagicelem =   {0,     magic_setamagic,
+                                        0,      0,      magic_setamagic};
+#endif /* OVERLOAD */
+
+#else
+EXT MGVTBL vtbl_sv;
+EXT MGVTBL vtbl_env;
+EXT MGVTBL vtbl_envelem;
+EXT MGVTBL vtbl_sig;
+EXT MGVTBL vtbl_sigelem;
+EXT MGVTBL vtbl_pack;
+EXT MGVTBL vtbl_packelem;
+EXT MGVTBL vtbl_dbline;
+EXT MGVTBL vtbl_isa;
+EXT MGVTBL vtbl_isaelem;
+EXT MGVTBL vtbl_arylen;
+EXT MGVTBL vtbl_glob;
+EXT MGVTBL vtbl_mglob;
+EXT MGVTBL vtbl_taint;
+EXT MGVTBL vtbl_substr;
+EXT MGVTBL vtbl_vec;
+EXT MGVTBL vtbl_pos;
+EXT MGVTBL vtbl_bm;
+EXT MGVTBL vtbl_uvar;
+
+#ifdef OVERLOAD
+EXT MGVTBL vtbl_amagic;
+EXT MGVTBL vtbl_amagicelem;
+#endif /* OVERLOAD */
+
+#endif
+
+#ifdef OVERLOAD
+EXT long amagic_generation;
+
+#define NofAMmeth 29
+#ifdef DOINIT
+EXT char * AMG_names[NofAMmeth][2] = {
+  {"fallback","abs"},
+  {"bool", "nomethod"},
+  {"\"\"", "0+"},
+  {"+","+="},
+  {"-","-="},
+  {"*", "*="},
+  {"/", "/="},
+  {"%", "%="},
+  {"**", "**="},
+  {"<<", "<<="},
+  {">>", ">>="},
+  {"&", "&="},
+  {"|", "|="},
+  {"^", "^="},
+  {"<", "<="},
+  {">", ">="},
+  {"==", "!="},
+  {"<=>", "cmp"},
+  {"lt", "le"},
+  {"gt", "ge"},
+  {"eq", "ne"},
+  {"!", "~"},
+  {"++", "--"},
+  {"atan2", "cos"},
+  {"sin", "exp"},
+  {"log", "sqrt"},
+  {"x","x="},
+  {".",".="},
+  {"=","neg"}
+};
+#else
+EXT char * AMG_names[NofAMmeth][2];
+#endif /* def INITAMAGIC */
+
+struct  am_table        {
+  long was_ok_sub;
+  long was_ok_am;
+  CV* table[NofAMmeth*2];
+  long fallback;
+};
+typedef struct am_table AMT;
+
+#define AMGfallNEVER	1
+#define AMGfallNO	2
+#define AMGfallYES	3
+
+enum {
+  fallback_amg,	abs_amg,
+  bool__amg,	nomethod_amg,
+  string_amg,	numer_amg,
+  add_amg,	add_ass_amg,
+  subtr_amg,	subtr_ass_amg,
+  mult_amg,	mult_ass_amg,
+  div_amg,	div_ass_amg,
+  mod_amg,	mod_ass_amg,
+  pow_amg,	pow_ass_amg,
+  lshift_amg,	lshift_ass_amg,
+  rshift_amg,	rshift_ass_amg,
+  band_amg,	band_ass_amg,
+  bor_amg,	bor_ass_amg,
+  bxor_amg,	bxor_ass_amg,
+  lt_amg,	le_amg,
+  gt_amg,	ge_amg,
+  eq_amg,	ne_amg,
+  ncmp_amg,	scmp_amg,
+  slt_amg,	sle_amg,
+  sgt_amg,	sge_amg,
+  seq_amg,	sne_amg,
+  not_amg,	compl_amg,
+  inc_amg,	dec_amg,
+  atan2_amg,	cos_amg,
+  sin_amg,	exp_amg,
+  log_amg,	sqrt_amg,
+  repeat_amg,   repeat_ass_amg,
+  concat_amg,	concat_ass_amg,
+  copy_amg,	neg_amg
+};
+#endif /* OVERLOAD */
+
+#endif /* Include guard */
diff --git a/gnu/usr.bin/perl/perl_exp.SH b/gnu/usr.bin/perl/perl_exp.SH
new file mode 100644
index 00000000000..2e7bb20e082
--- /dev/null
+++ b/gnu/usr.bin/perl/perl_exp.SH
@@ -0,0 +1,48 @@
+#!/bin/sh
+
+# Written: Nov 1994 Wayne Scott (wscott@ichips.intel.com)
+
+# Create the export list for perl.
+# Needed by AIX to do dynamic linking.
+
+# This simple program relys on 'global.sym' being up to date
+# with all of the global symbols that a dynamicly link library
+# might want to access.
+
+# All symbols have a Perl_ prefix because that's what embed.h
+# sticks in front of them.
+
+echo "Extracting perl.exp"
+
+echo "#!" > perl.exp
+
+sed -n '/^[A-Za-z]/ s/^/Perl_/p' global.sym >> perl.exp
+
+# also add symbols from interp.sym
+# They are only needed if -DMULTIPLICITY is not set but it
+# doesn't hurt to include them anyway.
+sed -n '/^[A-Za-z]/ p' interp.sym >> perl.exp
+
+# extra globals not included above.
+cat <<END >> perl.exp
+perl_init_i18nl14n
+perl_init_ext
+perl_alloc
+perl_construct
+perl_destruct
+perl_free
+perl_parse
+perl_run
+perl_get_sv
+perl_get_av
+perl_get_hv
+perl_get_cv
+perl_call_argv
+perl_call_pv
+perl_call_method
+perl_call_sv
+perl_requirepv
+safemalloc
+saferealloc
+safefree
+END
diff --git a/gnu/usr.bin/perl/perlsh b/gnu/usr.bin/perl/perlsh
new file mode 100644
index 00000000000..2b2cccd0641
--- /dev/null
+++ b/gnu/usr.bin/perl/perlsh
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+# Poor man's perl shell.
+
+# Simply type two carriage returns every time you want to evaluate.
+# Note that it must be a complete perl statement--don't type double
+#  carriage return in the middle of a loop.
+
+$/ = "\n\n";	# set paragraph mode
+$SHlinesep = "\n";
+while ($SHcmd = <>) {
+    $/ = $SHlinesep;
+    eval $SHcmd; print $@ || "\n";
+    $SHlinesep = $/; $/ = '';
+}
diff --git a/gnu/usr.bin/perl/perly.c b/gnu/usr.bin/perl/perly.c
new file mode 100644
index 00000000000..9ecf6d2063e
--- /dev/null
+++ b/gnu/usr.bin/perl/perly.c
@@ -0,0 +1,2321 @@
+#ifndef lint
+static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
+#endif
+#define YYBYACC 1
+#line 16 "perly.y"
+#include "EXTERN.h"
+#include "perl.h"
+
+static void
+dep()
+{
+    deprecate("\"do\" to call subroutines");
+}
+
+#define YYERRCODE 256
+short yylhs[] = {                                        -1,
+   31,    0,    5,    3,    6,    6,    6,    7,    7,    7,
+    7,   21,   21,   21,   21,   21,   21,   11,   11,   11,
+    9,    9,    9,    9,   30,   30,    8,    8,    8,    8,
+    8,    8,    8,    8,   10,   10,   25,   25,   29,   29,
+    1,    1,    1,    1,    2,    2,   32,   32,   28,   28,
+    4,   33,   33,   34,   13,   13,   13,   12,   12,   12,
+   26,   26,   26,   26,   26,   26,   26,   26,   27,   27,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   22,   22,   23,   23,   23,   20,
+   15,   16,   17,   18,   19,   24,   24,   24,   24,
+};
+short yylen[] = {                                         2,
+    0,    2,    4,    0,    0,    2,    2,    2,    1,    2,
+    3,    1,    1,    3,    3,    3,    3,    0,    2,    6,
+    6,    6,    4,    4,    0,    2,    7,    7,    5,    5,
+    8,    7,   10,    3,    0,    1,    0,    1,    0,    1,
+    1,    1,    1,    1,    4,    3,    5,    5,    0,    1,
+    0,    3,    2,    5,    3,    3,    1,    2,    3,    1,
+    3,    5,    6,    3,    5,    2,    4,    4,    1,    1,
+    3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+    3,    3,    5,    3,    2,    2,    2,    2,    2,    2,
+    2,    2,    2,    2,    3,    2,    3,    2,    4,    3,
+    4,    1,    5,    1,    4,    5,    4,    1,    1,    1,
+    5,    6,    5,    6,    5,    4,    5,    1,    1,    3,
+    4,    3,    2,    2,    4,    5,    4,    5,    1,    2,
+    2,    1,    2,    2,    2,    1,    3,    1,    3,    4,
+    4,    6,    1,    1,    0,    1,    0,    1,    2,    2,
+    2,    2,    2,    2,    2,    1,    1,    1,    1,
+};
+short yydefred[] = {                                      1,
+    0,    5,    0,   40,   51,   51,    0,   51,    6,   41,
+    7,    9,    0,   42,   43,   44,    0,    0,    0,   53,
+    0,   12,    4,  143,    0,    0,  118,    0,  138,    0,
+   51,   51,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   10,    0,    0,    0,
+    0,    0,    0,    0,    0,    8,    0,    0,    0,    0,
+    0,  108,  110,    0,    0,    0,  144,    0,   46,    0,
+   52,    0,    5,  156,  159,  158,  157,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  154,    0,  124,
+    0,    0,    0,    0,    0,    0,  150,    0,    0,    0,
+    0,   66,    0,  133,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   98,    0,  151,  152,  153,  155,
+    0,   34,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   90,   91,    0,    0,    0,    0,
+    0,    0,    0,    0,   11,   45,   50,    0,    0,    0,
+   64,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   36,    0,  137,  139,
+    0,    0,    0,    0,    0,    0,  100,    0,  122,    0,
+    0,    0,   97,   26,    0,    0,    0,    0,    0,    0,
+   55,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   69,    0,   70,
+    0,    0,    0,    0,    0,    0,    0,  120,    0,   48,
+   47,   54,    3,    0,  141,    0,   68,  101,    0,   29,
+    0,   30,    0,    0,    0,   23,    0,   24,    0,    0,
+    0,  140,  149,   67,    0,  125,    0,  127,    0,   99,
+    0,    0,    0,    0,    0,    0,    0,  107,    0,  105,
+    0,  116,    0,  121,   65,    0,    0,    0,    0,   19,
+    0,    0,    0,    0,    0,   62,  126,  128,  115,    0,
+  113,    0,    0,  106,    0,  111,  117,  103,  142,   27,
+   28,   21,    0,   22,    0,   32,    0,  114,  112,   63,
+    0,    0,   31,    0,    0,   20,   33,
+};
+short yydgoto[] = {                                       1,
+    9,   10,   83,   17,   86,    3,   11,   12,   66,  195,
+  266,   67,  202,   69,   70,   71,   72,   73,   74,   75,
+  197,  122,  203,   88,  187,   77,  241,  178,   13,  142,
+    2,   14,   15,   16,
+};
+short yysindex[] = {                                      0,
+    0,    0,  -82,    0,    0,    0,  -52,    0,    0,    0,
+    0,    0,  853,    0,    0,    0,  -80, -256,  -19,    0,
+ -245,    0,    0,    0,   19,   19,    0,   20,    0, 2177,
+    0,    0,   -2,    1,   28,   41,  133, 2177,   27,   33,
+   52,   19, 1028, 2177, 1303, -210,   19, 2177,  965, 1359,
+ 2177, 2177, 2177, 2177, 2177, 1415,    0, 2177, 2177, 1478,
+   19,   19,   19,   19, -225,    0,   71,  209, 1535,  -49,
+  -30,    0,    0,    8,  101,   42,    0,   30,    0, -112,
+    0, 2177,    0,    0,    0,    0,    0, 2177,  127, 2177,
+ 1535,   30, -112, 2177,   30, 2177,   30, 2177,   30, 2177,
+   30, 1712,  128, 1535,  139, 1768,  965,    0,  141,    0,
+ 1485,  -14, 1485,   65,  -42, 2177,    0,   71,    0,   71,
+  -49,    0, 2177,    0, 1485,  334,  334,  334,  -47,  -47,
+   92,  -26,  334,  334,    0,   63,    0,    0,    0,    0,
+   30,    0, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177,
+ 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177,
+ 2177, 2177, 2177, 2177,    0,    0,  -27, 2177, 2177, 2177,
+ 2177, 2177, 2177, 1824,    0,    0,    0,  -48,  137,  -92,
+    0, 2177,  221, 2177,   30, -191,  151, -225,  -22, -225,
+  -12, -147,    7, -147,  138,    5,    0, 2177,    0,    0,
+    9,  -39,  160, 2177, 1887, 2121,    0,   77,    0,   71,
+ 2177,  113,    0,    0, 1535, -191, -191, -191, -191,  -86,
+    0,  -20,  395, 1485, 1566,  461,  -88, 1535, 4122, 1064,
+  679,  364, 1120,  728,  334,  334, 2177,    0, 2177,    0,
+  174,   89,   51,   98,   55,  118,   57,    0,   11,    0,
+    0,    0,    0,  175,    0, 2177,    0,    0,   30,    0,
+   30,    0,   30,   30,  178,    0,   30,    0, 2177,   30,
+   15,    0,    0,    0,   22,    0,   25,    0,   29,    0,
+  152, 2177,   94, 2177,   59,  177, 2177,    0,   96,    0,
+   97,    0,  102,    0,    0, 1190, -225, -225, -147,    0,
+ 2177, -147,  176, -225,   30,    0,    0,    0,    0,  205,
+    0, 3039,  111,    0,  206,    0,    0,    0,    0,    0,
+    0,    0,   37,    0, 1712,    0, -225,    0,    0,    0,
+   30,  208,    0, -147,   30,    0,    0,
+};
+short yyrindex[] = {                                      0,
+    0,    0,  297,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0, 2253,  505,    0,
+    0,    0,    0,    0,    0,    0,    0,    0, 2847, 2935,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  107,    0,  -35,   10,   53, 3109,
+ 3156,    0,    0, 2298, 1976,    0,    0,    0,    0,  -23,
+    0,  230,    0,    0,    0,    0,    0, 2385,    0,    0,
+ 1004,    0,  168,  253,    0,    0,    0,    0,    0,    0,
+    0,  254,    0, 2242,    0,    0,  274,    0, 2032,    0,
+ 3844, 3109, 3902,    0,    0, 2385,    0, 2440,  452, 2554,
+  572,    0,    0,    0, 3981, 3274, 3312, 3421, 3200, 3237,
+ 2661,    0, 3560, 3596,    0,    0,    0,    0,    0,    0,
+    0,    0, 2714,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  909,
+    0,  274,    0, 2385,    0,   39,    0,  107,    0,  107,
+    0,  170,    0,  170,    0,  262,    0,    0,    0,    0,
+    0,  288,    0,    0,    0,    0,    0,    0,    0, 2805,
+    0, 2757,    0,    0, 2650,   49,   58,   61,   64,  365,
+    0,    0,  -31, 4018, 4028, 3719,  630, 2995,    0, 1623,
+ 4106, 4096, 4064, 3756, 3640, 3683,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  277,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  274,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  107,  107,  170,    0,
+    0,  170,    0,  107,    0,    0,    0,    0,    0,    0,
+    0,   13,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  300,    0,  107,    0,    0,    0,
+    0,    0,    0,  170,    0,    0,    0,
+};
+short yygindex[] = {                                      0,
+    0,    0,    0,  506,  -13,  255,    0,    0,    0,   18,
+ -180,  839,  -11, 4398, 2162,    0,    0,    0,    0,    0,
+  342,  -57, -174, 1032,   90,    0,    0,  267,    0, -172,
+    0,    0,    0,    0,
+};
+#define YYTABLESIZE 4682
+short yytable[] = {                                      65,
+   80,   68,  168,   79,  273,   57,   20,  254,   61,   80,
+  250,   82,   80,  268,  212,  260,  208,  262,  261,   95,
+   97,   99,  101,   57,  179,  206,   80,   80,  263,  110,
+  181,   80,  253,  115,  150,   49,  124,   94,  283,   81,
+   96,  170,   23,  168,  132,  270,  116,  267,  136,  272,
+   13,  294,  141,   83,   61,  305,   83,   57,  209,   90,
+  172,   80,  306,  239,  176,  307,  105,   98,   13,  308,
+   83,   83,  106,  169,   23,  150,  170,  331,  184,   38,
+  100,  188,  186,  190,  189,  192,  191,  194,  193,   16,
+  196,  107,  171,   60,  201,  237,   60,   38,   17,   49,
+  175,   14,  148,  149,   15,   83,   25,   16,  169,  289,
+   60,   60,  315,  291,  143,  293,   17,  313,  322,   14,
+   23,  324,   15,   23,  320,  321,  257,  214,  264,  265,
+  173,  326,  216,  217,  218,  219,  220,  221,  222,   25,
+  174,   23,   25,   25,   25,   60,   25,  177,   25,   25,
+   23,   25,   23,  336,  333,  213,  242,  243,  244,  245,
+  246,  247,  249,   23,  251,   25,  182,  198,   61,   18,
+   25,  258,  102,    4,    5,    6,   78,    7,    8,  199,
+  205,  288,  211,    4,    5,    6,  271,    7,    8,  207,
+  290,  259,  275,  277,  279,  252,  269,   25,  154,  281,
+  274,  280,   18,  282,   19,   18,   18,   18,  149,   18,
+  292,   18,   18,  287,   18,  295,  163,  301,  311,  164,
+  316,  317,  165,  166,  167,  285,  318,  286,   18,   25,
+  238,   25,   25,   18,  325,  329,   57,   57,   57,   57,
+   80,   80,   80,   80,  309,  297,  330,  298,  335,  299,
+  300,  148,  149,  302,  148,  149,  304,  186,   57,   57,
+   18,  255,   80,   80,  256,  167,   80,  148,  149,  314,
+  310,  148,  149,  148,  149,   84,  144,  145,  146,  147,
+   85,  148,  149,  157,   83,   83,   83,   83,  145,  323,
+   49,  327,   18,   37,   18,   18,    2,  328,  148,  149,
+  148,  149,  148,  149,  148,  149,   83,   83,  148,  149,
+   83,  168,   35,   68,  147,  148,  149,  334,  148,  149,
+   13,  337,  148,  149,   60,   60,   60,   60,  148,   39,
+  148,  149,   39,   39,   39,   37,   39,  180,   39,   39,
+   35,   39,  332,  150,  148,  149,   60,   60,  148,  149,
+  148,  149,  148,  149,   76,   39,  148,  149,  303,  185,
+   39,    0,   25,   25,   25,   25,   25,   25,    0,   25,
+   25,   25,   25,   25,   25,   25,   25,   25,   25,   25,
+   25,   25,  148,  149,    0,   25,   25,   39,   25,   25,
+   25,  148,  149,    0,    0,   25,   25,   25,   25,   25,
+    0,    0,   25,   25,    0,   56,    0,    0,   56,   25,
+    0,  148,  149,   25,    0,   25,   25,    0,    0,   39,
+    0,    0,   39,   56,  168,   18,   18,   18,   18,   18,
+   18,    0,   18,   18,   18,   18,   18,   18,   18,   18,
+   18,   18,   18,   18,   18,  148,  149,    0,   18,   18,
+    0,   18,   18,   18,  168,    0,  150,   56,   18,   18,
+   18,   18,   18,    0,    0,   18,   18,    0,    0,    0,
+  148,  149,   18,    0,    0,    0,   18,    0,   18,   18,
+  144,  145,  146,  147,  156,  168,  150,  156,  156,  156,
+    0,  156,  143,  156,  156,  143,  156,    0,  148,  149,
+    0,  151,  148,  149,    0,  152,  153,  154,  155,  143,
+  143,   18,    0,   21,  143,  156,    0,  150,  156,  158,
+  159,  160,  161,    0,  162,  163,    0,    0,  164,    0,
+    0,  165,  166,  167,    0,    0,   92,   93,    0,    0,
+    0,    0,  143,    0,  143,  136,    0,    0,  136,    0,
+    0,  168,   39,   39,   39,   39,   39,   39,    0,   39,
+   39,   39,  136,  136,    0,   39,    0,  136,   39,   39,
+   39,   39,    0,    0,  143,   39,   39,  156,   39,   39,
+   39,    0,    0,  150,    0,   39,   39,   39,   39,   39,
+    0,    0,   39,   39,    0,  136,    0,  136,    0,   39,
+    0,    0,    0,   39,  157,   39,   39,  157,  157,  157,
+    0,  157,  102,  157,  157,  102,  157,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  136,    0,  102,
+  102,    0,    0,    0,  102,  157,   56,   56,   56,   56,
+    0,  164,    0,    0,  165,  166,  167,    0,  152,  153,
+  154,  155,    0,    0,    0,    0,    0,    0,   56,    0,
+    0,    0,    0,    0,  102,  161,    0,  162,  163,    0,
+   74,  164,    0,   74,  165,  166,  167,    0,    0,  152,
+  153,  154,  155,    0,    0,    0,    0,   74,   74,    0,
+    0,    0,   74,  158,  159,  160,  161,  157,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,  156,  156,
+  156,  156,  156,    0,  156,  156,  156,    0,    0,    0,
+  156,    0,   74,  143,  143,  143,  143,    0,    0,    0,
+    0,  156,  143,  156,  156,  156,  143,  143,  143,  143,
+  156,  156,  156,  156,  156,  143,  143,  156,  156,  143,
+  143,  143,  143,  143,  156,  143,  143,    0,  156,  143,
+  156,  156,  143,  143,  143,  163,    0,    0,  164,  168,
+    0,  165,  166,  167,    0,    0,  136,  136,  136,  136,
+    0,    0,    0,    0,    0,  136,    0,    0,    0,  136,
+  136,  136,  136,    0,    0,    0,    0,    0,  136,  136,
+    0,  150,  136,  136,  136,  136,  136,    0,  136,  136,
+    0,    0,  136,    0,    0,  136,  136,  136,  168,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  157,  157,
+  157,  157,  157,    0,  157,  157,  157,    0,    0,    0,
+  157,    0,    0,  102,  102,  102,  102,    0,    0,    0,
+  150,  157,  102,  157,  157,  157,  102,  102,  102,  102,
+  157,  157,  157,  157,  157,  102,  102,  157,  157,  102,
+  102,  102,  102,  102,  157,  102,  102,    0,  157,  102,
+  157,  157,  102,  102,  102,   51,  118,  120,   61,   63,
+   47,    0,   56,    0,   64,   59,    0,   58,    0,    0,
+    0,   74,   74,   74,   74,    0,    0,    0,    0,    0,
+   74,   57,    0,    0,   74,   74,   62,   74,    0,    0,
+  120,    0,    0,   74,   74,    0,  120,   74,   74,   74,
+   74,   74,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,   39,    0,   60,   39,   39,   39,    0,   39,    0,
+   39,   39,    0,   39,  120,    0,    0,    0,    0,    0,
+    0,  210,    0,  152,  153,  154,  155,   39,    0,    0,
+    0,    0,   39,    0,    0,   23,    0,    0,   52,  160,
+  161,    0,  162,  163,    0,    0,  164,    0,    0,  165,
+  166,  167,    0,    0,    0,    0,    0,   51,    0,   39,
+   61,   63,   47,    0,   56,    0,   64,   59,    0,   58,
+    0,    0,    0,    0,  154,  155,    0,    0,    0,    0,
+    0,    0,  120,    0,    0,    0,    0,    0,   62,    0,
+    0,   39,  163,    0,   39,  164,    0,    0,  165,  166,
+  167,    0,    0,    0,  135,    0,    0,  135,    0,    0,
+    0,    0,    0,    0,    0,   60,    0,   89,    0,    0,
+   51,  135,  135,   61,   63,   47,    0,   56,    0,   64,
+   59,    0,   58,  108,    0,    0,    0,    0,  117,    0,
+  123,    0,    0,    0,    0,    0,    0,   23,    0,    0,
+   52,   62,  137,  138,  139,  140,  135,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   22,   24,
+   25,   26,   27,   28,    0,   29,   30,   31,   60,    0,
+    0,   32,    0,    0,   33,   34,   35,   36,    0,    0,
+    0,   37,   38,    0,   39,   40,   41,    0,  204,    0,
+    0,   42,   43,   44,   45,   46,    0,    0,   48,   49,
+   23,    0,    0,   52,  168,   50,    0,    0,    0,   53,
+    0,   54,   55,    0,   39,   39,   39,   39,   39,   39,
+    0,   39,   39,   39,    0,    0,    0,   39,    0,    0,
+   39,   39,   39,   39,    0,    0,  150,   39,   39,    0,
+   39,   39,   39,    0,    0,    0,    0,   39,   39,   39,
+   39,   39,    0,    0,   39,   39,    0,    0,    0,    0,
+  168,   39,    0,    0,    0,   39,    0,   39,   39,    0,
+    0,  119,   25,   26,   27,   28,   85,   29,   30,   31,
+  319,    0,    0,   32,    0,    0,    0,    0,    0,    0,
+    0,    0,  150,    0,   38,    0,   39,   40,   41,    0,
+    0,    0,  157,   42,   43,   44,   45,   46,    0,    0,
+   48,   49,    0,    0,    0,    0,    0,   50,    0,    0,
+    0,   53,    0,   54,   55,  135,  135,  135,  135,    0,
+  168,    0,    0,    0,  109,   25,   26,   27,   28,    0,
+   29,   30,   31,    0,    0,    0,   32,  135,  135,    0,
+    0,    0,    0,    0,    0,    0,    0,   38,    0,   39,
+   40,   41,  150,    0,    0,    0,   42,   43,   44,   45,
+   46,    0,    0,   48,   49,    0,    0,    0,    0,    0,
+   50,    0,    0,    0,   53,   51,   54,   55,   61,   63,
+   47,    0,   56,    0,   64,   59,    0,   58,  152,  153,
+  154,  155,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  114,    0,  159,  160,  161,   62,  162,  163,    0,
+    0,  164,    0,    0,  165,  166,  167,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   51,    0,   60,   61,   63,   47,    0,   56,    0,
+   64,   59,    0,   58,  152,  153,  154,  155,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   62,  162,  163,    0,    0,  164,   52,    0,
+  165,  166,  167,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   51,    0,   60,
+   61,   63,   47,    0,   56,  131,   64,   59,    0,   58,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  151,    0,    0,    0,  152,  153,  154,  155,   62,    0,
+    0,   23,    0,    0,   52,    0,    0,  156,  158,  159,
+  160,  161,    0,  162,  163,    0,    0,  164,    0,    0,
+  165,  166,  167,    0,    0,   60,    0,    0,    0,    0,
+   51,    0,    0,   61,   63,   47,    0,   56,    0,   64,
+   59,    0,   58,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   52,   62,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   24,
+   25,   26,   27,   28,    0,   29,   30,   31,   60,    0,
+  135,   32,    0,    0,    0,  168,    0,    0,    0,    0,
+    0,    0,   38,    0,   39,   40,   41,    0,    0,    0,
+    0,   42,   43,   44,   45,   46,    0,  157,   48,   49,
+    0,    0,    0,   52,    0,   50,    0,  150,    0,   53,
+    0,   54,   55,    0,    0,   24,   25,   26,   27,   28,
+    0,   29,   30,   31,    0,  168,    0,   32,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   38,    0,
+   39,   40,   41,    0,    0,    0,    0,   42,   43,   44,
+   45,   46,    0,    0,   48,   49,  168,  150,    0,    0,
+    0,   50,    0,   82,    0,   53,   82,   54,   55,    0,
+    0,   24,   25,   26,   27,   28,    0,   29,   30,   31,
+   82,   82,    0,   32,    0,   82,    0,    0,  150,    0,
+    0,    0,    0,    0,   38,    0,   39,   40,   41,    0,
+    0,    0,    0,   42,   43,   44,   45,   46,    0,    0,
+   48,   49,    0,    0,    0,   82,    0,   50,    0,    0,
+    0,   53,    0,   54,   55,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   24,   25,   26,   27,   28,    0,
+   29,   30,   31,    0,   51,    0,   32,   61,   63,   47,
+    0,   56,    0,   64,   59,    0,   58,   38,    0,   39,
+   40,   41,    0,    0,    0,    0,   42,   43,   44,   45,
+   46,  154,  155,   48,   49,   62,    0,    0,    0,    0,
+   50,    0,    0,    0,   53,    0,   54,   55,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,    0,    0,
+   51,    0,   60,   61,   63,   47,    0,   56,  200,   64,
+   59,    0,   58,    0,    0,  151,    0,    0,    0,  152,
+  153,  154,  155,    0,    0,    0,    0,    0,    0,    0,
+    0,   62,  156,  158,  159,  160,  161,   52,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,    0,    0,
+  152,    0,  154,  155,    0,    0,   51,    0,   60,   61,
+   63,   47,    0,   56,  248,   64,   59,    0,   58,  162,
+  163,    0,    0,  164,    0,    0,  165,  166,  167,    0,
+    0,    0,    0,    0,    0,    0,    0,   62,    0,    0,
+    0,    0,    0,   52,   82,   82,   82,   82,    0,    0,
+    0,    0,    0,   82,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   60,    0,   82,   82,    0,   51,
+   82,   82,   61,   63,   47,    0,   56,  276,   64,   59,
+    0,   58,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   52,
+   62,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   22,   24,   25,
+   26,   27,   28,    0,   29,   30,   31,   60,    0,    0,
+   32,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   38,    0,   39,   40,   41,    0,    0,    0,    0,
+   42,   43,   44,   45,   46,    0,    0,   48,   49,    0,
+    0,    0,   52,    0,   50,    0,  119,    0,   53,  119,
+   54,   55,    0,    0,   24,   25,   26,   27,   28,    0,
+   29,   30,   31,  119,  119,    0,   32,    0,  119,    0,
+    0,    0,    0,    0,    0,    0,    0,   38,    0,   39,
+   40,   41,    0,    0,    0,    0,   42,   43,   44,   45,
+   46,    0,    0,   48,   49,    0,  119,    0,  119,    0,
+   50,    0,  143,    0,   53,  143,   54,   55,    0,    0,
+   24,   25,   26,   27,   28,    0,   29,   30,   31,  143,
+  143,    0,   32,    0,  143,    0,    0,    0,  119,    0,
+    0,    0,    0,   38,    0,   39,   40,   41,    0,    0,
+    0,    0,   42,   43,   44,   45,   46,    0,    0,   48,
+   49,    0,  143,    0,  143,    0,   50,    0,    0,    0,
+   53,    0,   54,   55,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   24,   25,   26,   27,   28,    0,   29,
+   30,   31,    0,   51,  143,   32,   61,   63,   47,    0,
+   56,  278,   64,   59,    0,   58,   38,    0,   39,   40,
+   41,    0,    0,    0,    0,   42,   43,   44,   45,   46,
+    0,    0,   48,   49,   62,    0,   87,   87,    0,   50,
+    0,    0,    0,   53,    0,   54,   55,    0,  103,    0,
+    0,    0,    0,   87,  112,    0,    0,    0,   87,   51,
+  121,   60,   61,   63,   47,    0,   56,    0,   64,   59,
+    0,   58,   87,   87,   87,   87,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   62,    0,    0,    0,    0,    0,   52,  119,  119,  119,
+  119,    0,    0,    0,    0,    0,  119,    0,    0,    0,
+  119,  119,  119,  119,    0,    0,    0,   60,  121,  119,
+  119,    0,    0,  119,  119,  119,  119,  119,    0,  119,
+  119,    0,  130,  119,    0,  130,  119,  119,  119,    0,
+    0,    0,    0,  129,    0,    0,  129,    0,    0,  130,
+  130,    0,   52,  143,  143,  143,  143,    0,    0,    0,
+  129,  129,  143,    0,    0,  129,  143,  143,  143,  143,
+    0,    0,    0,    0,    0,  143,  143,    0,  240,  143,
+  143,  143,  143,  143,  130,  143,  143,    0,  104,  143,
+    0,  104,  143,  143,  143,  129,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  104,  104,    0,    0,    0,
+  104,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  129,    0,   24,   25,   26,
+   27,   28,    0,   29,   30,   31,    0,    0,  104,   32,
+  104,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   38,    0,   39,   40,   41,    0,    0,    0,    0,   42,
+   43,   44,   45,   46,    0,    0,   48,   49,    0,    0,
+    0,    0,    0,   50,    0,  145,    0,   53,  145,   54,
+   55,    0,    0,   24,   25,   26,   27,   28,    0,   29,
+   30,   31,  145,  145,    0,   32,    0,  145,    0,    0,
+    0,    0,    0,    0,    0,    0,   38,    0,   39,   40,
+   41,    0,    0,    0,    0,   42,   43,   44,   45,   46,
+    0,    0,   48,   49,    0,    0,    0,  145,    0,   50,
+  131,    0,    0,   53,    0,   54,   55,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  131,  131,    0,
+    0,    0,  131,    0,    0,    0,    0,  145,    0,    0,
+    0,    0,    0,  130,  130,  130,  130,    0,    0,    0,
+    0,    0,    0,    0,  129,  129,  129,  129,    0,    0,
+  131,    0,  131,  129,    0,  130,  130,  129,  129,  129,
+  129,    0,    0,    0,    0,    0,  129,  129,    0,    0,
+  129,  129,  129,  129,  129,    0,  129,  129,    0,    0,
+  129,    0,  131,  129,  129,  129,    0,    0,    0,  104,
+  104,  104,  104,    0,    0,    0,    0,    0,  104,    0,
+    0,    0,  104,  104,  104,  104,    0,    0,    0,    0,
+    0,  104,  104,    0,  146,  104,  104,  104,  104,  104,
+    0,  104,  104,    0,    0,  104,    0,    0,  104,  104,
+  104,  146,  146,    0,    0,    0,  146,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  146,    0,  146,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  145,  145,  145,  145,
+    0,    0,    0,    0,    0,  145,    0,    0,    0,  145,
+  145,  145,  145,    0,    0,    0,  146,    0,  145,  145,
+    0,    0,  145,  145,  145,  145,  145,    0,  145,  145,
+   59,    0,  145,   59,    0,  145,  145,  145,    0,    0,
+    0,   96,    0,    0,   96,    0,    0,   59,   59,    0,
+    0,  131,  131,  131,  131,    0,    0,    0,   96,   96,
+  131,    0,    0,   96,  131,  131,  131,  131,    0,    0,
+    0,    0,    0,  131,  131,    0,    0,  131,  131,  131,
+  131,  131,   59,  131,  131,    0,    0,  131,    0,    0,
+  131,  131,  131,   96,   58,    0,    0,   58,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   58,   58,    0,    0,    0,   58,    0,    0,    0,
+    0,    0,    0,   96,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   95,    0,    0,
+   95,    0,    0,    0,    0,    0,   58,    0,    0,    0,
+    0,    0,    0,    0,   95,   95,    0,    0,    0,   95,
+    0,    0,    0,    0,    0,  146,  146,  146,  146,    0,
+    0,    0,    0,    0,  146,    0,   58,    0,  146,  146,
+  146,  146,    0,    0,    0,   61,    0,  146,  146,   95,
+    0,  146,  146,  146,  146,  146,    0,  146,  146,    0,
+    0,  146,   61,   61,  146,  146,  146,   61,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   95,
+    0,    0,    0,    0,    0,    0,    0,  145,    0,    0,
+  145,    0,    0,    0,    0,   61,    0,   61,    0,    0,
+    0,    0,    0,    0,  145,  145,    0,    0,    0,  145,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   59,   59,   59,   59,    0,    0,   61,    0,    0,
+    0,    0,   96,   96,   96,   96,    0,    0,    0,  145,
+    0,   96,    0,   59,   59,   96,   96,   96,   96,    0,
+    0,    0,    0,    0,   96,   96,    0,    0,   96,   96,
+   96,   96,   96,    0,   96,   96,    0,    0,   96,    0,
+    0,   96,   96,   96,    0,  132,    0,    0,  132,    0,
+    0,    0,    0,    0,    0,   58,   58,   58,   58,    0,
+    0,    0,  132,  132,   58,    0,    0,  132,   58,   58,
+   58,   58,    0,    0,    0,    0,    0,   58,   58,    0,
+    0,   58,   58,   58,   58,   58,    0,   58,   58,    0,
+    0,   58,    0,    0,   58,   58,   58,  132,   95,   95,
+   95,   95,    0,    0,    0,   71,    0,   95,   71,    0,
+    0,   95,   95,   95,   95,    0,    0,    0,    0,    0,
+   95,   95,   71,   71,   95,   95,   95,   95,   95,    0,
+   95,   95,    0,    0,   95,    0,    0,   95,   95,   95,
+    0,    0,    0,    0,    0,    0,   61,   61,   61,   61,
+    0,    0,    0,    0,    0,   61,    0,   71,    0,   61,
+   61,   61,   61,    0,    0,    0,    0,    0,   61,   61,
+    0,  157,   61,   61,   61,   61,   61,    0,   61,   61,
+    0,    0,   61,    0,    0,   61,   61,   61,  145,  145,
+  145,  145,    0,    0,    0,    0,    0,  145,    0,  168,
+    0,  145,  145,  145,  145,    0,    0,    0,    0,    0,
+  145,  145,    0,    0,  145,  145,  145,  145,  145,  102,
+  145,  145,  102,    0,  145,    0,    0,  145,  145,  145,
+    0,  150,    0,    0,    0,    0,  102,  102,    0,    0,
+    0,  102,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  109,    0,    0,  109,
+    0,  102,    0,    0,    0,    0,  132,  132,  132,  132,
+    0,    0,    0,  109,  109,  132,    0,    0,  109,  132,
+  132,  132,  132,    0,    0,    0,    0,    0,  132,  132,
+    0,    0,  132,  132,  132,  132,  132,    0,  132,  132,
+   92,    0,  132,   92,    0,  132,  132,  132,  109,    0,
+    0,    0,    0,    0,    0,    0,    0,   92,   92,    0,
+    0,    0,   92,    0,    0,    0,   71,   71,   71,   71,
+    0,    0,    0,    0,    0,    0,    0,   93,    0,    0,
+   93,    0,    0,    0,    0,    0,    0,    0,   71,   71,
+    0,    0,   92,    0,   93,   93,    0,    0,    0,   93,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   87,    0,    0,   87,    0,  151,
+    0,    0,    0,  152,  153,  154,  155,    0,    0,   93,
+    0,   87,   87,    0,    0,    0,   87,  158,  159,  160,
+  161,    0,  162,  163,    0,    0,  164,    0,    0,  165,
+  166,  167,   88,    0,    0,   88,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   87,    0,    0,   88,
+   88,    0,    0,    0,   88,    0,    0,    0,    0,    0,
+  102,  102,  102,  102,    0,    0,    0,    0,    0,  102,
+    0,    0,    0,  102,  102,  102,  102,    0,    0,    0,
+    0,    0,  102,  102,   88,    0,  102,  102,  102,  102,
+  102,    0,  102,  102,    0,    0,  102,    0,    0,  102,
+  102,  102,    0,    0,    0,    0,    0,  109,  109,  109,
+  109,    0,    0,    0,    0,    0,  109,    0,    0,    0,
+  109,  109,  109,  109,    0,    0,    0,    0,    0,  109,
+  109,    0,    0,  109,  109,  109,  109,  109,    0,  109,
+  109,   89,    0,  109,   89,    0,  109,  109,  109,    0,
+    0,   92,   92,   92,   92,    0,    0,    0,   89,   89,
+   92,    0,    0,   89,   92,   92,   92,   92,    0,    0,
+    0,    0,    0,   92,   92,    0,    0,   92,   92,   92,
+   92,   92,    0,   92,   92,    0,    0,   92,   93,   93,
+   93,   93,    0,   89,    0,    0,    0,   93,    0,    0,
+    0,   93,   93,   93,   93,    0,    0,    0,    0,    0,
+   93,   93,    0,    0,   93,   93,   93,   93,   93,    0,
+   93,   93,    0,    0,   93,   87,   87,   87,   87,    0,
+    0,    0,    0,    0,   87,    0,    0,    0,   87,   87,
+   87,   87,    0,    0,    0,    0,    0,   87,   87,    0,
+    0,   87,   87,   87,   87,   87,    0,   87,   87,    0,
+    0,    0,    0,   88,   88,   88,   88,    0,    0,    0,
+    0,    0,   88,    0,    0,    0,   88,   88,   88,   88,
+   85,    0,    0,   85,    0,   88,   88,    0,    0,   88,
+   88,   88,   88,   88,    0,   88,   88,   85,   85,    0,
+    0,    0,   85,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   86,    0,    0,   86,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   85,   86,   86,    0,    0,    0,   86,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   84,    0,    0,   84,    0,    0,    0,    0,   86,    0,
+    0,    0,   89,   89,   89,   89,    0,   84,   84,    0,
+    0,   89,   84,    0,    0,   89,   89,   89,   89,    0,
+    0,    0,    0,    0,   89,   89,    0,    0,   89,   89,
+   89,   89,   89,   72,   89,   89,   72,    0,    0,    0,
+    0,    0,   84,    0,    0,    0,    0,    0,    0,    0,
+   72,   72,    0,    0,    0,   72,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   73,
+    0,    0,   73,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   72,   73,   73,    0,    0,
+    0,   73,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   75,    0,    0,   75,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   73,    0,   75,   75,    0,    0,    0,   75,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   85,   85,   85,   85,    0,    0,    0,    0,    0,
+   85,    0,    0,    0,   85,   85,   85,   85,   75,    0,
+    0,    0,    0,   85,   85,    0,    0,   85,   85,   85,
+   85,   85,    0,   85,   85,    0,    0,   86,   86,   86,
+   86,    0,    0,    0,    0,    0,   86,    0,    0,    0,
+   86,   86,   86,   86,  123,    0,    0,  123,    0,   86,
+   86,    0,    0,   86,   86,   86,   86,   86,    0,   86,
+   86,  123,  123,    0,    0,    0,  123,    0,    0,    0,
+    0,   84,   84,   84,   84,    0,    0,    0,    0,    0,
+   84,    0,    0,    0,   84,   84,   84,   84,    0,    0,
+    0,    0,    0,   84,   84,    0,  123,   84,   84,   84,
+   84,   84,   94,   84,   84,   94,    0,    0,    0,    0,
+    0,    0,    0,    0,   72,   72,   72,   72,    0,   94,
+   94,    0,    0,   72,   94,    0,    0,   72,   72,   72,
+   72,    0,    0,    0,    0,    0,   72,   72,    0,    0,
+   72,   72,   72,   72,   72,    0,   72,   72,    0,    0,
+   73,   73,   73,   73,   94,    0,    0,    0,    0,   73,
+    0,    0,    0,   73,   73,   73,   73,    0,    0,    0,
+    0,    0,   73,   73,    0,    0,   73,   73,   73,   73,
+   73,  134,   73,    0,  134,    0,    0,   75,   75,   75,
+   75,    0,    0,    0,    0,    0,   75,    0,  134,  134,
+   75,   75,    0,  134,    0,    0,    0,    0,    0,   75,
+   75,    0,    0,   75,   75,   75,   75,   75,   76,   75,
+    0,   76,    0,    0,    0,    0,    0,    0,   77,    0,
+    0,   77,    0,  134,    0,   76,   76,    0,    0,    0,
+   76,    0,    0,    0,    0,   77,   77,    0,    0,    0,
+   77,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   78,    0,    0,   78,    0,    0,
+   76,    0,    0,    0,    0,  123,  123,  123,  123,    0,
+   77,   78,   78,    0,  123,    0,   78,    0,  123,  123,
+    0,    0,    0,    0,    0,    0,   79,  123,  123,   79,
+    0,  123,  123,  123,  123,  123,   81,    0,    0,   81,
+    0,    0,    0,   79,   79,    0,   78,    0,   79,    0,
+    0,    0,    0,   81,   81,    0,    0,    0,   81,    0,
+    0,    0,    0,   94,   94,   94,   94,    0,    0,  284,
+    0,    0,   94,    0,  157,    0,   94,   94,   79,    0,
+    0,    0,    0,    0,    0,   94,   94,    0,   81,   94,
+   94,   94,   94,   94,    0,    0,    0,    0,    0,    0,
+    0,    0,  168,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  150,    0,    0,    0,    0,    0,
+    0,    0,  134,  134,  134,  134,    0,    0,    0,    0,
+    0,  134,    0,    0,    0,  134,  134,    0,    0,    0,
+    0,    0,    0,    0,  134,  134,    0,    0,  134,  134,
+  134,  134,  134,    0,    0,    0,    0,    0,    0,   76,
+   76,   76,   76,    0,    0,    0,    0,    0,   76,   77,
+   77,   77,   77,   76,    0,    0,    0,    0,   77,    0,
+    0,   76,   76,    0,    0,   76,   76,   76,   76,   76,
+    0,   77,   77,    0,    0,   77,   77,   77,   77,   77,
+    0,    0,    0,    0,    0,   78,   78,   78,   78,    0,
+    0,    0,    0,    0,   78,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   78,   78,    0,
+    0,   78,   78,   78,   78,   78,    0,   79,   79,   79,
+   79,    0,    0,    0,    0,    0,   79,   81,   81,   81,
+   81,    0,    0,    0,    0,    0,   81,    0,    0,   79,
+   79,    0,    0,   79,   79,   79,   79,    0,    0,   81,
+   81,    0,  151,   81,   81,   81,  152,  153,  154,  155,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  156,
+  158,  159,  160,  161,    0,  162,  163,   91,    0,  164,
+    0,    0,  165,  166,  167,  104,    0,    0,    0,    0,
+  111,  113,    0,    0,    0,    0,    0,  125,  126,  127,
+  128,  129,  130,    0,    0,  133,  134,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  183,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  215,    0,    0,    0,    0,    0,    0,    0,  223,  224,
+  225,  226,  227,  228,  229,  230,  231,  232,  233,  234,
+  235,  236,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  296,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  312,
+};
+short yycheck[] = {                                      13,
+  257,   13,   91,   17,   44,   41,   59,  182,   36,   41,
+   59,  257,   44,  194,   41,  188,   59,  190,   41,   33,
+   34,   35,   36,   59,   82,   40,   58,   59,   41,   43,
+   88,   63,  125,   45,  123,   59,   50,   40,   59,   59,
+   40,   91,  123,   91,   56,   41,  257,   41,   60,   41,
+   41,   41,  278,   41,   36,   41,   44,   93,  116,   40,
+   91,   93,   41,   91,   78,   41,   40,   40,   59,   41,
+   58,   59,   40,  123,  123,  123,   91,   41,   92,   41,
+   40,   95,   94,   97,   96,   99,   98,  101,  100,   41,
+  102,   40,  123,   41,  106,  123,   44,   59,   41,  123,
+   59,   41,  294,  295,   41,   93,    0,   59,  123,   59,
+   58,   59,  287,   59,   44,   59,   59,   59,  299,   59,
+  123,  302,   59,  123,  297,  298,  184,  141,  276,  277,
+  123,  304,  144,  145,  146,  147,  148,  149,  150,   33,
+   40,  123,   36,   37,   38,   93,   40,  260,   42,   43,
+  123,   45,  123,  334,  327,   93,  168,  169,  170,  171,
+  172,  173,  174,  123,  178,   59,   40,   40,   36,    0,
+   64,  185,   40,  266,  267,  268,  257,  270,  271,   41,
+   40,   93,   91,  266,  267,  268,  198,  270,  271,  125,
+   93,   41,  204,  205,  206,   59,   59,   91,  287,  211,
+   41,  125,   33,   91,  257,   36,   37,   38,  295,   40,
+   93,   42,   43,   40,   45,   41,  305,   40,  125,  308,
+  125,  125,  311,  312,  313,  237,  125,  239,   59,  123,
+  258,  125,  126,   64,   59,  125,  272,  273,  274,  275,
+  272,  273,  274,  275,   93,  259,   41,  261,   41,  263,
+  264,  294,  295,  267,  294,  295,  270,  269,  294,  295,
+   91,   41,  294,  295,   44,  313,  298,  294,  295,   93,
+  282,  294,  295,  294,  295,  257,  272,  273,  274,  275,
+  262,  294,  295,   63,  272,  273,  274,  275,   59,  301,
+  123,  305,  123,   41,  125,  126,    0,   93,  294,  295,
+  294,  295,  294,  295,  294,  295,  294,  295,  294,  295,
+  298,   91,   59,  325,   41,  294,  295,  331,  294,  295,
+   59,  335,  294,  295,  272,  273,  274,  275,   41,   33,
+  294,  295,   36,   37,   38,   59,   40,   83,   42,   43,
+   41,   45,  325,  123,  294,  295,  294,  295,  294,  295,
+  294,  295,  294,  295,   13,   59,  294,  295,  269,   93,
+   64,   -1,  256,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,  266,  267,  268,  269,  270,  271,  272,  273,
+  274,  275,  294,  295,   -1,  279,  280,   91,  282,  283,
+  284,  294,  295,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   41,   -1,   -1,   44,  303,
+   -1,  294,  295,  307,   -1,  309,  310,   -1,   -1,  123,
+   -1,   -1,  126,   59,   91,  256,  257,  258,  259,  260,
+  261,   -1,  263,  264,  265,  266,  267,  268,  269,  270,
+  271,  272,  273,  274,  275,  294,  295,   -1,  279,  280,
+   -1,  282,  283,  284,   91,   -1,  123,   93,  289,  290,
+  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,
+  294,  295,  303,   -1,   -1,   -1,  307,   -1,  309,  310,
+  272,  273,  274,  275,   33,   91,  123,   36,   37,   38,
+   -1,   40,   41,   42,   43,   44,   45,   -1,  294,  295,
+   -1,  281,  294,  295,   -1,  285,  286,  287,  288,   58,
+   59,    6,   -1,    8,   63,   64,   -1,  123,  298,  299,
+  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
+   -1,  311,  312,  313,   -1,   -1,   31,   32,   -1,   -1,
+   -1,   -1,   91,   -1,   93,   41,   -1,   -1,   44,   -1,
+   -1,   91,  256,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   58,   59,   -1,  269,   -1,   63,  272,  273,
+  274,  275,   -1,   -1,  123,  279,  280,  126,  282,  283,
+  284,   -1,   -1,  123,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   91,   -1,   93,   -1,  303,
+   -1,   -1,   -1,  307,   33,  309,  310,   36,   37,   38,
+   -1,   40,   41,   42,   43,   44,   45,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   58,
+   59,   -1,   -1,   -1,   63,   64,  272,  273,  274,  275,
+   -1,  308,   -1,   -1,  311,  312,  313,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,  294,   -1,
+   -1,   -1,   -1,   -1,   93,  302,   -1,  304,  305,   -1,
+   41,  308,   -1,   44,  311,  312,  313,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,  299,  300,  301,  302,  126,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,
+  269,   -1,   93,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,  280,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,  297,  298,
+  299,  300,  301,  302,  303,  304,  305,   -1,  307,  308,
+  309,  310,  311,  312,  313,  305,   -1,   -1,  308,   91,
+   -1,  311,  312,  313,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,  123,  298,  299,  300,  301,  302,   -1,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   91,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,
+  269,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+  123,  280,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,  297,  298,
+  299,  300,  301,  302,  303,  304,  305,   -1,  307,  308,
+  309,  310,  311,  312,  313,   33,   48,   49,   36,   37,
+   38,   -1,   40,   -1,   42,   43,   -1,   45,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   59,   -1,   -1,  285,  286,   64,  288,   -1,   -1,
+   82,   -1,   -1,  294,  295,   -1,   88,  298,  299,  300,
+  301,  302,   -1,  304,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   33,   -1,   91,   36,   37,   38,   -1,   40,   -1,
+   42,   43,   -1,   45,  116,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,   -1,  285,  286,  287,  288,   59,   -1,   -1,
+   -1,   -1,   64,   -1,   -1,  123,   -1,   -1,  126,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   -1,   -1,   -1,   -1,   -1,   33,   -1,   91,
+   36,   37,   38,   -1,   40,   -1,   42,   43,   -1,   45,
+   -1,   -1,   -1,   -1,  287,  288,   -1,   -1,   -1,   -1,
+   -1,   -1,  184,   -1,   -1,   -1,   -1,   -1,   64,   -1,
+   -1,  123,  305,   -1,  126,  308,   -1,   -1,  311,  312,
+  313,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   91,   -1,   26,   -1,   -1,
+   33,   58,   59,   36,   37,   38,   -1,   40,   -1,   42,
+   43,   -1,   45,   42,   -1,   -1,   -1,   -1,   47,   -1,
+   49,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   -1,
+  126,   64,   61,   62,   63,   64,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   91,   -1,
+   -1,  269,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   -1,  279,  280,   -1,  282,  283,  284,   -1,  107,   -1,
+   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,  297,
+  123,   -1,   -1,  126,   91,  303,   -1,   -1,   -1,  307,
+   -1,  309,  310,   -1,  256,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   -1,   -1,  269,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,  123,  279,  280,   -1,
+  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
+  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,
+   91,  303,   -1,   -1,   -1,  307,   -1,  309,  310,   -1,
+   -1,  257,  258,  259,  260,  261,  262,  263,  264,  265,
+   41,   -1,   -1,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  123,   -1,  280,   -1,  282,  283,  284,   -1,
+   -1,   -1,   63,  289,  290,  291,  292,  293,   -1,   -1,
+  296,  297,   -1,   -1,   -1,   -1,   -1,  303,   -1,   -1,
+   -1,  307,   -1,  309,  310,  272,  273,  274,  275,   -1,
+   91,   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   -1,   -1,   -1,  269,  294,  295,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,  123,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,   -1,
+  303,   -1,   -1,   -1,  307,   33,  309,  310,   36,   37,
+   38,   -1,   40,   -1,   42,   43,   -1,   45,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   59,   -1,  300,  301,  302,   64,  304,  305,   -1,
+   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   33,   -1,   91,   36,   37,   38,   -1,   40,   -1,
+   42,   43,   -1,   45,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   64,  304,  305,   -1,   -1,  308,  126,   -1,
+  311,  312,  313,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,   91,
+   36,   37,   38,   -1,   40,   41,   42,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   64,   -1,
+   -1,  123,   -1,   -1,  126,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,
+  311,  312,  313,   -1,   -1,   91,   -1,   -1,   -1,   -1,
+   33,   -1,   -1,   36,   37,   38,   -1,   40,   -1,   42,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  126,   64,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   91,   -1,
+   93,  269,   -1,   -1,   -1,   91,   -1,   -1,   -1,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,
+   -1,  289,  290,  291,  292,  293,   -1,   63,  296,  297,
+   -1,   -1,   -1,  126,   -1,  303,   -1,  123,   -1,  307,
+   -1,  309,  310,   -1,   -1,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   91,   -1,  269,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
+  292,  293,   -1,   -1,  296,  297,   91,  123,   -1,   -1,
+   -1,  303,   -1,   41,   -1,  307,   44,  309,  310,   -1,
+   -1,  257,  258,  259,  260,  261,   -1,  263,  264,  265,
+   58,   59,   -1,  269,   -1,   63,   -1,   -1,  123,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+   -1,   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,
+  296,  297,   -1,   -1,   -1,   93,   -1,  303,   -1,   -1,
+   -1,  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   -1,   33,   -1,  269,   36,   37,   38,
+   -1,   40,   -1,   42,   43,   -1,   45,  280,   -1,  282,
+  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,  287,  288,  296,  297,   64,   -1,   -1,   -1,   -1,
+  303,   -1,   -1,   -1,  307,   -1,  309,  310,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,
+   33,   -1,   91,   36,   37,   38,   -1,   40,   41,   42,
+   43,   -1,   45,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   64,  298,  299,  300,  301,  302,  126,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,
+  285,   -1,  287,  288,   -1,   -1,   33,   -1,   91,   36,
+   37,   38,   -1,   40,   41,   42,   43,   -1,   45,  304,
+  305,   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   64,   -1,   -1,
+   -1,   -1,   -1,  126,  272,  273,  274,  275,   -1,   -1,
+   -1,   -1,   -1,  281,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   91,   -1,  294,  295,   -1,   33,
+  298,  299,   36,   37,   38,   -1,   40,   41,   42,   43,
+   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  126,
+   64,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   91,   -1,   -1,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,
+  289,  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,
+   -1,   -1,  126,   -1,  303,   -1,   41,   -1,  307,   44,
+  309,  310,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   58,   59,   -1,  269,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,   -1,   -1,  296,  297,   -1,   91,   -1,   93,   -1,
+  303,   -1,   41,   -1,  307,   44,  309,  310,   -1,   -1,
+  257,  258,  259,  260,  261,   -1,  263,  264,  265,   58,
+   59,   -1,  269,   -1,   63,   -1,   -1,   -1,  123,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,
+   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,
+  297,   -1,   91,   -1,   93,   -1,  303,   -1,   -1,   -1,
+  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   -1,   33,  123,  269,   36,   37,   38,   -1,
+   40,   41,   42,   43,   -1,   45,  280,   -1,  282,  283,
+  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   64,   -1,   25,   26,   -1,  303,
+   -1,   -1,   -1,  307,   -1,  309,  310,   -1,   37,   -1,
+   -1,   -1,   -1,   42,   43,   -1,   -1,   -1,   47,   33,
+   49,   91,   36,   37,   38,   -1,   40,   -1,   42,   43,
+   -1,   45,   61,   62,   63,   64,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   64,   -1,   -1,   -1,   -1,   -1,  126,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   91,  107,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   -1,   41,  308,   -1,   44,  311,  312,  313,   -1,
+   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,   58,
+   59,   -1,  126,  272,  273,  274,  275,   -1,   -1,   -1,
+   58,   59,  281,   -1,   -1,   63,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,  167,  298,
+  299,  300,  301,  302,   93,  304,  305,   -1,   41,  308,
+   -1,   44,  311,  312,  313,   93,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  123,   -1,  257,  258,  259,
+  260,  261,   -1,  263,  264,  265,   -1,   -1,   91,  269,
+   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,  289,
+  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,
+   -1,   -1,   -1,  303,   -1,   41,   -1,  307,   44,  309,
+  310,   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   58,   59,   -1,  269,   -1,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
+  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   -1,   -1,   93,   -1,  303,
+   41,   -1,   -1,  307,   -1,  309,  310,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,   -1,  123,   -1,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   91,   -1,   93,  281,   -1,  294,  295,  285,  286,  287,
+  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
+  298,  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,
+  308,   -1,  123,  311,  312,  313,   -1,   -1,   -1,  272,
+  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,
+   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,
+   -1,  294,  295,   -1,   41,  298,  299,  300,  301,  302,
+   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,
+  313,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   91,   -1,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,  123,   -1,  294,  295,
+   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
+   41,   -1,  308,   44,   -1,  311,  312,  313,   -1,   -1,
+   -1,   41,   -1,   -1,   44,   -1,   -1,   58,   59,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
+  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   93,  304,  305,   -1,   -1,  308,   -1,   -1,
+  311,  312,  313,   93,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,  123,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   41,   -1,  294,  295,   93,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,  308,   58,   59,  311,  312,  313,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   91,   -1,   93,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,  123,   -1,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   93,
+   -1,  281,   -1,  294,  295,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
+   -1,  311,  312,  313,   -1,   41,   -1,   -1,   44,   -1,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,  308,   -1,   -1,  311,  312,  313,   93,  272,  273,
+  274,  275,   -1,   -1,   -1,   41,   -1,  281,   44,   -1,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   58,   59,  298,  299,  300,  301,  302,   -1,
+  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,  313,
+   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   93,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   63,  298,  299,  300,  301,  302,   -1,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,  272,  273,
+  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   91,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   41,
+  304,  305,   44,   -1,  308,   -1,   -1,  311,  312,  313,
+   -1,  123,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   93,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
+   41,   -1,  308,   44,   -1,  311,  312,  313,   93,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   -1,   93,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   93,
+   -1,   58,   59,   -1,   -1,   -1,   63,  299,  300,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   93,   -1,   -1,   58,
+   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,  294,  295,   93,   -1,  298,  299,  300,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   41,   -1,  308,   44,   -1,  311,  312,  313,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
+  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  308,  272,  273,
+  274,  275,   -1,   93,   -1,   -1,   -1,  281,   -1,   -1,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
+  304,  305,   -1,   -1,  308,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   41,   -1,   -1,   44,   -1,  294,  295,   -1,   -1,  298,
+  299,  300,  301,  302,   -1,  304,  305,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   93,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   93,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   58,   59,   -1,
+   -1,  281,   63,   -1,   -1,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   41,  304,  305,   44,   -1,   -1,   -1,
+   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,
+   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   93,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   93,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   93,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   41,   -1,   -1,   44,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   93,  298,  299,  300,
+  301,  302,   41,  304,  305,   44,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   58,
+   59,   -1,   -1,  281,   63,   -1,   -1,  285,  286,  287,
+  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
+  298,  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,
+  272,  273,  274,  275,   93,   -1,   -1,   -1,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,
+  302,   41,  304,   -1,   44,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   58,   59,
+  285,  286,   -1,   63,   -1,   -1,   -1,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   41,  304,
+   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   44,   -1,   93,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   93,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   93,   58,   59,   -1,  281,   -1,   63,   -1,  285,  286,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,  294,  295,   44,
+   -1,  298,  299,  300,  301,  302,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   58,   59,   -1,   93,   -1,   63,   -1,
+   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   58,
+   -1,   -1,  281,   -1,   63,   -1,  285,  286,   93,   -1,
+   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   93,  298,
+  299,  300,  301,  302,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   91,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
+   -1,  281,   -1,   -1,   -1,  285,  286,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   -1,   -1,   -1,   -1,   -1,   -1,  272,
+  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,  272,
+  273,  274,  275,  286,   -1,   -1,   -1,   -1,  281,   -1,
+   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
+   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,   -1,   -1,  294,
+  295,   -1,  281,  298,  299,  300,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  298,
+  299,  300,  301,  302,   -1,  304,  305,   30,   -1,  308,
+   -1,   -1,  311,  312,  313,   38,   -1,   -1,   -1,   -1,
+   43,   44,   -1,   -1,   -1,   -1,   -1,   50,   51,   52,
+   53,   54,   55,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   90,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  143,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  151,  152,
+  153,  154,  155,  156,  157,  158,  159,  160,  161,  162,
+  163,  164,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  256,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  284,
+};
+#define YYFINAL 1
+#ifndef YYDEBUG
+#define YYDEBUG 0
+#endif
+#define YYMAXTOKEN 313
+#if YYDEBUG
+char *yyname[] = {
+"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+"'!'",0,0,"'$'","'%'","'&'",0,"'('","')'","'*'","'+'","','","'-'",0,0,0,0,0,0,0,
+0,0,0,0,0,"':'","';'",0,0,0,"'?'","'@'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,"'['",0,"']'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,"'{'",0,"'}'","'~'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING",
+"PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB",
+"ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF",
+"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP",
+"MULOP","ADDOP","DOLSHARP","DO","LOCAL","HASHBRACK","NOAMP","OROP","ANDOP",
+"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP",
+"SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC",
+"POSTDEC","ARROW",
+};
+char *yyrule[] = {
+"$accept : prog",
+"$$1 :",
+"prog : $$1 lineseq",
+"block : '{' remember lineseq '}'",
+"remember :",
+"lineseq :",
+"lineseq : lineseq decl",
+"lineseq : lineseq line",
+"line : label cond",
+"line : loop",
+"line : label ';'",
+"line : label sideff ';'",
+"sideff : error",
+"sideff : expr",
+"sideff : expr IF expr",
+"sideff : expr UNLESS expr",
+"sideff : expr WHILE expr",
+"sideff : expr UNTIL expr",
+"else :",
+"else : ELSE block",
+"else : ELSIF '(' expr ')' block else",
+"cond : IF '(' expr ')' block else",
+"cond : UNLESS '(' expr ')' block else",
+"cond : IF block block else",
+"cond : UNLESS block block else",
+"cont :",
+"cont : CONTINUE block",
+"loop : label WHILE '(' texpr ')' block cont",
+"loop : label UNTIL '(' expr ')' block cont",
+"loop : label WHILE block block cont",
+"loop : label UNTIL block block cont",
+"loop : label FOR scalar '(' expr ')' block cont",
+"loop : label FOR '(' expr ')' block cont",
+"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block",
+"loop : label block cont",
+"nexpr :",
+"nexpr : sideff",
+"texpr :",
+"texpr : expr",
+"label :",
+"label : LABEL",
+"decl : format",
+"decl : subrout",
+"decl : package",
+"decl : use",
+"format : FORMAT startsub WORD block",
+"format : FORMAT startsub block",
+"subrout : SUB startsub WORD proto block",
+"subrout : SUB startsub WORD proto ';'",
+"proto :",
+"proto : THING",
+"startsub :",
+"package : PACKAGE WORD ';'",
+"package : PACKAGE ';'",
+"use : USE startsub WORD listexpr ';'",
+"expr : expr ANDOP expr",
+"expr : expr OROP expr",
+"expr : argexpr",
+"argexpr : argexpr ','",
+"argexpr : argexpr ',' term",
+"argexpr : term",
+"listop : LSTOP indirob argexpr",
+"listop : FUNC '(' indirob expr ')'",
+"listop : term ARROW method '(' listexprcom ')'",
+"listop : METHOD indirob listexpr",
+"listop : FUNCMETH indirob '(' listexprcom ')'",
+"listop : LSTOP listexpr",
+"listop : FUNC '(' listexprcom ')'",
+"listop : LSTOPSUB startsub block listexpr",
+"method : METHOD",
+"method : scalar",
+"term : term ASSIGNOP term",
+"term : term POWOP term",
+"term : term MULOP term",
+"term : term ADDOP term",
+"term : term SHIFTOP term",
+"term : term RELOP term",
+"term : term EQOP term",
+"term : term BITANDOP term",
+"term : term BITOROP term",
+"term : term DOTDOT term",
+"term : term ANDAND term",
+"term : term OROR term",
+"term : term '?' term ':' term",
+"term : term MATCHOP term",
+"term : '-' term",
+"term : '+' term",
+"term : '!' term",
+"term : '~' term",
+"term : REFGEN term",
+"term : term POSTINC",
+"term : term POSTDEC",
+"term : PREINC term",
+"term : PREDEC term",
+"term : LOCAL term",
+"term : '(' expr ')'",
+"term : '(' ')'",
+"term : '[' expr ']'",
+"term : '[' ']'",
+"term : HASHBRACK expr ';' '}'",
+"term : HASHBRACK ';' '}'",
+"term : ANONSUB startsub proto block",
+"term : scalar",
+"term : star '{' expr ';' '}'",
+"term : star",
+"term : scalar '[' expr ']'",
+"term : term ARROW '[' expr ']'",
+"term : term '[' expr ']'",
+"term : hsh",
+"term : ary",
+"term : arylen",
+"term : scalar '{' expr ';' '}'",
+"term : term ARROW '{' expr ';' '}'",
+"term : term '{' expr ';' '}'",
+"term : '(' expr ')' '[' expr ']'",
+"term : '(' ')' '[' expr ']'",
+"term : ary '[' expr ']'",
+"term : ary '{' expr ';' '}'",
+"term : THING",
+"term : amper",
+"term : amper '(' ')'",
+"term : amper '(' expr ')'",
+"term : NOAMP WORD listexpr",
+"term : DO term",
+"term : DO block",
+"term : DO WORD '(' ')'",
+"term : DO WORD '(' expr ')'",
+"term : DO scalar '(' ')'",
+"term : DO scalar '(' expr ')'",
+"term : LOOPEX",
+"term : LOOPEX term",
+"term : NOTOP argexpr",
+"term : UNIOP",
+"term : UNIOP block",
+"term : UNIOP term",
+"term : UNIOPSUB term",
+"term : FUNC0",
+"term : FUNC0 '(' ')'",
+"term : FUNC0SUB",
+"term : FUNC1 '(' ')'",
+"term : FUNC1 '(' expr ')'",
+"term : PMFUNC '(' term ')'",
+"term : PMFUNC '(' term ',' term ')'",
+"term : WORD",
+"term : listop",
+"listexpr :",
+"listexpr : argexpr",
+"listexprcom :",
+"listexprcom : expr",
+"listexprcom : expr ','",
+"amper : '&' indirob",
+"scalar : '$' indirob",
+"ary : '@' indirob",
+"hsh : '%' indirob",
+"arylen : DOLSHARP indirob",
+"star : '*' indirob",
+"indirob : WORD",
+"indirob : scalar",
+"indirob : block",
+"indirob : PRIVATEREF",
+};
+#endif
+#define yyclearin (yychar=(-1))
+#define yyerrok (yyerrflag=0)
+#ifdef YYSTACKSIZE
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH YYSTACKSIZE
+#endif
+#else
+#ifdef YYMAXDEPTH
+#define YYSTACKSIZE YYMAXDEPTH
+#else
+#define YYSTACKSIZE 500
+#define YYMAXDEPTH 500
+#endif
+#endif
+int yydebug;
+int yynerrs;
+int yyerrflag;
+int yychar;
+YYSTYPE yyval;
+YYSTYPE yylval;
+#line 571 "perly.y"
+ /* PROGRAM */
+#line 1394 "y.tab.c"
+#define YYABORT goto yyabort
+#define YYACCEPT goto yyaccept
+#define YYERROR goto yyerrlab
+
+struct ysv {
+    short* yyss;
+    YYSTYPE* yyvs;
+    int oldyydebug;
+    int oldyynerrs;
+    int oldyyerrflag;
+    int oldyychar;
+    YYSTYPE oldyyval;
+    YYSTYPE oldyylval;
+};
+
+void
+yydestruct(ptr)
+void* ptr;
+{
+    struct ysv* ysave = (struct ysv*)ptr;
+    if (ysave->yyss) Safefree(ysave->yyss);
+    if (ysave->yyvs) Safefree(ysave->yyvs);
+    yydebug	= ysave->oldyydebug;
+    yynerrs	= ysave->oldyynerrs;
+    yyerrflag	= ysave->oldyyerrflag;
+    yychar	= ysave->oldyychar;
+    yyval	= ysave->oldyyval;
+    yylval	= ysave->oldyylval;
+    Safefree(ysave);
+}
+
+int
+yyparse()
+{
+    register int yym, yyn, yystate;
+    register short *yyssp;
+    register YYSTYPE *yyvsp;
+    short* yyss;
+    YYSTYPE* yyvs;
+    unsigned yystacksize = YYSTACKSIZE;
+    int retval = 0;
+#if YYDEBUG
+    register char *yys;
+    extern char *getenv();
+#endif
+
+    struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+    SAVEDESTRUCTOR(yydestruct, ysave);
+    ysave->oldyydebug	= yydebug;
+    ysave->oldyynerrs	= yynerrs;
+    ysave->oldyyerrflag	= yyerrflag;
+    ysave->oldyychar	= yychar;
+    ysave->oldyyval	= yyval;
+    ysave->oldyylval	= yylval;
+
+#if YYDEBUG
+    if (yys = getenv("YYDEBUG"))
+    {
+        yyn = *yys;
+        if (yyn >= '0' && yyn <= '9')
+            yydebug = yyn - '0';
+    }
+#endif
+
+    yynerrs = 0;
+    yyerrflag = 0;
+    yychar = (-1);
+
+    /*
+    ** Initialize private stacks (yyparse may be called from an action)
+    */
+    ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
+    ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+    if (!yyvs || !yyss)
+	goto yyoverflow;
+
+    yyssp = yyss;
+    yyvsp = yyvs;
+    *yyssp = yystate = 0;
+
+yyloop:
+    if (yyn = yydefred[yystate]) goto yyreduce;
+    if (yychar < 0)
+    {
+        if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate,
+                    yychar, yys);
+        }
+#endif
+    }
+    if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+#if YYDEBUG
+        if (yydebug)
+            fprintf(stderr, "yydebug: state %d, shifting to state %d\n",
+                    yystate, yytable[yyn]);
+#endif
+        if (yyssp >= yyss + yystacksize - 1)
+        {
+	    /*
+	    ** reallocate and recover.  Note that pointers
+	    ** have to be reset, or bad things will happen
+	    */
+	    int yyps_index = (yyssp - yyss);
+	    int yypv_index = (yyvsp - yyvs);
+	    yystacksize += YYSTACKSIZE;
+	    ysave->yyvs = yyvs =
+		(YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+	    ysave->yyss = yyss =
+		(short*)realloc((char*)yyss,yystacksize * sizeof(short));
+	    if (!yyvs || !yyss)
+		goto yyoverflow;
+	    yyssp = yyss + yyps_index;
+	    yyvsp = yyvs + yypv_index;
+        }
+        *++yyssp = yystate = yytable[yyn];
+        *++yyvsp = yylval;
+        yychar = (-1);
+        if (yyerrflag > 0)  --yyerrflag;
+        goto yyloop;
+    }
+    if ((yyn = yyrindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+        yyn = yytable[yyn];
+        goto yyreduce;
+    }
+    if (yyerrflag) goto yyinrecovery;
+#ifdef lint
+    goto yynewerror;
+#endif
+yynewerror:
+    yyerror("syntax error");
+#ifdef lint
+    goto yyerrlab;
+#endif
+yyerrlab:
+    ++yynerrs;
+yyinrecovery:
+    if (yyerrflag < 3)
+    {
+        yyerrflag = 3;
+        for (;;)
+        {
+            if ((yyn = yysindex[*yyssp]) && (yyn += YYERRCODE) >= 0 &&
+                    yyn <= YYTABLESIZE && yycheck[yyn] == YYERRCODE)
+            {
+#if YYDEBUG
+                if (yydebug)
+                    fprintf(stderr,
+		     "yydebug: state %d, error recovery shifting to state %d\n",
+		     *yyssp, yytable[yyn]);
+#endif
+                if (yyssp >= yyss + yystacksize - 1)
+                {
+		    /*
+		    ** reallocate and recover.  Note that pointers
+		    ** have to be reset, or bad things will happen
+		    */
+		    int yyps_index = (yyssp - yyss);
+		    int yypv_index = (yyvsp - yyvs);
+		    yystacksize += YYSTACKSIZE;
+		    ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
+			yystacksize * sizeof(YYSTYPE));
+		    ysave->yyss = yyss = (short*)realloc((char*)yyss,
+			yystacksize * sizeof(short));
+		    if (!yyvs || !yyss)
+			goto yyoverflow;
+		    yyssp = yyss + yyps_index;
+		    yyvsp = yyvs + yypv_index;
+                }
+                *++yyssp = yystate = yytable[yyn];
+                *++yyvsp = yylval;
+                goto yyloop;
+            }
+            else
+            {
+#if YYDEBUG
+                if (yydebug)
+                    fprintf(stderr,
+			"yydebug: error recovery discarding state %d\n",
+			*yyssp);
+#endif
+                if (yyssp <= yyss) goto yyabort;
+                --yyssp;
+                --yyvsp;
+            }
+        }
+    }
+    else
+    {
+        if (yychar == 0) goto yyabort;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            fprintf(stderr,
+		"yydebug: state %d, error recovery discards token %d (%s)\n",
+		yystate, yychar, yys);
+        }
+#endif
+        yychar = (-1);
+        goto yyloop;
+    }
+yyreduce:
+#if YYDEBUG
+    if (yydebug)
+        fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n",
+                yystate, yyn, yyrule[yyn]);
+#endif
+    yym = yylen[yyn];
+    yyval = yyvsp[1-yym];
+    switch (yyn)
+    {
+case 1:
+#line 84 "perly.y"
+{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (debug & 1);
+#endif
+		    expect = XSTATE;
+		}
+break;
+case 2:
+#line 91 "perly.y"
+{ newPROG(yyvsp[0].opval); }
+break;
+case 3:
+#line 95 "perly.y"
+{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); }
+break;
+case 4:
+#line 99 "perly.y"
+{ yyval.ival = block_start(); }
+break;
+case 5:
+#line 103 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 6:
+#line 105 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 7:
+#line 107 "perly.y"
+{   yyval.opval = append_list(OP_LINESEQ,
+				(LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
+			    pad_reset_pending = TRUE;
+			    if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; }
+break;
+case 8:
+#line 114 "perly.y"
+{ yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); }
+break;
+case 10:
+#line 117 "perly.y"
+{ if (yyvsp[-1].pval != Nullch) {
+			      yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0));
+			    }
+			    else {
+			      yyval.opval = Nullop;
+			      copline = NOLINE;
+			    }
+			    expect = XSTATE; }
+break;
+case 11:
+#line 126 "perly.y"
+{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
+			  expect = XSTATE; }
+break;
+case 12:
+#line 131 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 13:
+#line 133 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 14:
+#line 135 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); }
+break;
+case 15:
+#line 137 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); }
+break;
+case 16:
+#line 139 "perly.y"
+{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); }
+break;
+case 17:
+#line 141 "perly.y"
+{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);}
+break;
+case 18:
+#line 145 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 19:
+#line 147 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 20:
+#line 149 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, 0,
+				newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
+			    hints |= HINT_BLOCK_SCOPE; }
+break;
+case 21:
+#line 156 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 22:
+#line 159 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newCONDOP(0,
+				invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 23:
+#line 163 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    deprecate("if BLOCK BLOCK");
+			    yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 24:
+#line 167 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    deprecate("unless BLOCK BLOCK");
+			    yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))),
+						scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 25:
+#line 174 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 26:
+#line 176 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 27:
+#line 180 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 28:
+#line 185 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 29:
+#line 190 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 30:
+#line 195 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); }
+break;
+case 31:
+#line 200 "perly.y"
+{ yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP),
+				yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 32:
+#line 203 "perly.y"
+{ yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 33:
+#line 206 "perly.y"
+{  copline = yyvsp[-8].ival;
+			    yyval.opval = append_elem(OP_LINESEQ,
+				    newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)),
+				    newSTATEOP(0, yyvsp[-9].pval,
+					newWHILEOP(0, 1, (LOOP*)Nullop,
+					    scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); }
+break;
+case 34:
+#line 213 "perly.y"
+{ yyval.opval = newSTATEOP(0,
+				yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop,
+					Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
+break;
+case 35:
+#line 219 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 37:
+#line 224 "perly.y"
+{ (void)scan_num("1"); yyval.opval = yylval.opval; }
+break;
+case 39:
+#line 229 "perly.y"
+{ yyval.pval = Nullch; }
+break;
+case 41:
+#line 234 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 42:
+#line 236 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 43:
+#line 238 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 44:
+#line 240 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 45:
+#line 244 "perly.y"
+{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 46:
+#line 246 "perly.y"
+{ newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); }
+break;
+case 47:
+#line 250 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 48:
+#line 252 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; }
+break;
+case 49:
+#line 256 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 51:
+#line 261 "perly.y"
+{ yyval.ival = start_subparse(); }
+break;
+case 52:
+#line 265 "perly.y"
+{ package(yyvsp[-1].opval); }
+break;
+case 53:
+#line 267 "perly.y"
+{ package(Nullop); }
+break;
+case 54:
+#line 271 "perly.y"
+{ utilize(yyvsp[-4].ival, yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); }
+break;
+case 55:
+#line 275 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 56:
+#line 277 "perly.y"
+{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 58:
+#line 282 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 59:
+#line 284 "perly.y"
+{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 61:
+#line 289 "perly.y"
+{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
+break;
+case 62:
+#line 292 "perly.y"
+{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
+break;
+case 63:
+#line 295 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
+break;
+case 64:
+#line 300 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
+break;
+case 65:
+#line 305 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
+break;
+case 66:
+#line 310 "perly.y"
+{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 67:
+#line 312 "perly.y"
+{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
+break;
+case 68:
+#line 314 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST,
+			      prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval),
+			      yyvsp[-3].opval)); }
+break;
+case 71:
+#line 325 "perly.y"
+{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
+break;
+case 72:
+#line 327 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 73:
+#line 329 "perly.y"
+{   if (yyvsp[-1].ival != OP_REPEAT)
+				scalar(yyvsp[-2].opval);
+			    yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
+break;
+case 74:
+#line 333 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 75:
+#line 335 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 76:
+#line 337 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 77:
+#line 339 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 78:
+#line 341 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 79:
+#line 343 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 80:
+#line 345 "perly.y"
+{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
+break;
+case 81:
+#line 347 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 82:
+#line 349 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 83:
+#line 351 "perly.y"
+{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 84:
+#line 353 "perly.y"
+{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 85:
+#line 356 "perly.y"
+{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
+break;
+case 86:
+#line 358 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 87:
+#line 360 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+break;
+case 88:
+#line 362 "perly.y"
+{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
+break;
+case 89:
+#line 364 "perly.y"
+{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+break;
+case 90:
+#line 366 "perly.y"
+{ yyval.opval = newUNOP(OP_POSTINC, 0,
+					mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
+break;
+case 91:
+#line 369 "perly.y"
+{ yyval.opval = newUNOP(OP_POSTDEC, 0,
+					mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
+break;
+case 92:
+#line 372 "perly.y"
+{ yyval.opval = newUNOP(OP_PREINC, 0,
+					mod(scalar(yyvsp[0].opval), OP_PREINC)); }
+break;
+case 93:
+#line 375 "perly.y"
+{ yyval.opval = newUNOP(OP_PREDEC, 0,
+					mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
+break;
+case 94:
+#line 378 "perly.y"
+{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
+break;
+case 95:
+#line 380 "perly.y"
+{ yyval.opval = sawparens(yyvsp[-1].opval); }
+break;
+case 96:
+#line 382 "perly.y"
+{ yyval.opval = sawparens(newNULLLIST()); }
+break;
+case 97:
+#line 384 "perly.y"
+{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
+break;
+case 98:
+#line 386 "perly.y"
+{ yyval.opval = newANONLIST(Nullop); }
+break;
+case 99:
+#line 388 "perly.y"
+{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
+break;
+case 100:
+#line 390 "perly.y"
+{ yyval.opval = newANONHASH(Nullop); }
+break;
+case 101:
+#line 392 "perly.y"
+{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 102:
+#line 394 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 103:
+#line 396 "perly.y"
+{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
+break;
+case 104:
+#line 398 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 105:
+#line 400 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
+break;
+case 106:
+#line 402 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0,
+					ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
+					scalar(yyvsp[-1].opval));}
+break;
+case 107:
+#line 406 "perly.y"
+{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
+					ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
+					scalar(yyvsp[-1].opval));}
+break;
+case 108:
+#line 410 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 109:
+#line 412 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 110:
+#line 414 "perly.y"
+{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
+break;
+case 111:
+#line 416 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 112:
+#line 419 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0,
+					ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
+					jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 113:
+#line 424 "perly.y"
+{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
+					ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
+					jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 114:
+#line 429 "perly.y"
+{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
+break;
+case 115:
+#line 431 "perly.y"
+{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
+break;
+case 116:
+#line 433 "perly.y"
+{ yyval.opval = prepend_elem(OP_ASLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_ASLICE, 0,
+					list(yyvsp[-1].opval),
+					ref(yyvsp[-3].opval, OP_ASLICE))); }
+break;
+case 117:
+#line 439 "perly.y"
+{ yyval.opval = prepend_elem(OP_HSLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_HSLICE, 0,
+					list(yyvsp[-2].opval),
+					ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)));
+			    expect = XOPERATOR; }
+break;
+case 118:
+#line 446 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 119:
+#line 448 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
+break;
+case 120:
+#line 450 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
+break;
+case 121:
+#line 452 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
+break;
+case 122:
+#line 455 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
+break;
+case 123:
+#line 458 "perly.y"
+{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
+break;
+case 124:
+#line 460 "perly.y"
+{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
+break;
+case 125:
+#line 462 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar(yyvsp[-2].opval)
+				)),Nullop)); dep();}
+break;
+case 126:
+#line 470 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    append_elem(OP_LIST,
+				yyvsp[-1].opval,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar(yyvsp[-3].opval)
+				)))); dep();}
+break;
+case 127:
+#line 479 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
+break;
+case 128:
+#line 483 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				yyvsp[-1].opval,
+				scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
+break;
+case 129:
+#line 488 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
+			    hints |= HINT_BLOCK_SCOPE; }
+break;
+case 130:
+#line 491 "perly.y"
+{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
+break;
+case 131:
+#line 493 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+break;
+case 132:
+#line 495 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+break;
+case 133:
+#line 497 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 134:
+#line 499 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 135:
+#line 501 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
+break;
+case 136:
+#line 504 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+break;
+case 137:
+#line 506 "perly.y"
+{ yyval.opval = newOP(yyvsp[-2].ival, 0); }
+break;
+case 138:
+#line 508 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, 0,
+				scalar(yyvsp[0].opval)); }
+break;
+case 139:
+#line 511 "perly.y"
+{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
+break;
+case 140:
+#line 513 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
+break;
+case 141:
+#line 515 "perly.y"
+{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
+break;
+case 142:
+#line 517 "perly.y"
+{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
+break;
+case 145:
+#line 523 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 146:
+#line 525 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 147:
+#line 529 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 148:
+#line 531 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 149:
+#line 533 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 150:
+#line 537 "perly.y"
+{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
+break;
+case 151:
+#line 541 "perly.y"
+{ yyval.opval = newSVREF(yyvsp[0].opval); }
+break;
+case 152:
+#line 545 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
+break;
+case 153:
+#line 549 "perly.y"
+{ yyval.opval = newHVREF(yyvsp[0].opval); }
+break;
+case 154:
+#line 553 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
+break;
+case 155:
+#line 557 "perly.y"
+{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
+break;
+case 156:
+#line 561 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
+break;
+case 157:
+#line 563 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval);  }
+break;
+case 158:
+#line 565 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 159:
+#line 568 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+#line 2236 "y.tab.c"
+    }
+    yyssp -= yym;
+    yystate = *yyssp;
+    yyvsp -= yym;
+    yym = yylhs[yyn];
+    if (yystate == 0 && yym == 0)
+    {
+#if YYDEBUG
+        if (yydebug)
+            fprintf(stderr,
+		"yydebug: after reduction, shifting from state 0 to state %d\n",
+		YYFINAL);
+#endif
+        yystate = YYFINAL;
+        *++yyssp = YYFINAL;
+        *++yyvsp = yyval;
+        if (yychar < 0)
+        {
+            if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+            if (yydebug)
+            {
+                yys = 0;
+                if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+                if (!yys) yys = "illegal-symbol";
+                fprintf(stderr, "yydebug: state %d, reading %d (%s)\n",
+                        YYFINAL, yychar, yys);
+            }
+#endif
+        }
+        if (yychar == 0) goto yyaccept;
+        goto yyloop;
+    }
+    if ((yyn = yygindex[yym]) && (yyn += yystate) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yystate)
+        yystate = yytable[yyn];
+    else
+        yystate = yydgoto[yym];
+#if YYDEBUG
+    if (yydebug)
+        fprintf(stderr,
+	    "yydebug: after reduction, shifting from state %d to state %d\n",
+	    *yyssp, yystate);
+#endif
+    if (yyssp >= yyss + yystacksize - 1)
+    {
+	/*
+	** reallocate and recover.  Note that pointers
+	** have to be reset, or bad things will happen
+	*/
+	int yyps_index = (yyssp - yyss);
+	int yypv_index = (yyvsp - yyvs);
+	yystacksize += YYSTACKSIZE;
+	ysave->yyvs = yyvs =
+	    (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+	ysave->yyss = yyss =
+	    (short*)realloc((char*)yyss,yystacksize * sizeof(short));
+	if (!yyvs || !yyss)
+	    goto yyoverflow;
+	yyssp = yyss + yyps_index;
+	yyvsp = yyvs + yypv_index;
+    }
+    *++yyssp = yystate;
+    *++yyvsp = yyval;
+    goto yyloop;
+yyoverflow:
+    yyerror("Out of memory for yacc stack");
+yyabort:
+    retval = 1;
+yyaccept:
+    return retval;
+}
diff --git a/gnu/usr.bin/perl/perly.c.diff b/gnu/usr.bin/perl/perly.c.diff
new file mode 100644
index 00000000000..3b3c04ecf88
--- /dev/null
+++ b/gnu/usr.bin/perl/perly.c.diff
@@ -0,0 +1,423 @@
+*** perly.c.orig	Wed Feb 14 15:29:04 1996
+--- perly.c	Wed Feb 14 15:29:05 1996
+***************
+*** 12,82 ****
+      deprecate("\"do\" to call subroutines");
+  }
+  
+- #line 29 "perly.y"
+- typedef union {
+-     I32	ival;
+-     char *pval;
+-     OP *opval;
+-     GV *gvval;
+- } YYSTYPE;
+- #line 23 "y.tab.c"
+- #define WORD 257
+- #define METHOD 258
+- #define FUNCMETH 259
+- #define THING 260
+- #define PMFUNC 261
+- #define PRIVATEREF 262
+- #define FUNC0SUB 263
+- #define UNIOPSUB 264
+- #define LSTOPSUB 265
+- #define LABEL 266
+- #define FORMAT 267
+- #define SUB 268
+- #define ANONSUB 269
+- #define PACKAGE 270
+- #define USE 271
+- #define WHILE 272
+- #define UNTIL 273
+- #define IF 274
+- #define UNLESS 275
+- #define ELSE 276
+- #define ELSIF 277
+- #define CONTINUE 278
+- #define FOR 279
+- #define LOOPEX 280
+- #define DOTDOT 281
+- #define FUNC0 282
+- #define FUNC1 283
+- #define FUNC 284
+- #define RELOP 285
+- #define EQOP 286
+- #define MULOP 287
+- #define ADDOP 288
+- #define DOLSHARP 289
+- #define DO 290
+- #define LOCAL 291
+- #define HASHBRACK 292
+- #define NOAMP 293
+- #define OROP 294
+- #define ANDOP 295
+- #define NOTOP 296
+- #define LSTOP 297
+- #define ASSIGNOP 298
+- #define OROR 299
+- #define ANDAND 300
+- #define BITOROP 301
+- #define BITANDOP 302
+- #define UNIOP 303
+- #define SHIFTOP 304
+- #define MATCHOP 305
+- #define UMINUS 306
+- #define REFGEN 307
+- #define POWOP 308
+- #define PREINC 309
+- #define PREDEC 310
+- #define POSTINC 311
+- #define POSTDEC 312
+- #define ARROW 313
+  #define YYERRCODE 256
+  short yylhs[] = {                                        -1,
+     31,    0,    5,    3,    6,    6,    6,    7,    7,    7,
+--- 12,17 ----
+***************
+*** 1381,1393 ****
+  int yynerrs;
+  int yyerrflag;
+  int yychar;
+- short *yyssp;
+- YYSTYPE *yyvsp;
+  YYSTYPE yyval;
+  YYSTYPE yylval;
+- short yyss[YYSTACKSIZE];
+- YYSTYPE yyvs[YYSTACKSIZE];
+- #define yystacksize YYSTACKSIZE
+  #line 571 "perly.y"
+   /* PROGRAM */
+  #line 1394 "y.tab.c"
+--- 1316,1323 ----
+***************
+*** 1394,1407 ****
+--- 1324,1382 ----
+  #define YYABORT goto yyabort
+  #define YYACCEPT goto yyaccept
+  #define YYERROR goto yyerrlab
++ 
++ struct ysv {
++     short* yyss;
++     YYSTYPE* yyvs;
++     int oldyydebug;
++     int oldyynerrs;
++     int oldyyerrflag;
++     int oldyychar;
++     YYSTYPE oldyyval;
++     YYSTYPE oldyylval;
++ };
++ 
++ void
++ yydestruct(ptr)
++ void* ptr;
++ {
++     struct ysv* ysave = (struct ysv*)ptr;
++     if (ysave->yyss) Safefree(ysave->yyss);
++     if (ysave->yyvs) Safefree(ysave->yyvs);
++     yydebug	= ysave->oldyydebug;
++     yynerrs	= ysave->oldyynerrs;
++     yyerrflag	= ysave->oldyyerrflag;
++     yychar	= ysave->oldyychar;
++     yyval	= ysave->oldyyval;
++     yylval	= ysave->oldyylval;
++     Safefree(ysave);
++ }
++ 
+  int
+  yyparse()
+  {
+      register int yym, yyn, yystate;
++     register short *yyssp;
++     register YYSTYPE *yyvsp;
++     short* yyss;
++     YYSTYPE* yyvs;
++     unsigned yystacksize = YYSTACKSIZE;
++     int retval = 0;
+  #if YYDEBUG
+      register char *yys;
+      extern char *getenv();
++ #endif
+  
++     struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
++     SAVEDESTRUCTOR(yydestruct, ysave);
++     ysave->oldyydebug	= yydebug;
++     ysave->oldyynerrs	= yynerrs;
++     ysave->oldyyerrflag	= yyerrflag;
++     ysave->oldyychar	= yychar;
++     ysave->oldyyval	= yyval;
++     ysave->oldyylval	= yylval;
++ 
++ #if YYDEBUG
+      if (yys = getenv("YYDEBUG"))
+      {
+          yyn = *yys;
+***************
+*** 1414,1419 ****
+--- 1389,1402 ----
+      yyerrflag = 0;
+      yychar = (-1);
+  
++     /*
++     ** Initialize private stacks (yyparse may be called from an action)
++     */
++     ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
++     ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
++     if (!yyvs || !yyss)
++ 	goto yyoverflow;
++ 
+      yyssp = yyss;
+      yyvsp = yyvs;
+      *yyssp = yystate = 0;
+***************
+*** 1429,1435 ****
+              yys = 0;
+              if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+              if (!yys) yys = "illegal-symbol";
+!             printf("yydebug: state %d, reading %d (%s)\n", yystate,
+                      yychar, yys);
+          }
+  #endif
+--- 1412,1418 ----
+              yys = 0;
+              if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+              if (!yys) yys = "illegal-symbol";
+!             fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate,
+                      yychar, yys);
+          }
+  #endif
+***************
+*** 1439,1450 ****
+      {
+  #if YYDEBUG
+          if (yydebug)
+!             printf("yydebug: state %d, shifting to state %d\n",
+                      yystate, yytable[yyn]);
+  #endif
+          if (yyssp >= yyss + yystacksize - 1)
+          {
+!             goto yyoverflow;
+          }
+          *++yyssp = yystate = yytable[yyn];
+          *++yyvsp = yylval;
+--- 1422,1447 ----
+      {
+  #if YYDEBUG
+          if (yydebug)
+!             fprintf(stderr, "yydebug: state %d, shifting to state %d\n",
+                      yystate, yytable[yyn]);
+  #endif
+          if (yyssp >= yyss + yystacksize - 1)
+          {
+! 	    /*
+! 	    ** reallocate and recover.  Note that pointers
+! 	    ** have to be reset, or bad things will happen
+! 	    */
+! 	    int yyps_index = (yyssp - yyss);
+! 	    int yypv_index = (yyvsp - yyvs);
+! 	    yystacksize += YYSTACKSIZE;
+! 	    ysave->yyvs = yyvs =
+! 		(YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+! 	    ysave->yyss = yyss =
+! 		(short*)realloc((char*)yyss,yystacksize * sizeof(short));
+! 	    if (!yyvs || !yyss)
+! 		goto yyoverflow;
+! 	    yyssp = yyss + yyps_index;
+! 	    yyvsp = yyvs + yypv_index;
+          }
+          *++yyssp = yystate = yytable[yyn];
+          *++yyvsp = yylval;
+***************
+*** 1480,1491 ****
+              {
+  #if YYDEBUG
+                  if (yydebug)
+!                     printf("yydebug: state %d, error recovery shifting\
+!  to state %d\n", *yyssp, yytable[yyn]);
+  #endif
+                  if (yyssp >= yyss + yystacksize - 1)
+                  {
+!                     goto yyoverflow;
+                  }
+                  *++yyssp = yystate = yytable[yyn];
+                  *++yyvsp = yylval;
+--- 1477,1503 ----
+              {
+  #if YYDEBUG
+                  if (yydebug)
+!                     fprintf(stderr,
+! 		     "yydebug: state %d, error recovery shifting to state %d\n",
+! 		     *yyssp, yytable[yyn]);
+  #endif
+                  if (yyssp >= yyss + yystacksize - 1)
+                  {
+! 		    /*
+! 		    ** reallocate and recover.  Note that pointers
+! 		    ** have to be reset, or bad things will happen
+! 		    */
+! 		    int yyps_index = (yyssp - yyss);
+! 		    int yypv_index = (yyvsp - yyvs);
+! 		    yystacksize += YYSTACKSIZE;
+! 		    ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
+! 			yystacksize * sizeof(YYSTYPE));
+! 		    ysave->yyss = yyss = (short*)realloc((char*)yyss,
+! 			yystacksize * sizeof(short));
+! 		    if (!yyvs || !yyss)
+! 			goto yyoverflow;
+! 		    yyssp = yyss + yyps_index;
+! 		    yyvsp = yyvs + yypv_index;
+                  }
+                  *++yyssp = yystate = yytable[yyn];
+                  *++yyvsp = yylval;
+***************
+*** 1495,1502 ****
+              {
+  #if YYDEBUG
+                  if (yydebug)
+!                     printf("yydebug: error recovery discarding state %d\n",
+!                             *yyssp);
+  #endif
+                  if (yyssp <= yyss) goto yyabort;
+                  --yyssp;
+--- 1507,1515 ----
+              {
+  #if YYDEBUG
+                  if (yydebug)
+!                     fprintf(stderr,
+! 			"yydebug: error recovery discarding state %d\n",
+! 			*yyssp);
+  #endif
+                  if (yyssp <= yyss) goto yyabort;
+                  --yyssp;
+***************
+*** 1513,1520 ****
+              yys = 0;
+              if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+              if (!yys) yys = "illegal-symbol";
+!             printf("yydebug: state %d, error recovery discards token %d (%s)\n",
+!                     yystate, yychar, yys);
+          }
+  #endif
+          yychar = (-1);
+--- 1526,1534 ----
+              yys = 0;
+              if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+              if (!yys) yys = "illegal-symbol";
+!             fprintf(stderr,
+! 		"yydebug: state %d, error recovery discards token %d (%s)\n",
+! 		yystate, yychar, yys);
+          }
+  #endif
+          yychar = (-1);
+***************
+*** 1523,1529 ****
+  yyreduce:
+  #if YYDEBUG
+      if (yydebug)
+!         printf("yydebug: state %d, reducing by rule %d (%s)\n",
+                  yystate, yyn, yyrule[yyn]);
+  #endif
+      yym = yylen[yyn];
+--- 1537,1543 ----
+  yyreduce:
+  #if YYDEBUG
+      if (yydebug)
+!         fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n",
+                  yystate, yyn, yyrule[yyn]);
+  #endif
+      yym = yylen[yyn];
+***************
+*** 2242,2249 ****
+      {
+  #if YYDEBUG
+          if (yydebug)
+!             printf("yydebug: after reduction, shifting from state 0 to\
+!  state %d\n", YYFINAL);
+  #endif
+          yystate = YYFINAL;
+          *++yyssp = YYFINAL;
+--- 2256,2264 ----
+      {
+  #if YYDEBUG
+          if (yydebug)
+!             fprintf(stderr,
+! 		"yydebug: after reduction, shifting from state 0 to state %d\n",
+! 		YYFINAL);
+  #endif
+          yystate = YYFINAL;
+          *++yyssp = YYFINAL;
+***************
+*** 2257,2263 ****
+                  yys = 0;
+                  if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+                  if (!yys) yys = "illegal-symbol";
+!                 printf("yydebug: state %d, reading %d (%s)\n",
+                          YYFINAL, yychar, yys);
+              }
+  #endif
+--- 2272,2278 ----
+                  yys = 0;
+                  if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+                  if (!yys) yys = "illegal-symbol";
+!                 fprintf(stderr, "yydebug: state %d, reading %d (%s)\n",
+                          YYFINAL, yychar, yys);
+              }
+  #endif
+***************
+*** 2272,2291 ****
+          yystate = yydgoto[yym];
+  #if YYDEBUG
+      if (yydebug)
+!         printf("yydebug: after reduction, shifting from state %d \
+! to state %d\n", *yyssp, yystate);
+  #endif
+      if (yyssp >= yyss + yystacksize - 1)
+      {
+!         goto yyoverflow;
+      }
+      *++yyssp = yystate;
+      *++yyvsp = yyval;
+      goto yyloop;
+  yyoverflow:
+!     yyerror("yacc stack overflow");
+  yyabort:
+!     return (1);
+  yyaccept:
+!     return (0);
+  }
+--- 2287,2321 ----
+          yystate = yydgoto[yym];
+  #if YYDEBUG
+      if (yydebug)
+!         fprintf(stderr,
+! 	    "yydebug: after reduction, shifting from state %d to state %d\n",
+! 	    *yyssp, yystate);
+  #endif
+      if (yyssp >= yyss + yystacksize - 1)
+      {
+! 	/*
+! 	** reallocate and recover.  Note that pointers
+! 	** have to be reset, or bad things will happen
+! 	*/
+! 	int yyps_index = (yyssp - yyss);
+! 	int yypv_index = (yyvsp - yyvs);
+! 	yystacksize += YYSTACKSIZE;
+! 	ysave->yyvs = yyvs =
+! 	    (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+! 	ysave->yyss = yyss =
+! 	    (short*)realloc((char*)yyss,yystacksize * sizeof(short));
+! 	if (!yyvs || !yyss)
+! 	    goto yyoverflow;
+! 	yyssp = yyss + yyps_index;
+! 	yyvsp = yyvs + yypv_index;
+      }
+      *++yyssp = yystate;
+      *++yyvsp = yyval;
+      goto yyloop;
+  yyoverflow:
+!     yyerror("Out of memory for yacc stack");
+  yyabort:
+!     retval = 1;
+  yyaccept:
+!     return retval;
+  }
diff --git a/gnu/usr.bin/perl/perly.fixer b/gnu/usr.bin/perl/perly.fixer
new file mode 100644
index 00000000000..98296a72fd2
--- /dev/null
+++ b/gnu/usr.bin/perl/perly.fixer
@@ -0,0 +1,188 @@
+#!/bin/sh
+
+# Fix up yacc output to allow dynamic allocation.  Since perly.c
+# is now provided with the perl source, this should not be necessary.
+#  
+# However, if the user wishes to use byacc, or wishes to try another 
+# compiler compiler (e.g. bison or yacc), this script will get run.
+#
+# Currently, only byacc version 1.8 is supported.
+#
+#  Hacks to make it work with Interactive's SysVr3 Version 2.2
+#   doughera@lafvax.lafayette.edu (Andy Dougherty)   3/23/91
+#
+# Additional information to make the BSD section work with SunOS 4.0.2
+#   tdinger@East.Sun.COM (Tom Dinger)	4/15/1991
+
+input=$1
+output=$2
+tmp=/tmp/f$$
+
+if grep 'yaccpar 1.8 (Berkeley)' $input >/dev/null 2>&1; then
+    cp $input $output
+    if test -f perly.c.diff; then
+	patch -F3 $output <perly.c.diff
+	rm -rf $input
+    fi
+    exit
+elif grep 'yaccpar	1.9 (Berkeley)' $input >/dev/null 2>&1; then
+    if test -f perly.c.dif9; then
+	patch -F3 $output <perly.c.dif9
+	rm -rf $input
+	exit 0
+    else
+	echo "Diffs from byacc-1.9 are not available."
+	echo "If you wish to proceed anyway, do"
+	echo "cp $input $output"
+	echo "cp y.tab.h perly.h"
+	echo "and re-run make. Otherwise, I will use the old perly.c"
+	touch perly.c
+	# Exit with error status to stop make.
+	exit 1
+    fi
+fi
+
+plan="unknown"
+
+# Below, we check for various yaccpar outputs.
+
+#  Test for BSD 4.3 version.
+#  Also tests for the SunOS 4.0.2 version
+egrep 'YYSTYPE[ 	]*yyv\[ *YYMAXDEPTH *\];
+short[  ]*yys\[ *YYMAXDEPTH *\] *;
+yyps *= *&yys\[ *-1 *\];
+yypv *= *&yyv\[ *-1 *\];
+if *\( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp 2>/dev/null
+
+set `wc -l $tmp`
+if test "$1" = "5"; then
+      plan="bsd43"
+fi
+
+if test "$plan" = "unknown"; then
+    #   Test for ISC 2.2 version (probably generic SysVr3).
+egrep 'YYSTYPE[ 	]*yyv\[ *YYMAXDEPTH *\];
+int[    ]*yys\[ *YYMAXDEPTH *\] *;
+yyps *= *&yys\[ *-1 *\];
+yypv *= *&yyv\[ *-1 *\];
+if *\( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp 2>/dev/null
+
+    set `wc -l $tmp`
+    if test "$1" = "5"; then
+	plan="isc"
+    fi
+fi
+
+case "$plan" in
+    ##################################################################
+    # The SunOS 4.0.2 version has the comparison fixed already.
+    # Also added are out of memory checks (makes porting the generated
+    # code easier) For most systems, it can't hurt. -- TD
+    "bsd43")
+	echo "Patching perly.c to allow dynamic yacc stack allocation"
+	echo "Assuming bsd4.3 yaccpar"
+	cat >$tmp <<'END'
+/YYSTYPE[ 	]*yyv\[ *YYMAXDEPTH *\];/c\
+int yymaxdepth = YYMAXDEPTH;\
+YYSTYPE *yyv; /* where the values are stored */\
+short *yys;\
+short *maxyyps;
+
+/short[ 	]*yys\[ *YYMAXDEPTH *\] *;/d
+
+/yyps *= *&yys\[ *-1 *\];/d
+
+/yypv *= *&yyv\[ *-1 *\];/c\
+\	if (!yyv) {\
+\	    yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
+\	    yys = (short*) safemalloc(yymaxdepth * sizeof(short));\
+\	    if ( !yyv || !yys ) {\
+\		yyerror( "out of memory" );\
+\		return(1);\
+\	    }\
+\	    maxyyps = &yys[yymaxdepth];\
+\	}\
+\	yyps = &yys[-1];\
+\	yypv = &yyv[-1];
+
+
+/if *( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *)/c\
+\		if( ++yyps >= maxyyps ) {\
+\		    int tv = yypv - yyv;\
+\		    int ts = yyps - yys;\
+\
+\		    yymaxdepth *= 2;\
+\		    yyv = (YYSTYPE*)realloc((char*)yyv,\
+\		      yymaxdepth*sizeof(YYSTYPE));\
+\		    yys = (short*)realloc((char*)yys,\
+\		      yymaxdepth*sizeof(short));\
+\		    if ( !yyv || !yys ) {\
+\			yyerror( "yacc stack overflow" );\
+\			return(1);\
+\		    }\
+\		    yyps = yys + ts;\
+\		    yypv = yyv + tv;\
+\		    maxyyps = &yys[yymaxdepth];\
+\		}
+
+/yacc stack overflow.*}/d
+/yacc stack overflow/,/}/d
+END
+	sed -f $tmp <$input >$output ;;
+
+    #######################################################
+    "isc") # Interactive Systems 2.2  version
+	echo "Patching perly.c to allow dynamic yacc stack allocation"
+	echo "Assuming Interactive SysVr3 2.2 yaccpar"
+	# Easier to simply put whole script here than to modify the
+	# bsd script with sed.
+	# Main changes:  yaccpar sometimes uses yy_ps and yy_pv
+	# which are local register variables.
+	#  if(++yyps > YYMAXDEPTH) had opening brace on next line.
+	# I've kept that brace in along with a call to yyerror if
+	# realloc fails. (Actually, I just don't know how to do
+	# multi-line matches in sed.)
+	cat > $tmp << 'END'
+/YYSTYPE[ 	]*yyv\[ *YYMAXDEPTH *\];/c\
+int yymaxdepth = YYMAXDEPTH;\
+YYSTYPE *yyv; /* where the values are stored */\
+int *yys;\
+int *maxyyps;
+
+/int[ 	]*yys\[ *YYMAXDEPTH *\] *;/d
+
+/yyps *= *&yys\[ *-1 *\];/d
+
+/yypv *= *&yyv\[ *-1 *\];/c\
+\	if (!yyv) {\
+\	    yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
+\	    yys = (int*) safemalloc(yymaxdepth * sizeof(int));\
+\	    maxyyps = &yys[yymaxdepth];\
+\	}\
+\	yyps = &yys[-1];\
+\	yypv = &yyv[-1];
+
+/if *( *\+\+yy_ps *>= *&yys\[ *YYMAXDEPTH *\] *)/c\
+\		if( ++yy_ps >= maxyyps ) {\
+\		    int tv = yy_pv - yyv;\
+\		    int ts = yy_ps - yys;\
+\
+\		    yymaxdepth *= 2;\
+\		    yyv = (YYSTYPE*)realloc((char*)yyv,\
+\		      yymaxdepth*sizeof(YYSTYPE));\
+\		    yys = (int*)realloc((char*)yys,\
+\		      yymaxdepth*sizeof(int));\
+\		    yy_ps = yyps = yys + ts;\
+\		    yy_pv = yypv = yyv + tv;\
+\		    maxyyps = &yys[yymaxdepth];\
+\		}\
+\		if (yyv == NULL || yys == NULL)
+END
+	sed -f $tmp < $input > $output ;;
+
+    ######################################################
+    # Plan still unknown
+    *) sed -e 's/Received token/ *** Received token/' $input >$output;
+esac
+
+rm -rf $tmp $input
diff --git a/gnu/usr.bin/perl/perly.h b/gnu/usr.bin/perl/perly.h
new file mode 100644
index 00000000000..56eaf7e2a46
--- /dev/null
+++ b/gnu/usr.bin/perl/perly.h
@@ -0,0 +1,65 @@
+#define WORD 257
+#define METHOD 258
+#define FUNCMETH 259
+#define THING 260
+#define PMFUNC 261
+#define PRIVATEREF 262
+#define FUNC0SUB 263
+#define UNIOPSUB 264
+#define LSTOPSUB 265
+#define LABEL 266
+#define FORMAT 267
+#define SUB 268
+#define ANONSUB 269
+#define PACKAGE 270
+#define USE 271
+#define WHILE 272
+#define UNTIL 273
+#define IF 274
+#define UNLESS 275
+#define ELSE 276
+#define ELSIF 277
+#define CONTINUE 278
+#define FOR 279
+#define LOOPEX 280
+#define DOTDOT 281
+#define FUNC0 282
+#define FUNC1 283
+#define FUNC 284
+#define RELOP 285
+#define EQOP 286
+#define MULOP 287
+#define ADDOP 288
+#define DOLSHARP 289
+#define DO 290
+#define LOCAL 291
+#define HASHBRACK 292
+#define NOAMP 293
+#define OROP 294
+#define ANDOP 295
+#define NOTOP 296
+#define LSTOP 297
+#define ASSIGNOP 298
+#define OROR 299
+#define ANDAND 300
+#define BITOROP 301
+#define BITANDOP 302
+#define UNIOP 303
+#define SHIFTOP 304
+#define MATCHOP 305
+#define UMINUS 306
+#define REFGEN 307
+#define POWOP 308
+#define PREINC 309
+#define PREDEC 310
+#define POSTINC 311
+#define POSTDEC 312
+#define ARROW 313
+typedef union {
+    I32	ival;
+    char *pval;
+    OP *opval;
+    GV *gvval;
+} YYSTYPE;
+extern YYSTYPE yylval;
+extern YYSTYPE yylval;
diff --git a/gnu/usr.bin/perl/perly.y b/gnu/usr.bin/perl/perly.y
new file mode 100644
index 00000000000..96a35e1c0ec
--- /dev/null
+++ b/gnu/usr.bin/perl/perly.y
@@ -0,0 +1,571 @@
+/*    perly.y
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * 'I see,' laughed Strider.  'I look foul and feel fair.  Is that it?
+ * All that is gold does not glitter, not all those that wander are lost.'
+ */
+
+%{
+#include "EXTERN.h"
+#include "perl.h"
+
+static void
+dep()
+{
+    deprecate("\"do\" to call subroutines");
+}
+
+%}
+
+%start prog
+
+%union {
+    I32	ival;
+    char *pval;
+    OP *opval;
+    GV *gvval;
+}
+
+%token <ival> '{' ')'
+
+%token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
+%token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
+%token <pval> LABEL
+%token <ival> FORMAT SUB ANONSUB PACKAGE USE
+%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
+%token <ival> LOOPEX DOTDOT
+%token <ival> FUNC0 FUNC1 FUNC
+%token <ival> RELOP EQOP MULOP ADDOP
+%token <ival> DOLSHARP DO LOCAL HASHBRACK NOAMP
+
+%type <ival> prog decl format remember startsub '&'
+%type <opval> block lineseq line loop cond nexpr else argexpr
+%type <opval> expr term scalar ary hsh arylen star amper sideff
+%type <opval> listexpr listexprcom indirob
+%type <opval> texpr listop method proto
+%type <pval> label
+%type <opval> cont
+
+%left <ival> OROP
+%left ANDOP
+%right NOTOP
+%nonassoc <ival> LSTOP
+%left ','
+%right <ival> ASSIGNOP
+%right '?' ':'
+%nonassoc DOTDOT
+%left OROR
+%left ANDAND
+%left <ival> BITOROP
+%left <ival> BITANDOP
+%nonassoc EQOP
+%nonassoc RELOP
+%nonassoc <ival> UNIOP
+%left <ival> SHIFTOP
+%left ADDOP
+%left MULOP
+%left <ival> MATCHOP
+%right '!' '~' UMINUS REFGEN
+%right <ival> POWOP
+%nonassoc PREINC PREDEC POSTINC POSTDEC
+%left ARROW
+%left '('
+
+%% /* RULES */
+
+prog	:	/* NULL */
+		{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (debug & 1);
+#endif
+		    expect = XSTATE;
+		}
+	/*CONTINUED*/	lineseq
+			{ newPROG($2); }
+	;
+
+block	:	'{' remember lineseq '}'
+			{ $$ = block_end($1,$2,$3); }
+	;
+
+remember:	/* NULL */	/* start a lexical scope */
+			{ $$ = block_start(); }
+	;
+
+lineseq	:	/* NULL */
+			{ $$ = Nullop; }
+	|	lineseq decl
+			{ $$ = $1; }
+	|	lineseq line
+			{   $$ = append_list(OP_LINESEQ,
+				(LISTOP*)$1, (LISTOP*)$2);
+			    pad_reset_pending = TRUE;
+			    if ($1 && $2) hints |= HINT_BLOCK_SCOPE; }
+	;
+
+line	:	label cond
+			{ $$ = newSTATEOP(0, $1, $2); }
+	|	loop	/* loops add their own labels */
+	|	label ';'
+			{ if ($1 != Nullch) {
+			      $$ = newSTATEOP(0, $1, newOP(OP_NULL, 0));
+			    }
+			    else {
+			      $$ = Nullop;
+			      copline = NOLINE;
+			    }
+			    expect = XSTATE; }
+	|	label sideff ';'
+			{ $$ = newSTATEOP(0, $1, $2);
+			  expect = XSTATE; }
+	;
+
+sideff	:	error
+			{ $$ = Nullop; }
+	|	expr
+			{ $$ = $1; }
+	|	expr IF expr
+			{ $$ = newLOGOP(OP_AND, 0, $3, $1); }
+	|	expr UNLESS expr
+			{ $$ = newLOGOP(OP_OR, 0, $3, $1); }
+	|	expr WHILE expr
+			{ $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
+	|	expr UNTIL expr
+			{ $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);}
+	;
+
+else	:	/* NULL */
+			{ $$ = Nullop; }
+	|	ELSE block
+			{ $$ = scope($2); }
+	|	ELSIF '(' expr ')' block else
+			{ copline = $1;
+			    $$ = newSTATEOP(0, 0,
+				newCONDOP(0, $3, scope($5), $6));
+			    hints |= HINT_BLOCK_SCOPE; }
+	;
+
+cond	:	IF '(' expr ')' block else
+			{ copline = $1;
+			    $$ = newCONDOP(0, $3, scope($5), $6); }
+	|	UNLESS '(' expr ')' block else
+			{ copline = $1;
+			    $$ = newCONDOP(0,
+				invert(scalar($3)), scope($5), $6); }
+	|	IF block block else
+			{ copline = $1;
+			    deprecate("if BLOCK BLOCK");
+			    $$ = newCONDOP(0, scope($2), scope($3), $4); }
+	|	UNLESS block block else
+			{ copline = $1;
+			    deprecate("unless BLOCK BLOCK");
+			    $$ = newCONDOP(0, invert(scalar(scope($2))),
+						scope($3), $4); }
+	;
+
+cont	:	/* NULL */
+			{ $$ = Nullop; }
+	|	CONTINUE block
+			{ $$ = scope($2); }
+	;
+
+loop	:	label WHILE '(' texpr ')' block cont
+			{ copline = $2;
+			    $$ = newSTATEOP(0, $1,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					$4, $6, $7) ); }
+	|	label UNTIL '(' expr ')' block cont
+			{ copline = $2;
+			    $$ = newSTATEOP(0, $1,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar($4)), $6, $7) ); }
+	|	label WHILE block block cont
+			{ copline = $2;
+			    $$ = newSTATEOP(0, $1,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					scope($3), $4, $5) ); }
+	|	label UNTIL block block cont
+			{ copline = $2;
+			    $$ = newSTATEOP(0, $1,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar(scope($3))), $4, $5)); }
+	|	label FOR scalar '(' expr ')' block cont
+			{ $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+				$5, $7, $8); }
+	|	label FOR '(' expr ')' block cont
+			{ $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); }
+	|	label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+			/* basically fake up an initialize-while lineseq */
+			{  copline = $2;
+			    $$ = append_elem(OP_LINESEQ,
+				    newSTATEOP(0, $1, scalar($4)),
+				    newSTATEOP(0, $1,
+					newWHILEOP(0, 1, (LOOP*)Nullop,
+					    scalar($6), $10, scalar($8)) )); }
+	|	label block cont  /* a block is a loop that happens once */
+			{ $$ = newSTATEOP(0,
+				$1, newWHILEOP(0, 1, (LOOP*)Nullop,
+					Nullop, $2, $3)); }
+	;
+
+nexpr	:	/* NULL */
+			{ $$ = Nullop; }
+	|	sideff
+	;
+
+texpr	:	/* NULL means true */
+			{ (void)scan_num("1"); $$ = yylval.opval; }
+	|	expr
+	;
+
+label	:	/* empty */
+			{ $$ = Nullch; }
+	|	LABEL
+	;
+
+decl	:	format
+			{ $$ = 0; }
+	|	subrout
+			{ $$ = 0; }
+	|	package
+			{ $$ = 0; }
+	|	use
+			{ $$ = 0; }
+	;
+
+format	:	FORMAT startsub WORD block
+			{ newFORM($2, $3, $4); }
+	|	FORMAT startsub block
+			{ newFORM($2, Nullop, $3); }
+	;
+
+subrout	:	SUB startsub WORD proto block
+			{ newSUB($2, $3, $4, $5); }
+	|	SUB startsub WORD proto ';'
+			{ newSUB($2, $3, $4, Nullop); expect = XSTATE; }
+	;
+
+proto	:	/* NULL */
+			{ $$ = Nullop; }
+	|	THING
+	;
+		
+startsub:	/* NULL */	/* start a subroutine scope */
+			{ $$ = start_subparse(); }
+	;
+
+package :	PACKAGE WORD ';'
+			{ package($2); }
+	|	PACKAGE ';'
+			{ package(Nullop); }
+	;
+
+use	:	USE startsub WORD listexpr ';'
+			{ utilize($1, $2, $3, $4); }
+	;
+
+expr	:	expr ANDOP expr
+			{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
+	|	expr OROP expr
+			{ $$ = newLOGOP($2, 0, $1, $3); }
+	|	argexpr
+	;
+
+argexpr	:	argexpr ','
+			{ $$ = $1; }
+	|	argexpr ',' term
+			{ $$ = append_elem(OP_LIST, $1, $3); }
+	|	term
+	;
+
+listop	:	LSTOP indirob argexpr
+			{ $$ = convert($1, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); }
+	|	FUNC '(' indirob expr ')'
+			{ $$ = convert($1, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); }
+	|	term ARROW method '(' listexprcom ')'
+			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, $1, $5),
+				    newUNOP(OP_METHOD, 0, $3))); }
+	|	METHOD indirob listexpr
+			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, $2, $3),
+				    newUNOP(OP_METHOD, 0, $1))); }
+	|	FUNCMETH indirob '(' listexprcom ')'
+			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, $2, $4),
+				    newUNOP(OP_METHOD, 0, $1))); }
+	|	LSTOP listexpr
+			{ $$ = convert($1, 0, $2); }
+	|	FUNC '(' listexprcom ')'
+			{ $$ = convert($1, 0, $3); }
+	|	LSTOPSUB startsub block listexpr	%prec LSTOP
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST,
+			      prepend_elem(OP_LIST, newANONSUB($2, 0, $3), $4),
+			      $1)); }
+	;
+
+method	:	METHOD
+	|	scalar
+	;
+
+term	:	term ASSIGNOP term
+			{ $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); }
+	|	term POWOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term MULOP term
+			{   if ($2 != OP_REPEAT)
+				scalar($1);
+			    $$ = newBINOP($2, 0, $1, scalar($3)); }
+	|	term ADDOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term SHIFTOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term RELOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term EQOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term BITANDOP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term BITOROP term
+			{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+	|	term DOTDOT term
+			{ $$ = newRANGE($2, scalar($1), scalar($3));}
+	|	term ANDAND term
+			{ $$ = newLOGOP(OP_AND, 0, $1, $3); }
+	|	term OROR term
+			{ $$ = newLOGOP(OP_OR, 0, $1, $3); }
+	|	term '?' term ':' term
+			{ $$ = newCONDOP(0, $1, $3, $5); }
+	|	term MATCHOP term
+			{ $$ = bind_match($2, $1, $3); }
+
+	|	'-' term %prec UMINUS
+			{ $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
+	|	'+' term %prec UMINUS
+			{ $$ = $2; }
+	|	'!' term
+			{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
+	|	'~' term
+			{ $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
+	|	REFGEN term
+			{ $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); }
+	|	term POSTINC
+			{ $$ = newUNOP(OP_POSTINC, 0,
+					mod(scalar($1), OP_POSTINC)); }
+	|	term POSTDEC
+			{ $$ = newUNOP(OP_POSTDEC, 0,
+					mod(scalar($1), OP_POSTDEC)); }
+	|	PREINC term
+			{ $$ = newUNOP(OP_PREINC, 0,
+					mod(scalar($2), OP_PREINC)); }
+	|	PREDEC term
+			{ $$ = newUNOP(OP_PREDEC, 0,
+					mod(scalar($2), OP_PREDEC)); }
+	|	LOCAL term	%prec UNIOP
+			{ $$ = localize($2,$1); }
+	|	'(' expr ')'
+			{ $$ = sawparens($2); }
+	|	'(' ')'
+			{ $$ = sawparens(newNULLLIST()); }
+	|	'[' expr ']'				%prec '('
+			{ $$ = newANONLIST($2); }
+	|	'[' ']'					%prec '('
+			{ $$ = newANONLIST(Nullop); }
+	|	HASHBRACK expr ';' '}'			%prec '('
+			{ $$ = newANONHASH($2); }
+	|	HASHBRACK ';' '}'				%prec '('
+			{ $$ = newANONHASH(Nullop); }
+	|	ANONSUB startsub proto block			%prec '('
+			{ $$ = newANONSUB($2, $3, $4); }
+	|	scalar	%prec '('
+			{ $$ = $1; }
+	|	star '{' expr ';' '}'
+			{ $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
+	|	star	%prec '('
+			{ $$ = $1; }
+	|	scalar '[' expr ']'	%prec '('
+			{ $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
+	|	term ARROW '[' expr ']'	%prec '('
+			{ $$ = newBINOP(OP_AELEM, 0,
+					ref(newAVREF($1),OP_RV2AV),
+					scalar($4));}
+	|	term '[' expr ']'	%prec '('
+			{ assertref($1); $$ = newBINOP(OP_AELEM, 0,
+					ref(newAVREF($1),OP_RV2AV),
+					scalar($3));}
+	|	hsh 	%prec '('
+			{ $$ = $1; }
+	|	ary 	%prec '('
+			{ $$ = $1; }
+	|	arylen 	%prec '('
+			{ $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
+	|	scalar '{' expr ';' '}'	%prec '('
+			{ $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
+			    expect = XOPERATOR; }
+	|	term ARROW '{' expr ';' '}'	%prec '('
+			{ $$ = newBINOP(OP_HELEM, 0,
+					ref(newHVREF($1),OP_RV2HV),
+					jmaybe($4));
+			    expect = XOPERATOR; }
+	|	term '{' expr ';' '}'	%prec '('
+			{ assertref($1); $$ = newBINOP(OP_HELEM, 0,
+					ref(newHVREF($1),OP_RV2HV),
+					jmaybe($3));
+			    expect = XOPERATOR; }
+	|	'(' expr ')' '[' expr ']'	%prec '('
+			{ $$ = newSLICEOP(0, $5, $2); }
+	|	'(' ')' '[' expr ']'	%prec '('
+			{ $$ = newSLICEOP(0, $4, Nullop); }
+	|	ary '[' expr ']'	%prec '('
+			{ $$ = prepend_elem(OP_ASLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_ASLICE, 0,
+					list($3),
+					ref($1, OP_ASLICE))); }
+	|	ary '{' expr ';' '}'	%prec '('
+			{ $$ = prepend_elem(OP_HSLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_HSLICE, 0,
+					list($3),
+					ref(oopsHV($1), OP_HSLICE)));
+			    expect = XOPERATOR; }
+	|	THING	%prec '('
+			{ $$ = $1; }
+	|	amper
+			{ $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
+	|	amper '(' ')'
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); }
+	|	amper '(' expr ')'
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, $3, scalar($1))); }
+	|	NOAMP WORD listexpr
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, $3, scalar($2))); }
+	|	DO term	%prec UNIOP
+			{ $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+	|	DO block	%prec '('
+			{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
+	|	DO WORD '(' ')'
+			{ $$ = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar($2)
+				)),Nullop)); dep();}
+	|	DO WORD '(' expr ')'
+			{ $$ = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    append_elem(OP_LIST,
+				$4,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar($2)
+				)))); dep();}
+	|	DO scalar '(' ')'
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(0,scalar($2))), Nullop)); dep();}
+	|	DO scalar '(' expr ')'
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				$4,
+				scalar(newCVREF(0,scalar($2))))); dep();}
+	|	LOOPEX
+			{ $$ = newOP($1, OPf_SPECIAL);
+			    hints |= HINT_BLOCK_SCOPE; }
+	|	LOOPEX term
+			{ $$ = newLOOPEX($1,$2); }
+	|	NOTOP argexpr
+			{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
+	|	UNIOP
+			{ $$ = newOP($1, 0); }
+	|	UNIOP block
+			{ $$ = newUNOP($1, 0, $2); }
+	|	UNIOP term
+			{ $$ = newUNOP($1, 0, $2); }
+	|	UNIOPSUB term
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, $2, scalar($1))); }
+	|	FUNC0
+			{ $$ = newOP($1, 0); }
+	|	FUNC0 '(' ')'
+			{ $$ = newOP($1, 0); }
+	|	FUNC0SUB
+			{ $$ = newUNOP(OP_ENTERSUB, 0,
+				scalar($1)); }
+	|	FUNC1 '(' ')'
+			{ $$ = newOP($1, OPf_SPECIAL); }
+	|	FUNC1 '(' expr ')'
+			{ $$ = newUNOP($1, 0, $3); }
+	|	PMFUNC '(' term ')'
+			{ $$ = pmruntime($1, $3, Nullop); }
+	|	PMFUNC '(' term ',' term ')'
+			{ $$ = pmruntime($1, $3, $5); }
+	|	WORD
+	|	listop
+	;
+
+listexpr:	/* NULL */
+			{ $$ = Nullop; }
+	|	argexpr
+			{ $$ = $1; }
+	;
+
+listexprcom:	/* NULL */
+			{ $$ = Nullop; }
+	|	expr
+			{ $$ = $1; }
+	|	expr ','
+			{ $$ = $1; }
+	;
+
+amper	:	'&' indirob
+			{ $$ = newCVREF($1,$2); }
+	;
+
+scalar	:	'$' indirob
+			{ $$ = newSVREF($2); }
+	;
+
+ary	:	'@' indirob
+			{ $$ = newAVREF($2); }
+	;
+
+hsh	:	'%' indirob
+			{ $$ = newHVREF($2); }
+	;
+
+arylen	:	DOLSHARP indirob
+			{ $$ = newAVREF($2); }
+	;
+
+star	:	'*' indirob
+			{ $$ = newGVREF(0,$2); }
+	;
+
+indirob	:	WORD
+			{ $$ = scalar($1); }
+	|	scalar
+			{ $$ = scalar($1);  }
+	|	block
+			{ $$ = scope($1); }
+
+	|	PRIVATEREF
+			{ $$ = $1; }
+	;
+
+%% /* PROGRAM */
diff --git a/gnu/usr.bin/perl/pod/Makefile b/gnu/usr.bin/perl/pod/Makefile
new file mode 100644
index 00000000000..bfe6c8edada
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/Makefile
@@ -0,0 +1,194 @@
+CONVERTERS = pod2html pod2latex pod2man pod2text
+
+all: $(CONVERTERS) man
+PERL = ../miniperl
+
+POD = 	\
+	perl.pod	\
+	perlbook.pod	\
+	perlbot.pod	\
+	perlcall.pod	\
+	perldata.pod	\
+	perldebug.pod	\
+	perldiag.pod	\
+	perldsc.pod	\
+	perlembed.pod	\
+	perlform.pod	\
+	perlfunc.pod	\
+	perlguts.pod	\
+	perlipc.pod	\
+	perllol.pod	\
+	perlmod.pod	\
+	perlobj.pod	\
+	perlop.pod	\
+	perlovl.pod	\
+	perlpod.pod	\
+	perlre.pod	\
+	perlref.pod	\
+	perlrun.pod	\
+	perlsec.pod	\
+	perlstyle.pod	\
+	perlsub.pod	\
+	perlsyn.pod	\
+	perltie.pod	\
+	perltoc.pod	\
+	perltrap.pod	\
+	perlvar.pod	\
+	perlxs.pod	\
+	perlxstut.pod
+
+MAN = 	\
+	perl.man	\
+	perlbook.man	\
+	perlbot.man	\
+	perlcall.man	\
+	perldata.man	\
+	perldebug.man	\
+	perldiag.man	\
+	perldsc.man	\
+	perlembed.man	\
+	perlform.man	\
+	perlfunc.man	\
+	perlguts.man	\
+	perlipc.man	\
+	perllol.man	\
+	perlmod.man	\
+	perlobj.man	\
+	perlop.man	\
+	perlovl.man	\
+	perlpod.man	\
+	perlre.man	\
+	perlref.man	\
+	perlrun.man	\
+	perlsec.man	\
+	perlstyle.man	\
+	perlsub.man	\
+	perlsyn.man	\
+	perltie.man	\
+	perltoc.man	\
+	perltrap.man	\
+	perlvar.man	\
+	perlxs.man	\
+	perlxstut.man
+
+HTML = 	\
+	perl.html	\
+	perlbook.html	\
+	perlbot.html	\
+	perlcall.html	\
+	perldata.html	\
+	perldebug.html	\
+	perldiag.html	\
+	perldsc.html	\
+	perlembed.html	\
+	perlform.html	\
+	perlfunc.html	\
+	perlguts.html	\
+	perlipc.html	\
+	perllol.html	\
+	perlmod.html	\
+	perlobj.html	\
+	perlop.html	\
+	perlovl.html	\
+	perlpod.html	\
+	perlre.html	\
+	perlref.html	\
+	perlrun.html	\
+	perlsec.html	\
+	perlstyle.html	\
+	perlsub.html	\
+	perlsyn.html	\
+	perltie.html	\
+	perltoc.html	\
+	perltrap.html	\
+	perlvar.html	\
+	perlxs.html	\
+	perlxstut.html
+
+TEX = 	\
+	perl.tex	\
+	perlbook.tex	\
+	perlbot.tex	\
+	perlcall.tex	\
+	perldata.tex	\
+	perldebug.tex	\
+	perldiag.tex	\
+	perldsc.tex	\
+	perlembed.tex	\
+	perlform.tex	\
+	perlfunc.tex	\
+	perlguts.tex	\
+	perlipc.tex	\
+	perllol.tex	\
+	perlmod.tex	\
+	perlobj.tex	\
+	perlop.tex	\
+	perlovl.tex	\
+	perlpod.tex	\
+	perlre.tex	\
+	perlref.tex	\
+	perlrun.tex	\
+	perlsec.tex	\
+	perlstyle.tex	\
+	perlsub.tex	\
+	perlsyn.tex	\
+	perltie.tex	\
+	perltoc.tex	\
+	perltrap.tex	\
+	perlvar.tex	\
+	perlxs.tex	\
+	perlxstut.tex
+
+man:  pod2man $(MAN)
+
+# pod2html normally runs on all the pods at once in order to build up
+# cross-references.
+html: pod2html
+	$(PERL) -I../lib pod2html $(POD)
+
+tex:	pod2latex $(TEX)
+
+.SUFFIXES: .pm .pod .man
+
+.pm.man:     pod2man
+	$(PERL) -I../lib pod2man $*.pm >$*.man
+
+.pod.man:     pod2man
+	$(PERL) -I../lib pod2man $*.pod >$*.man
+
+.SUFFIXES: .mp .pod .html
+
+.pm.html:    pod2html
+	$(PERL) -I../lib pod2html $*.pod
+
+.pod.html:    pod2html
+	$(PERL) -I../lib pod2html $*.pod
+
+.SUFFIXES: .pm .pod .tex
+
+.pod.tex: pod2latex
+	$(PERL) -I../lib pod2latex $*.pod
+
+.pm.tex: pod2latex
+	$(PERL) -I../lib pod2latex $*.pod
+
+clean:
+	rm -f $(MAN) $(HTML) $(TEX)
+
+realclean:	clean
+	rm -f $(CONVERTERS)
+
+distclean:	realclean
+
+# Dependencies.
+pod2latex:	pod2latex.PL ../lib/Config.pm
+	$(PERL) -I../lib pod2latex.PL
+
+pod2html:	pod2html.PL ../lib/Config.pm
+	$(PERL) -I ../lib pod2html.PL
+
+pod2man:	pod2man.PL ../lib/Config.pm
+	$(PERL) -I ../lib pod2man.PL
+
+pod2text:	pod2text.PL ../lib/Config.pm
+	$(PERL) -I ../lib pod2text.PL
diff --git a/gnu/usr.bin/perl/pod/buildtoc b/gnu/usr.bin/perl/pod/buildtoc
new file mode 100644
index 00000000000..9ca5e920fdf
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/buildtoc
@@ -0,0 +1,207 @@
+use File::Find;
+use Cwd;
+
+@pods = qw{
+	    perl perldata perlsyn perlop perlre perlrun perlfunc perlvar
+	    perlsub perlmod perlref perldsc perllol perlobj perltie
+	    perlbot perldebug perldiag perlform perlipc perlsec perltrap
+	    perlstyle perlxs perlxstut perlguts perlcall perlembed perlpod
+	    perlbook 
+	};
+for (@pods) { s/$/.pod/ } 
+
+$/ = '';
+@ARGV = @pods;
+
+($_= <<EOPOD2B) =~ s/^\t//gm && print;
+
+	=head1 NAME
+
+	perltoc - perl documentation table of contents
+
+	=head1 DESCRIPTION
+
+	This page provides a brief table of contents for the rest of the Perl 
+	documentation set.  It is meant to be be quickly scanned or grepped 
+	through to locate the proper section you're looking for.
+
+	=head1 BASIC DOCUMENTATION
+
+EOPOD2B
+
+podset(@pods);
+
+find \&getpods => qw(../lib ../ext);
+sub getpods {
+    if (/\.p(od|m)$/) { 
+	my $tmp;
+	# Skip .pm files that have corresponding .pod files, and Functions.pm.
+	return if (($tmp = $_) =~ s/\.pm$/.pod/ && -f $tmp);
+	return if ($_ eq '../lib/Pod/Functions.pm');####Used only by pod itself
+
+	my $file = $File::Find::name;
+	die "tut $name" if $file =~ /TUT/;
+	unless (open (F, "< $_\0")) {
+	    warn "bogus <$file>: $!";
+	    system "ls", "-l", $file;
+	}  else { 
+	    my $line;
+	    while ($line = <F>) {
+		if ($line =~ /^=head1\s+NAME\b/) {
+		    push @modpods, $file;
+		    #warn "GOOD $file\n";
+		    return;
+		} 
+	    } 
+	    warn "EVIL $file\n";
+	}
+    }
+}
+
+die "no pods" unless @modpods;
+
+for (@modpods) {
+    #($name) = /(\w+)\.p(m|od)$/;
+    $name = path2modname($_);
+    if ($name =~ /^[a-z]/) {
+	push @pragmata, $_;
+    } else {
+	if ($done{$name}++) {
+	    # warn "already did $_\n";
+	    next;
+	} 
+	push @modules, $_;
+	push @modname, $name;
+    } 
+} 
+
+($_= <<EOPOD2B) =~ s/^\t//gm && print;
+ 
+
+
+	=head1 PRAGMA DOCUMENTATION
+
+EOPOD2B
+
+podset(sort @pragmata);
+
+($_= <<EOPOD2B) =~ s/^\t//gm && print;
+ 
+
+
+	=head1 MODULE DOCUMENTATION
+
+EOPOD2B
+
+podset( @modules[ sort { $modname[$a] cmp $modname[$b] } 0 .. $#modules ] );
+
+($_= <<EOPOD2B) =~ s/^\t//gm;
+ 
+
+	=head1 AUXILIARY DOCUMENTATION
+
+	Here should be listed all the extra program's docs, but they
+	don't all have man pages yet:
+
+	=item a2p
+
+	=item s2p
+
+	=item find2perl
+	
+	=item h2ph
+	
+	=item c2ph
+
+	=item h2xs
+
+	=item xsubpp
+
+	=item pod2man 
+
+	=item wrapsuid
+
+
+	=head1 AUTHOR
+
+	Larry Wall E<lt>F<lwall\@sems.com>E<gt>, with the help of oodles 
+	of other folks.
+
+
+EOPOD2B
+print;
+
+exit;
+
+sub podset {
+    local @ARGV = @_;
+
+    while(<>) {
+	if (s/^=head1 (NAME)\s*/=head2 /) {
+	    $pod = path2modname($ARGV);
+	    sub path2modname {
+		local $_ = shift;
+		s/\.p(m|od)$//;
+		s-.*?/(lib|ext)/--;
+		s-/-::-g;
+		s/(\w+)::\1/$1/;
+		return $_;
+	    }
+	    unitem(); unhead2();
+	    print "\n \n\n=head2 ";
+	    $_ = <>;
+	    if ( /^\s*$pod\b/ ) {
+		print;
+	    } else {
+		s/^/$pod, /;
+		print;
+	    } 
+	    next;
+	}
+	if (s/^=head1 (.*)/=item $1/) {
+	    unitem(); unhead2();
+	    print; nl(); next;
+	} 
+	if (s/^=head2 (.*)/=item $1/) {
+	    unitem();
+	    print "=over\n\n" unless $inhead2;
+	    $inhead2 = 1;
+	    print; nl(); next;
+
+	} 
+	if (s/^=item (.*)\n/$1/) {
+	    next if $pod eq 'perldiag';
+	    s/^\s*\*\s*$// && next;
+	    s/^\s*\*\s*//;
+	    s/\s+$//;
+	    next if /^[\d.]+$/;
+	    next if $pod eq 'perlmod' && /^ftp:/;
+	    ##print "=over\n\n" unless $initem;
+	    print ", " if $initem;
+	    $initem = 1;
+	    s/\.$//;
+	    print; next;
+	} 
+    } 
+
+} 
+
+sub unhead2 {
+    if ($inhead2) {
+	print "\n\n=back\n\n";
+    } 
+    $inhead2 = 0; 
+    $initem = 0;
+} 
+
+sub unitem {
+    if ($initem) {
+	print "\n\n";
+	##print "\n\n=back\n\n";
+    } 
+    $initem = 0;
+} 
+
+sub nl {
+    print "\n";
+} 
diff --git a/gnu/usr.bin/perl/pod/perl.pod b/gnu/usr.bin/perl/pod/perl.pod
new file mode 100644
index 00000000000..150bb7d842e
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perl.pod
@@ -0,0 +1,320 @@
+=head1 NAME
+
+perl - Practical Extraction and Report Language
+
+=head1 SYNOPSIS
+
+B<perl>	S<[ B<-sTuU> ]>
+	S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]>
+	S<[ B<-cw> ] [ B<-d>[:I<debugger>] ] [ B<-D>[I<number/list>] ]>
+	S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal>] ]>
+	S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ]>
+	S<[ B<-P> ]>
+	S<[ B<-S> ]>
+	S<[ B<-x>[I<dir>] ]>
+	S<[ B<-i>[I<extension>] ]>
+	S<[ B<-e> I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...>
+
+For ease of access, the Perl manual has been split up into a number
+of sections:
+
+    perl	Perl overview (this section)
+    perltoc	Perl documentation table of contents
+    perldata	Perl data structures
+    perlsyn	Perl syntax
+    perlop	Perl operators and precedence
+    perlre	Perl regular expressions
+    perlrun	Perl execution and options
+    perlfunc	Perl builtin functions
+    perlvar	Perl predefined variables
+    perlsub	Perl subroutines
+    perlmod	Perl modules
+    perlref	Perl references 
+    perldsc	Perl data structures intro
+    perllol	Perl data structures: lists of lists
+    perlobj	Perl objects
+    perltie	Perl objects hidden behind simple variables
+    perlbot	Perl OO tricks and examples
+    perldebug	Perl debugging
+    perldiag	Perl diagnostic messages
+    perlform	Perl formats
+    perlipc	Perl interprocess communication
+    perlsec	Perl security
+    perltrap	Perl traps for the unwary
+    perlstyle	Perl style guide
+    perlxs	Perl XS application programming interface
+    perlxstut	Perl XS tutorial
+    perlguts	Perl internal functions for those doing extensions 
+    perlcall	Perl calling conventions from C
+    perlembed	Perl how to embed perl in your C or C++ app
+    perlpod	Perl plain old documentation
+    perlbook	Perl book information
+
+(If you're intending to read these straight through for the first time,
+the suggested order will tend to reduce the number of forward references.)
+
+Additional documentation for Perl modules is available in the
+F</usr/local/man/> directory.  Some of this is distributed standard with
+Perl, but you'll also find third-party modules there.  You should be able
+to view this with your man(1) program by including the proper directories
+in the appropriate start-up files.  To find out where these are, type:
+
+    perl -le 'use Config; print "@Config{man1dir,man3dir}"'
+
+If the directories were F</usr/local/man/man1> and F</usr/local/man/man3>,
+you would only need to add F</usr/local/man> to your MANPATH.  If 
+they are different, you'll have to add both stems.
+
+If that doesn't work for some reason, you can still use the
+supplied F<perldoc> script to view module information.  You might
+also look into getting a replacement man program.
+
+If something strange has gone wrong with your program and you're not
+sure where you should look for help, try the B<-w> switch first.  It
+will often point out exactly where the trouble is.
+
+=head1 DESCRIPTION
+
+Perl is an interpreted language optimized for scanning arbitrary
+text files, extracting information from those text files, and printing
+reports based on that information.  It's also a good language for many
+system management tasks.  The language is intended to be practical
+(easy to use, efficient, complete) rather than beautiful (tiny,
+elegant, minimal).
+
+Perl combines (in the author's opinion, anyway) some
+of the best features of C, B<sed>, B<awk>, and B<sh>, so people
+familiar with those languages should have little difficulty with it.
+(Language historians will also note some vestiges of B<csh>, Pascal,
+and even BASIC-PLUS.)  Expression syntax corresponds quite closely to C
+expression syntax.  Unlike most Unix utilities, Perl does not
+arbitrarily limit the size of your data--if you've got the memory,
+Perl can slurp in your whole file as a single string.  Recursion is
+of unlimited depth.  And the hash tables used by associative arrays
+grow as necessary to prevent degraded performance.  Perl uses
+sophisticated pattern matching techniques to scan large amounts of data
+very quickly.  Although optimized for scanning text, Perl can also
+deal with binary data, and can make dbm files look like associative
+arrays.  Setuid Perl scripts are safer than
+C programs through a dataflow tracing mechanism which prevents many
+stupid security holes.  If you have a problem that would ordinarily use
+B<sed> or B<awk> or B<sh>, but it exceeds their capabilities or must
+run a little faster, and you don't want to write the silly thing in C,
+then Perl may be for you.  There are also translators to turn your
+B<sed> and B<awk> scripts into Perl scripts.
+
+But wait, there's more...
+
+Perl version 5 is nearly a complete rewrite, and provides
+the following additional benefits:
+
+=over 5
+
+=item * Many usability enhancements
+
+It is now possible to write much more readable Perl code (even within
+regular expressions).  Formerly cryptic variable names can be replaced
+by mnemonic identifiers.  Error messages are more informative, and the
+optional warnings will catch many of the mistakes a novice might make.
+This cannot be stressed enough.  Whenever you get mysterious behavior,
+try the B<-w> switch!!!  Whenever you don't get mysterious behavior,
+try using B<-w> anyway.
+
+=item * Simplified grammar
+
+The new yacc grammar is one half the size of the old one.  Many of the
+arbitrary grammar rules have been regularized.  The number of reserved
+words has been cut by 2/3.  Despite this, nearly all old Perl scripts
+will continue to work unchanged.
+
+=item * Lexical scoping
+
+Perl variables may now be declared within a lexical scope, like "auto"
+variables in C.  Not only is this more efficient, but it contributes
+to better privacy for "programming in the large".
+
+=item * Arbitrarily nested data structures
+
+Any scalar value, including any array element, may now contain a
+reference to any other variable or subroutine.  You can easily create
+anonymous variables and subroutines.  Perl manages your reference
+counts for you.
+
+=item * Modularity and reusability
+
+The Perl library is now defined in terms of modules which can be easily
+shared among various packages.  A package may choose to import all or a
+portion of a module's published interface.  Pragmas (that is, compiler
+directives) are defined and used by the same mechanism.
+
+=item * Object-oriented programming
+
+A package can function as a class.  Dynamic multiple inheritance and
+virtual methods are supported in a straightforward manner and with very
+little new syntax.  Filehandles may now be treated as objects.
+
+=item * Embeddable and Extensible
+
+Perl may now be embedded easily in your C or C++ application, and can
+either call or be called by your routines through a documented
+interface.  The XS preprocessor is provided to make it easy to glue
+your C or C++ routines into Perl.  Dynamic loading of modules is
+supported.
+
+=item * POSIX compliant
+
+A major new module is the POSIX module, which provides access to all
+available POSIX routines and definitions, via object classes where
+appropriate.
+
+=item * Package constructors and destructors
+
+The new BEGIN and END blocks provide means to capture control as
+a package is being compiled, and after the program exits.  As a
+degenerate case they work just like awk's BEGIN and END when you
+use the B<-p> or B<-n> switches.
+
+=item * Multiple simultaneous DBM implementations
+
+A Perl program may now access DBM, NDBM, SDBM, GDBM, and Berkeley DB
+files from the same script simultaneously.  In fact, the old dbmopen
+interface has been generalized to allow any variable to be tied
+to an object class which defines its access methods.
+
+=item * Subroutine definitions may now be autoloaded
+
+In fact, the AUTOLOAD mechanism also allows you to define any arbitrary
+semantics for undefined subroutine calls.  It's not just for autoloading.
+
+=item * Regular expression enhancements
+
+You can now specify non-greedy quantifiers.  You can now do grouping
+without creating a backreference.  You can now write regular expressions
+with embedded whitespace and comments for readability.  A consistent
+extensibility mechanism has been added that is upwardly compatible with
+all old regular expressions.
+
+=back
+
+Ok, that's I<definitely> enough hype.
+
+=head1 ENVIRONMENT
+
+=over 12
+
+=item HOME
+
+Used if chdir has no argument.
+
+=item LOGDIR
+
+Used if chdir has no argument and HOME is not set.
+
+=item PATH
+
+Used in executing subprocesses, and in finding the script if B<-S> is
+used.
+
+=item PERL5LIB
+
+A colon-separated list of directories in which to look for Perl library
+files before looking in the standard library and the current
+directory.  If PERL5LIB is not defined, PERLLIB is used.  When running
+taint checks (because the script was running setuid or setgid, or the
+B<-T> switch was used), neither variable is used.  The script should
+instead say
+
+    use lib "/my/directory";
+
+=item PERL5DB
+
+The command used to get the debugger code.  If unset, uses
+
+	BEGIN { require 'perl5db.pl' }
+
+=item PERLLIB
+
+A colon-separated list of directories in which to look for Perl library
+files before looking in the standard library and the current
+directory.  If PERL5LIB is defined, PERLLIB is not used.
+
+=back
+
+Apart from these, Perl uses no other environment variables, except
+to make them available to the script being executed, and to child
+processes.  However, scripts running setuid would do well to execute
+the following lines before doing anything else, just to keep people
+honest:
+
+    $ENV{'PATH'} = '/bin:/usr/bin';    # or whatever you need
+    $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
+    $ENV{'IFS'} = ''          if defined $ENV{'IFS'};
+
+=head1 AUTHOR
+
+Larry Wall E<lt>F<lwall@sems.com>E<gt>, with the help of oodles of other folks.
+
+=head1 FILES
+
+ "/tmp/perl-e$$"	temporary file for -e commands
+ "@INC"			locations of perl 5 libraries
+
+=head1 SEE ALSO
+
+ a2p	awk to perl translator
+
+ s2p	sed to perl translator
+
+=head1 DIAGNOSTICS
+
+The B<-w> switch produces some lovely diagnostics.
+
+See L<perldiag> for explanations of all Perl's diagnostics.
+
+Compilation errors will tell you the line number of the error, with an
+indication of the next token or token type that was to be examined.
+(In the case of a script passed to Perl via B<-e> switches, each
+B<-e> is counted as one line.)
+
+Setuid scripts have additional constraints that can produce error
+messages such as "Insecure dependency".  See L<perlsec>.
+
+Did we mention that you should definitely consider using the B<-w>
+switch?
+
+=head1 BUGS
+
+The B<-w> switch is not mandatory.
+
+Perl is at the mercy of your machine's definitions of various
+operations such as type casting, atof() and sprintf().  The latter
+can even trigger a coredump when passed ludicrous input values.
+
+If your stdio requires a seek or eof between reads and writes on a
+particular stream, so does Perl.  (This doesn't apply to sysread()
+and syswrite().)
+
+While none of the built-in data types have any arbitrary size limits
+(apart from memory size), there are still a few arbitrary limits:  a
+given identifier may not be longer than 255 characters, and no
+component of your PATH may be longer than 255 if you use B<-S>.  A regular
+expression may not compile to more than 32767 bytes internally.
+
+See the perl bugs database at F< http://perl.com/perl/bugs/ >.  You may
+mail your bug reports (be sure to include full configuration information
+as output by the myconfig program in the perl source tree) to
+F<perlbug@perl.com>.
+If you've succeeded in compiling perl, the perlbug script in the utils/
+subdirectory can be used to help mail in a bug report.
+
+Perl actually stands for Pathologically Eclectic Rubbish Lister, but
+don't tell anyone I said that.
+
+=head1 NOTES
+
+The Perl motto is "There's more than one way to do it."  Divining
+how many more is left as an exercise to the reader.
+
+The three principal virtues of a programmer are Laziness,
+Impatience, and Hubris.  See the Camel Book for why.
+
diff --git a/gnu/usr.bin/perl/pod/perlbook.pod b/gnu/usr.bin/perl/pod/perlbook.pod
new file mode 100644
index 00000000000..5bb4bfb0b52
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlbook.pod
@@ -0,0 +1,22 @@
+=head1 NAME
+
+perlbook - Perl book information
+
+=head1 DESCRIPTION
+
+You can order Perl books from O'Reilly & Associates, 1-800-998-9938.
+Local/overseas is +1 707 829 0515.  If you can locate an O'Reilly order
+form, you can also fax to +1 707 829 0104.  I<Programming Perl> is a
+reference work that covers nearly all of Perl (version 4, alas), while
+I<Learning Perl> is a tutorial that covers the most frequently used subset
+of the language.
+
+    Programming Perl (the Camel Book):
+	ISBN 0-937175-64-1      (English)
+	ISBN 4-89052-384-7      (Japanese)
+
+    Learning Perl (the Llama Book):
+	ISBN 1-56592-042-2      (English)
+	ISBN 4-89502-678-1      (Japanese)
+	ISBN 2-84177-005-2      (French)
+	ISBN 3-930673-08-8      (German)
diff --git a/gnu/usr.bin/perl/pod/perlbot.pod b/gnu/usr.bin/perl/pod/perlbot.pod
new file mode 100644
index 00000000000..0fd545fe88f
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlbot.pod
@@ -0,0 +1,527 @@
+=head1 NAME
+
+perlbot - Bag'o Object Tricks (the BOT)
+
+=head1 DESCRIPTION
+
+The following collection of tricks and hints is intended to whet curious
+appetites about such things as the use of instance variables and the
+mechanics of object and class relationships.  The reader is encouraged to
+consult relevant textbooks for discussion of Object Oriented definitions and
+methodology.  This is not intended as a tutorial for object-oriented
+programming or as a comprehensive guide to Perl's object oriented features,
+nor should it be construed as a style guide.
+
+The Perl motto still holds:  There's more than one way to do it.
+
+=head1 OO SCALING TIPS
+
+=over 5
+
+=item 1
+
+Do not attempt to verify the type of $self.  That'll break if the class is
+inherited, when the type of $self is valid but its package isn't what you
+expect.  See rule 5.
+
+=item 2
+
+If an object-oriented (OO) or indirect-object (IO) syntax was used, then the
+object is probably the correct type and there's no need to become paranoid
+about it.  Perl isn't a paranoid language anyway.  If people subvert the OO
+or IO syntax then they probably know what they're doing and you should let
+them do it.  See rule 1.
+
+=item 3
+
+Use the two-argument form of bless().  Let a subclass use your constructor.
+See L<INHERITING A CONSTRUCTOR>.
+
+=item 4
+
+The subclass is allowed to know things about its immediate superclass, the
+superclass is allowed to know nothing about a subclass.
+
+=item 5
+
+Don't be trigger happy with inheritance.  A "using", "containing", or
+"delegation" relationship (some sort of aggregation, at least) is often more
+appropriate.  See L<OBJECT RELATIONSHIPS>, L<USING RELATIONSHIP WITH SDBM>,
+and L<"DELEGATION">.
+
+=item 6
+
+The object is the namespace.  Make package globals accessible via the
+object.  This will remove the guess work about the symbol's home package.
+See L<CLASS CONTEXT AND THE OBJECT>.
+
+=item 7
+
+IO syntax is certainly less noisy, but it is also prone to ambiguities which
+can cause difficult-to-find bugs.  Allow people to use the sure-thing OO
+syntax, even if you don't like it.
+
+=item 8
+
+Do not use function-call syntax on a method.  You're going to be bitten
+someday.  Someone might move that method into a superclass and your code
+will be broken.  On top of that you're feeding the paranoia in rule 2.
+
+=item 9
+
+Don't assume you know the home package of a method.  You're making it
+difficult for someone to override that method.  See L<THINKING OF CODE REUSE>.
+
+=back
+
+=head1 INSTANCE VARIABLES
+
+An anonymous array or anonymous hash can be used to hold instance
+variables.  Named parameters are also demonstrated.
+
+	package Foo;
+
+	sub new {
+		my $type = shift;
+		my %params = @_;
+		my $self = {};
+		$self->{'High'} = $params{'High'};
+		$self->{'Low'}  = $params{'Low'};
+		bless $self, $type;
+	}
+
+
+	package Bar;
+
+	sub new {
+		my $type = shift;
+		my %params = @_;
+		my $self = [];
+		$self->[0] = $params{'Left'};
+		$self->[1] = $params{'Right'};
+		bless $self, $type;
+	}
+
+	package main;
+
+	$a = Foo->new( 'High' => 42, 'Low' => 11 );
+	print "High=$a->{'High'}\n";
+	print "Low=$a->{'Low'}\n";
+
+	$b = Bar->new( 'Left' => 78, 'Right' => 40 );
+	print "Left=$b->[0]\n";
+	print "Right=$b->[1]\n";
+
+=head1 SCALAR INSTANCE VARIABLES
+
+An anonymous scalar can be used when only one instance variable is needed.
+
+	package Foo;
+
+	sub new {
+		my $type = shift;
+		my $self;
+		$self = shift;
+		bless \$self, $type;
+	}
+
+	package main;
+
+	$a = Foo->new( 42 );
+	print "a=$$a\n";
+
+
+=head1 INSTANCE VARIABLE INHERITANCE
+
+This example demonstrates how one might inherit instance variables from a
+superclass for inclusion in the new class.  This requires calling the
+superclass's constructor and adding one's own instance variables to the new
+object.
+
+	package Bar;
+
+	sub new {
+		my $type = shift;
+		my $self = {};
+		$self->{'buz'} = 42;
+		bless $self, $type;
+	}
+
+	package Foo;
+	@ISA = qw( Bar );
+
+	sub new {
+		my $type = shift;
+		my $self = Bar->new;
+		$self->{'biz'} = 11;
+		bless $self, $type;
+	}
+
+	package main;
+
+	$a = Foo->new;
+	print "buz = ", $a->{'buz'}, "\n";
+	print "biz = ", $a->{'biz'}, "\n";
+
+
+
+=head1 OBJECT RELATIONSHIPS
+
+The following demonstrates how one might implement "containing" and "using"
+relationships between objects.
+
+	package Bar;
+
+	sub new {
+		my $type = shift;
+		my $self = {};
+		$self->{'buz'} = 42;
+		bless $self, $type;
+	}
+
+	package Foo;
+
+	sub new {
+		my $type = shift;
+		my $self = {};
+		$self->{'Bar'} = Bar->new;
+		$self->{'biz'} = 11;
+		bless $self, $type;
+	}
+
+	package main;
+
+	$a = Foo->new;
+	print "buz = ", $a->{'Bar'}->{'buz'}, "\n";
+	print "biz = ", $a->{'biz'}, "\n";
+
+
+
+=head1 OVERRIDING SUPERCLASS METHODS
+
+The following example demonstrates how to override a superclass method and
+then call the overridden method.  The B<SUPER> pseudo-class allows the
+programmer to call an overridden superclass method without actually knowing
+where that method is defined.
+
+	package Buz;
+	sub goo { print "here's the goo\n" }
+
+	package Bar; @ISA = qw( Buz );
+	sub google { print "google here\n" }
+
+	package Baz;
+	sub mumble { print "mumbling\n" }
+
+	package Foo;
+	@ISA = qw( Bar Baz );
+
+	sub new {
+		my $type = shift;
+		bless [], $type;
+	}
+	sub grr { print "grumble\n" }
+	sub goo {
+		my $self = shift;
+		$self->SUPER::goo();
+	}
+	sub mumble {
+		my $self = shift;
+		$self->SUPER::mumble();
+	}
+	sub google {
+		my $self = shift;
+		$self->SUPER::google();
+	}
+
+	package main;
+
+	$foo = Foo->new;
+	$foo->mumble;
+	$foo->grr;
+	$foo->goo;
+	$foo->google;
+
+
+=head1 USING RELATIONSHIP WITH SDBM
+
+This example demonstrates an interface for the SDBM class.  This creates a
+"using" relationship between the SDBM class and the new class Mydbm.
+
+	package Mydbm;
+
+	require SDBM_File;
+	require Tie::Hash;
+	@ISA = qw( Tie::Hash );
+
+	sub TIEHASH {
+	    my $type = shift;
+	    my $ref  = SDBM_File->new(@_);
+	    bless {'dbm' => $ref}, $type;
+	}
+	sub FETCH {
+	    my $self = shift;
+	    my $ref  = $self->{'dbm'};
+	    $ref->FETCH(@_);
+	}
+	sub STORE {
+	    my $self = shift; 
+	    if (defined $_[0]){
+		my $ref = $self->{'dbm'};
+		$ref->STORE(@_);
+	    } else {
+		die "Cannot STORE an undefined key in Mydbm\n";
+	    }
+	}
+
+	package main;
+	use Fcntl qw( O_RDWR O_CREAT );
+
+	tie %foo, Mydbm, "Sdbm", O_RDWR|O_CREAT, 0640;
+	$foo{'bar'} = 123;
+	print "foo-bar = $foo{'bar'}\n";
+
+	tie %bar, Mydbm, "Sdbm2", O_RDWR|O_CREAT, 0640;
+	$bar{'Cathy'} = 456;
+	print "bar-Cathy = $bar{'Cathy'}\n";
+
+=head1 THINKING OF CODE REUSE
+
+One strength of Object-Oriented languages is the ease with which old code
+can use new code.  The following examples will demonstrate first how one can
+hinder code reuse and then how one can promote code reuse.
+
+This first example illustrates a class which uses a fully-qualified method
+call to access the "private" method BAZ().  The second example will show
+that it is impossible to override the BAZ() method.
+
+	package FOO;
+
+	sub new {
+		my $type = shift;
+		bless {}, $type;
+	}
+	sub bar {
+		my $self = shift;
+		$self->FOO::private::BAZ;
+	}
+
+	package FOO::private;
+
+	sub BAZ {
+		print "in BAZ\n";
+	}
+
+	package main;
+
+	$a = FOO->new;
+	$a->bar;
+
+Now we try to override the BAZ() method.  We would like FOO::bar() to call
+GOOP::BAZ(), but this cannot happen because FOO::bar() explicitly calls
+FOO::private::BAZ().
+
+	package FOO;
+
+	sub new {
+		my $type = shift;
+		bless {}, $type;
+	}
+	sub bar {
+		my $self = shift;
+		$self->FOO::private::BAZ;
+	}
+
+	package FOO::private;
+
+	sub BAZ {
+		print "in BAZ\n";
+	}
+
+	package GOOP;
+	@ISA = qw( FOO );
+	sub new {
+		my $type = shift;
+		bless {}, $type;
+	}
+
+	sub BAZ {
+		print "in GOOP::BAZ\n";
+	}
+
+	package main;
+
+	$a = GOOP->new;
+	$a->bar;
+
+To create reusable code we must modify class FOO, flattening class
+FOO::private.  The next example shows a reusable class FOO which allows the
+method GOOP::BAZ() to be used in place of FOO::BAZ().
+
+	package FOO;
+
+	sub new {
+		my $type = shift;
+		bless {}, $type;
+	}
+	sub bar {
+		my $self = shift;
+		$self->BAZ;
+	}
+
+	sub BAZ {
+		print "in BAZ\n";
+	}
+
+	package GOOP;
+	@ISA = qw( FOO );
+
+	sub new {
+		my $type = shift;
+		bless {}, $type;
+	}
+	sub BAZ {
+		print "in GOOP::BAZ\n";
+	}
+
+	package main;
+
+	$a = GOOP->new;
+	$a->bar;
+
+=head1 CLASS CONTEXT AND THE OBJECT
+
+Use the object to solve package and class context problems.  Everything a
+method needs should be available via the object or should be passed as a
+parameter to the method.
+
+A class will sometimes have static or global data to be used by the
+methods.  A subclass may want to override that data and replace it with new
+data.  When this happens the superclass may not know how to find the new
+copy of the data.
+
+This problem can be solved by using the object to define the context of the
+method.  Let the method look in the object for a reference to the data.  The
+alternative is to force the method to go hunting for the data ("Is it in my
+class, or in a subclass?  Which subclass?"), and this can be inconvenient
+and will lead to hackery.  It is better to just let the object tell the
+method where that data is located.
+
+	package Bar;
+
+	%fizzle = ( 'Password' => 'XYZZY' );
+
+	sub new {
+		my $type = shift;
+		my $self = {};
+		$self->{'fizzle'} = \%fizzle;
+		bless $self, $type;
+	}
+
+	sub enter {
+		my $self = shift;
+	
+		# Don't try to guess if we should use %Bar::fizzle
+		# or %Foo::fizzle.  The object already knows which
+		# we should use, so just ask it.
+		#
+		my $fizzle = $self->{'fizzle'};
+
+		print "The word is ", $fizzle->{'Password'}, "\n";
+	}
+
+	package Foo;
+	@ISA = qw( Bar );
+
+	%fizzle = ( 'Password' => 'Rumple' );
+
+	sub new {
+		my $type = shift;
+		my $self = Bar->new;
+		$self->{'fizzle'} = \%fizzle;
+		bless $self, $type;
+	}
+
+	package main;
+
+	$a = Bar->new;
+	$b = Foo->new;
+	$a->enter;
+	$b->enter;
+
+=head1 INHERITING A CONSTRUCTOR
+
+An inheritable constructor should use the second form of bless() which allows
+blessing directly into a specified class.  Notice in this example that the
+object will be a BAR not a FOO, even though the constructor is in class FOO.
+
+	package FOO;
+
+	sub new {
+		my $type = shift;
+		my $self = {};
+		bless $self, $type;
+	}
+
+	sub baz {
+		print "in FOO::baz()\n";
+	}
+
+	package BAR;
+	@ISA = qw(FOO);
+
+	sub baz {
+		print "in BAR::baz()\n";
+	}
+
+	package main;
+
+	$a = BAR->new;
+	$a->baz;
+
+=head1 DELEGATION
+
+Some classes, such as SDBM_File, cannot be effectively subclassed because
+they create foreign objects.  Such a class can be extended with some sort of
+aggregation technique such as the "using" relationship mentioned earlier or
+by delegation.
+
+The following example demonstrates delegation using an AUTOLOAD() function to
+perform message-forwarding.  This will allow the Mydbm object to behave
+exactly like an SDBM_File object.  The Mydbm class could now extend the
+behavior by adding custom FETCH() and STORE() methods, if this is desired.
+
+	package Mydbm;
+
+	require SDBM_File;
+	require Tie::Hash;
+	@ISA = qw(Tie::Hash);
+
+	sub TIEHASH {
+		my $type = shift;
+		my $ref = SDBM_File->new(@_);
+		bless {'delegate' => $ref};
+	}
+
+	sub AUTOLOAD {
+		my $self = shift;
+
+		# The Perl interpreter places the name of the
+		# message in a variable called $AUTOLOAD.
+
+		# DESTROY messages should never be propagated.
+		return if $AUTOLOAD =~ /::DESTROY$/;
+
+		# Remove the package name.
+		$AUTOLOAD =~ s/^Mydbm:://;
+
+		# Pass the message to the delegate.
+		$self->{'delegate'}->$AUTOLOAD(@_);
+	}
+
+	package main;
+	use Fcntl qw( O_RDWR O_CREAT );
+
+	tie %foo, Mydbm, "adbm", O_RDWR|O_CREAT, 0640;
+	$foo{'bar'} = 123;
+	print "foo-bar = $foo{'bar'}\n";
diff --git a/gnu/usr.bin/perl/pod/perlcall.pod b/gnu/usr.bin/perl/pod/perlcall.pod
new file mode 100644
index 00000000000..996c9145d08
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlcall.pod
@@ -0,0 +1,1902 @@
+=head1 NAME
+
+perlcall - Perl calling conventions from C
+
+=head1 DESCRIPTION
+
+The purpose of this document is to show you how to call Perl subroutines
+directly from C, i.e. how to write I<callbacks>.
+
+Apart from discussing the C interface provided by Perl for writing
+callbacks the document uses a series of examples to show how the
+interface actually works in practice.  In addition some techniques for
+coding callbacks are covered.
+
+Examples where callbacks are necessary include
+
+=over 5
+
+=item * An Error Handler
+
+You have created an XSUB interface to an application's C API.
+
+A fairly common feature in applications is to allow you to define a C
+function that will be called whenever something nasty occurs. What we
+would like is to be able to specify a Perl subroutine that will be
+called instead.
+
+=item * An Event Driven Program
+
+The classic example of where callbacks are used is when writing an
+event driven program like for an X windows application.  In this case
+your register functions to be called whenever specific events occur,
+e.g. a mouse button is pressed, the cursor moves into a window or a
+menu item is selected.
+
+=back
+
+Although the techniques described here are applicable when embedding
+Perl in a C program, this is not the primary goal of this document.
+There are other details that must be considered and are specific to
+embedding Perl. For details on embedding Perl in C refer to
+L<perlembed>.
+
+Before you launch yourself head first into the rest of this document,
+it would be a good idea to have read the following two documents -
+L<perlxs> and L<perlguts>.
+
+=head1 THE PERL_CALL FUNCTIONS
+
+Although this stuff is easier to explain using examples, you first need
+be aware of a few important definitions.
+
+Perl has a number of C functions that allow you to call Perl
+subroutines.  They are
+
+    I32 perl_call_sv(SV* sv, I32 flags) ;
+    I32 perl_call_pv(char *subname, I32 flags) ;
+    I32 perl_call_method(char *methname, I32 flags) ;
+    I32 perl_call_argv(char *subname, I32 flags, register char **argv) ;
+
+The key function is I<perl_call_sv>.  All the other functions are
+fairly simple wrappers which make it easier to call Perl subroutines in
+special cases. At the end of the day they will all call I<perl_call_sv>
+to actually invoke the Perl subroutine.
+
+All the I<perl_call_*> functions have a C<flags> parameter which is
+used to pass a bit mask of options to Perl.  This bit mask operates
+identically for each of the functions.  The settings available in the
+bit mask are discussed in L<FLAG VALUES>.
+
+Each of the functions will now be discussed in turn.
+
+=over 5
+
+=item B<perl_call_sv>
+
+I<perl_call_sv> takes two parameters, the first, C<sv>, is an SV*.
+This allows you to specify the Perl subroutine to be called either as a
+C string (which has first been converted to an SV) or a reference to a
+subroutine. The section, I<Using perl_call_sv>, shows how you can make
+use of I<perl_call_sv>.
+
+=item B<perl_call_pv>
+
+The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it
+expects its first parameter to be a C char* which identifies the Perl
+subroutine you want to call, e.g. C<perl_call_pv("fred", 0)>.  If the
+subroutine you want to call is in another package, just include the
+package name in the string, e.g. C<"pkg::fred">.
+
+=item B<perl_call_method>
+
+The function I<perl_call_method> is used to call a method from a Perl
+class.  The parameter C<methname> corresponds to the name of the method
+to be called.  Note that the class that the method belongs to is passed
+on the Perl stack rather than in the parameter list. This class can be
+either the name of the class (for a static method) or a reference to an
+object (for a virtual method).  See L<perlobj> for more information on
+static and virtual methods and L<Using perl_call_method> for an example
+of using I<perl_call_method>.
+
+=item B<perl_call_argv>
+
+I<perl_call_argv> calls the Perl subroutine specified by the C string
+stored in the C<subname> parameter. It also takes the usual C<flags>
+parameter.  The final parameter, C<argv>, consists of a NULL terminated
+list of C strings to be passed as parameters to the Perl subroutine.
+See I<Using perl_call_argv>.
+
+=back
+
+All the functions return an integer. This is a count of the number of
+items returned by the Perl subroutine. The actual items returned by the
+subroutine are stored on the Perl stack.
+
+As a general rule you should I<always> check the return value from
+these functions.  Even if you are expecting only a particular number of
+values to be returned from the Perl subroutine, there is nothing to
+stop someone from doing something unexpected - don't say you haven't
+been warned.
+
+=head1 FLAG VALUES
+
+The C<flags> parameter in all the I<perl_call_*> functions is a bit mask
+which can consist of any combination of the symbols defined below,
+OR'ed together.
+
+
+=head2  G_SCALAR
+
+Calls the Perl subroutine in a scalar context.  This is the default
+context flag setting for all the I<perl_call_*> functions.
+
+This flag has 2 effects
+
+=over 5
+
+=item 1.
+
+it indicates to the subroutine being called that it is executing in a
+scalar context (if it executes I<wantarray> the result will be false).
+
+
+=item 2.
+
+it ensures that only a scalar is actually returned from the subroutine.
+The subroutine can, of course,  ignore the I<wantarray> and return a
+list anyway. If so, then only the last element of the list will be
+returned.
+
+=back
+
+The value returned by the I<perl_call_*> function indicates how may
+items have been returned by the Perl subroutine - in this case it will
+be either 0 or 1.
+
+If 0, then you have specified the G_DISCARD flag.
+
+If 1, then the item actually returned by the Perl subroutine will be
+stored on the Perl stack - the section I<Returning a Scalar> shows how
+to access this value on the stack.  Remember that regardless of how
+many items the Perl subroutine returns, only the last one will be
+accessible from the stack - think of the case where only one value is
+returned as being a list with only one element.  Any other items that
+were returned will not exist by the time control returns from the
+I<perl_call_*> function.  The section I<Returning a list in a scalar
+context> shows an example of this behaviour.
+
+
+=head2 G_ARRAY
+
+Calls the Perl subroutine in a list context.
+
+As with G_SCALAR, this flag has 2 effects
+
+=over 5
+
+=item 1.
+
+it indicates to the subroutine being called that it is executing in an
+array context (if it executes I<wantarray> the result will be true).
+
+
+=item 2.
+
+it ensures that all items returned from the subroutine will be
+accessible when control returns from the I<perl_call_*> function.
+
+=back
+
+The value returned by the I<perl_call_*> function indicates how may
+items have been returned by the Perl subroutine.
+
+If 0, the you have specified the G_DISCARD flag.
+
+If not 0, then it will be a count of the number of items returned by
+the subroutine. These items will be stored on the Perl stack.  The
+section I<Returning a list of values> gives an example of using the
+G_ARRAY flag and the mechanics of accessing the returned items from the
+Perl stack.
+
+=head2 G_DISCARD
+
+By default, the I<perl_call_*> functions place the items returned from
+by the Perl subroutine on the stack.  If you are not interested in
+these items, then setting this flag will make Perl get rid of them
+automatically for you.  Note that it is still possible to indicate a
+context to the Perl subroutine by using either G_SCALAR or G_ARRAY.
+
+If you do not set this flag then it is I<very> important that you make
+sure that any temporaries (i.e. parameters passed to the Perl
+subroutine and values returned from the subroutine) are disposed of
+yourself.  The section I<Returning a Scalar> gives details of how to
+explicitly dispose of these temporaries and the section I<Using Perl to
+dispose of temporaries> discusses the specific circumstances where you
+can ignore the problem and let Perl deal with it for you.
+
+=head2 G_NOARGS
+
+Whenever a Perl subroutine is called using one of the I<perl_call_*>
+functions, it is assumed by default that parameters are to be passed to
+the subroutine.  If you are not passing any parameters to the Perl
+subroutine, you can save a bit of time by setting this flag.  It has
+the effect of not creating the C<@_> array for the Perl subroutine.
+
+Although the functionality provided by this flag may seem
+straightforward, it should be used only if there is a good reason to do
+so.  The reason for being cautious is that even if you have specified
+the G_NOARGS flag, it is still possible for the Perl subroutine that
+has been called to think that you have passed it parameters.
+
+In fact, what can happen is that the Perl subroutine you have called
+can access the C<@_> array from a previous Perl subroutine.  This will
+occur when the code that is executing the I<perl_call_*> function has
+itself been called from another Perl subroutine. The code below
+illustrates this
+
+    sub fred
+      { print "@_\n"  }
+
+    sub joe
+      { &fred }
+
+    &joe(1,2,3) ;
+
+This will print
+
+    1 2 3
+
+What has happened is that C<fred> accesses the C<@_> array which
+belongs to C<joe>.
+
+
+=head2 G_EVAL	
+
+It is possible for the Perl subroutine you are calling to terminate
+abnormally, e.g. by calling I<die> explicitly or by not actually
+existing.  By default, when either of these of events occurs, the
+process will terminate immediately.  If though, you want to trap this
+type of event, specify the G_EVAL flag.  It will put an I<eval { }>
+around the subroutine call.
+
+Whenever control returns from the I<perl_call_*> function you need to
+check the C<$@> variable as you would in a normal Perl script.
+
+The value returned from the I<perl_call_*> function is dependent on
+what other flags have been specified and whether an error has
+occurred.  Here are all the different cases that can occur
+
+=over 5
+
+=item *
+
+If the I<perl_call_*> function returns normally, then the value
+returned is as specified in the previous sections.
+
+=item *
+
+If G_DISCARD is specified, the return value will always be 0.
+
+=item *
+
+If G_ARRAY is specified I<and> an error has occurred, the return value
+will always be 0.
+
+=item *
+
+If G_SCALAR is specified I<and> an error has occurred, the return value
+will be 1 and the value on the top of the stack will be I<undef>. This
+means that if you have already detected the error by checking C<$@> and
+you want the program to continue, you must remember to pop the I<undef>
+from the stack.
+
+=back
+
+See I<Using G_EVAL> for details of using G_EVAL.
+
+=head2 G_KEEPERR
+
+You may have noticed that using the G_EVAL flag described above will
+B<always> clear the C<$@> variable and set it to a string describing
+the error iff there was an error in the called code.  This unqualified
+resetting of C<$@> can be problematic in the reliable identification of
+errors using the C<eval {}> mechanism, because the possibility exists
+that perl will call other code (end of block processing code, for
+example) between the time the error causes C<$@> to be set within
+C<eval {}>, and the subsequent statement which checks for the value of
+C<$@> gets executed in the user's script.
+
+This scenario will mostly be applicable to code that is meant to be
+called from within destructors, asynchronous callbacks, signal
+handlers, C<__DIE__> or C<__WARN__> hooks, and C<tie> functions.  In
+such situations, you will not want to clear C<$@> at all, but simply to
+append any new errors to any existing value of C<$@>.
+
+The G_KEEPERR flag is meant to be used in conjunction with G_EVAL in
+I<perl_call_*> functions that are used to implement such code.  This flag
+has no effect when G_EVAL is not used.
+
+When G_KEEPERR is used, any errors in the called code will be prefixed
+with the string "\t(in cleanup)", and appended to the current value
+of C<$@>.
+
+The G_KEEPERR flag was introduced in Perl version 5.002.
+
+See I<Using G_KEEPERR> for an example of a situation that warrants the
+use of this flag.
+
+=head2 Determining the Context 
+
+As mentioned above, you can determine the context of the currently
+executing subroutine in Perl with I<wantarray>. The equivalent test can
+be made in C by using the C<GIMME> macro. This will return C<G_SCALAR>
+if you have been called in a scalar context and C<G_ARRAY> if in an
+array context. An example of using the C<GIMME> macro is shown in
+section I<Using GIMME>.
+
+=head1 KNOWN PROBLEMS
+
+This section outlines all known problems that exist in the
+I<perl_call_*> functions.
+
+=over 5
+
+=item 1.
+
+If you are intending to make use of both the G_EVAL and G_SCALAR flags
+in your code, use a version of Perl greater than 5.000.  There is a bug
+in version 5.000 of Perl which means that the combination of these two
+flags will not work as described in the section I<FLAG VALUES>.
+
+Specifically, if the two flags are used when calling a subroutine and
+that subroutine does not call I<die>, the value returned by
+I<perl_call_*> will be wrong.
+
+
+=item 2.
+
+In Perl 5.000 and 5.001 there is a problem with using I<perl_call_*> if
+the Perl sub you are calling attempts to trap a I<die>.
+
+The symptom of this problem is that the called Perl sub will continue
+to completion, but whenever it attempts to pass control back to the
+XSUB, the program will immediately terminate.
+
+For example, say you want to call this Perl sub
+
+    sub fred
+    {
+        eval { die "Fatal Error" ; }
+        print "Trapped error: $@\n" 
+            if $@ ;
+    }
+
+via this XSUB
+
+    void
+    Call_fred()
+        CODE:
+        PUSHMARK(sp) ;
+        perl_call_pv("fred", G_DISCARD|G_NOARGS) ;
+        fprintf(stderr, "back in Call_fred\n") ;
+
+When C<Call_fred> is executed it will print
+
+    Trapped error: Fatal Error
+
+As control never returns to C<Call_fred>, the C<"back in Call_fred">
+string will not get printed.
+
+To work around this problem, you can either upgrade to Perl 5.002 (or
+later), or use the G_EVAL flag with I<perl_call_*> as shown below
+
+    void
+    Call_fred()
+        CODE:
+        PUSHMARK(sp) ;
+        perl_call_pv("fred", G_EVAL|G_DISCARD|G_NOARGS) ;
+        fprintf(stderr, "back in Call_fred\n") ;
+
+=back
+
+
+
+=head1 EXAMPLES
+
+Enough of the definition talk, let's have a few examples.
+
+Perl provides many macros to assist in accessing the Perl stack.
+Wherever possible, these macros should always be used when interfacing
+to Perl internals.  Hopefully this should make the code less vulnerable
+to any changes made to Perl in the future.
+
+Another point worth noting is that in the first series of examples I
+have made use of only the I<perl_call_pv> function.  This has been done
+to keep the code simpler and ease you into the topic.  Wherever
+possible, if the choice is between using I<perl_call_pv> and
+I<perl_call_sv>, you should always try to use I<perl_call_sv>.  See
+I<Using perl_call_sv> for details.
+
+=head2 No Parameters, Nothing returned
+
+This first trivial example will call a Perl subroutine, I<PrintUID>, to
+print out the UID of the process.
+
+    sub PrintUID
+    {
+        print "UID is $<\n" ;
+    }
+
+and here is a C function to call it
+
+    static void
+    call_PrintUID()
+    {
+        dSP ;
+
+        PUSHMARK(sp) ;
+        perl_call_pv("PrintUID", G_DISCARD|G_NOARGS) ;
+    }
+
+Simple, eh.
+
+A few points to note about this example.
+
+=over 5
+
+=item 1.
+
+Ignore C<dSP> and C<PUSHMARK(sp)> for now. They will be discussed in
+the next example.
+
+=item 2.
+
+We aren't passing any parameters to I<PrintUID> so G_NOARGS can be
+specified.
+
+=item 3.
+
+We aren't interested in anything returned from I<PrintUID>, so
+G_DISCARD is specified. Even if I<PrintUID> was changed to actually
+return some value(s), having specified G_DISCARD will mean that they
+will be wiped by the time control returns from I<perl_call_pv>.
+
+=item 4.
+
+As I<perl_call_pv> is being used, the Perl subroutine is specified as a
+C string. In this case the subroutine name has been 'hard-wired' into the
+code.
+
+=item 5.
+
+Because we specified G_DISCARD, it is not necessary to check the value
+returned from I<perl_call_pv>. It will always be 0.
+
+=back
+
+=head2 Passing Parameters
+
+Now let's make a slightly more complex example. This time we want to
+call a Perl subroutine, C<LeftString>, which will take 2 parameters - a
+string (C<$s>) and an integer (C<$n>).  The subroutine will simply
+print the first C<$n> characters of the string.
+
+So the Perl subroutine would look like this
+
+    sub LeftString
+    {
+        my($s, $n) = @_ ;
+        print substr($s, 0, $n), "\n" ;
+    }
+
+The C function required to call I<LeftString> would look like this.
+
+    static void
+    call_LeftString(a, b)
+    char * a ;
+    int b ;
+    {
+        dSP ;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSVpv(a, 0)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        perl_call_pv("LeftString", G_DISCARD);
+    }
+
+Here are a few notes on the C function I<call_LeftString>.
+
+=over 5
+
+=item 1.
+
+Parameters are passed to the Perl subroutine using the Perl stack.
+This is the purpose of the code beginning with the line C<dSP> and
+ending with the line C<PUTBACK>.
+
+
+=item 2.
+
+If you are going to put something onto the Perl stack, you need to know
+where to put it. This is the purpose of the macro C<dSP> - it declares
+and initializes a I<local> copy of the Perl stack pointer.
+
+All the other macros which will be used in this example require you to
+have used this macro.
+
+The exception to this rule is if you are calling a Perl subroutine
+directly from an XSUB function. In this case it is not necessary to
+explicitly use the C<dSP> macro - it will be declared for you
+automatically.
+
+=item 3.
+
+Any parameters to be pushed onto the stack should be bracketed by the
+C<PUSHMARK> and C<PUTBACK> macros.  The purpose of these two macros, in
+this context, is to automatically count the number of parameters you
+are pushing. Then whenever Perl is creating the C<@_> array for the
+subroutine, it knows how big to make it.
+
+The C<PUSHMARK> macro tells Perl to make a mental note of the current
+stack pointer. Even if you aren't passing any parameters (like the
+example shown in the section I<No Parameters, Nothing returned>) you
+must still call the C<PUSHMARK> macro before you can call any of the
+I<perl_call_*> functions - Perl still needs to know that there are no
+parameters.
+
+The C<PUTBACK> macro sets the global copy of the stack pointer to be
+the same as our local copy. If we didn't do this I<perl_call_pv>
+wouldn't know where the two parameters we pushed were - remember that
+up to now all the stack pointer manipulation we have done is with our
+local copy, I<not> the global copy.
+
+=item 4.
+
+The only flag specified this time is G_DISCARD. Since we are passing 2
+parameters to the Perl subroutine this time, we have not specified
+G_NOARGS.
+
+=item 5.
+
+Next, we come to XPUSHs. This is where the parameters actually get
+pushed onto the stack. In this case we are pushing a string and an
+integer.
+
+See the section L<perlguts/"XSUB'S and the Argument Stack"> for details
+on how the XPUSH macros work.
+
+=item 6.
+
+Finally, I<LeftString> can now be called via the I<perl_call_pv>
+function.
+
+=back
+
+=head2 Returning a Scalar
+
+Now for an example of dealing with the items returned from a Perl
+subroutine.
+
+Here is a Perl subroutine, I<Adder>,  which takes 2 integer parameters
+and simply returns their sum.
+
+    sub Adder
+    {
+        my($a, $b) = @_ ;
+        $a + $b ;
+    }
+
+Since we are now concerned with the return value from I<Adder>, the C
+function required to call it is now a bit more complex.
+
+    static void
+    call_Adder(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        int count ;
+
+        ENTER ;
+        SAVETMPS;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(a)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        count = perl_call_pv("Adder", G_SCALAR);
+
+        SPAGAIN ;
+
+        if (count != 1)
+            croak("Big trouble\n") ;
+
+        printf ("The sum of %d and %d is %d\n", a, b, POPi) ;
+
+        PUTBACK ;
+        FREETMPS ;
+        LEAVE ;
+    }
+
+Points to note this time are
+
+=over 5
+
+=item 1. 
+
+The only flag specified this time was G_SCALAR. That means the C<@_>
+array will be created and that the value returned by I<Adder> will
+still exist after the call to I<perl_call_pv>.
+
+
+
+=item 2.
+
+Because we are interested in what is returned from I<Adder> we cannot
+specify G_DISCARD. This means that we will have to tidy up the Perl
+stack and dispose of any temporary values ourselves. This is the
+purpose of
+
+    ENTER ;
+    SAVETMPS ;
+
+at the start of the function, and
+
+    FREETMPS ;
+    LEAVE ;
+
+at the end. The C<ENTER>/C<SAVETMPS> pair creates a boundary for any
+temporaries we create.  This means that the temporaries we get rid of
+will be limited to those which were created after these calls.
+
+The C<FREETMPS>/C<LEAVE> pair will get rid of any values returned by
+the Perl subroutine, plus it will also dump the mortal SV's we have
+created.  Having C<ENTER>/C<SAVETMPS> at the beginning of the code
+makes sure that no other mortals are destroyed.
+
+Think of these macros as working a bit like using C<{> and C<}> in Perl
+to limit the scope of local variables.
+
+See the section I<Using Perl to dispose of temporaries> for details of
+an alternative to using these macros.
+
+=item 3.
+
+The purpose of the macro C<SPAGAIN> is to refresh the local copy of the
+stack pointer. This is necessary because it is possible that the memory
+allocated to the Perl stack has been re-allocated whilst in the
+I<perl_call_pv> call.
+
+If you are making use of the Perl stack pointer in your code you must
+always refresh the your local copy using SPAGAIN whenever you make use
+of the I<perl_call_*> functions or any other Perl internal function.
+
+=item 4.
+
+Although only a single value was expected to be returned from I<Adder>,
+it is still good practice to check the return code from I<perl_call_pv>
+anyway.
+
+Expecting a single value is not quite the same as knowing that there
+will be one. If someone modified I<Adder> to return a list and we
+didn't check for that possibility and take appropriate action the Perl
+stack would end up in an inconsistent state. That is something you
+I<really> don't want to ever happen.
+
+=item 5.
+
+The C<POPi> macro is used here to pop the return value from the stack.
+In this case we wanted an integer, so C<POPi> was used.
+
+
+Here is the complete list of POP macros available, along with the types
+they return.
+
+    POPs	SV
+    POPp	pointer
+    POPn	double
+    POPi	integer
+    POPl	long
+
+=item 6.
+
+The final C<PUTBACK> is used to leave the Perl stack in a consistent
+state before exiting the function.  This is necessary because when we
+popped the return value from the stack with C<POPi> it updated only our
+local copy of the stack pointer.  Remember, C<PUTBACK> sets the global
+stack pointer to be the same as our local copy.
+
+=back
+
+
+=head2 Returning a list of values
+
+Now, let's extend the previous example to return both the sum of the
+parameters and the difference.
+
+Here is the Perl subroutine
+
+    sub AddSubtract
+    {
+       my($a, $b) = @_ ;
+       ($a+$b, $a-$b) ;
+    }
+
+and this is the C function
+
+    static void
+    call_AddSubtract(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        int count ;
+
+        ENTER ;
+        SAVETMPS;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(a)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        count = perl_call_pv("AddSubtract", G_ARRAY);
+
+        SPAGAIN ;
+
+        if (count != 2)
+            croak("Big trouble\n") ;
+
+        printf ("%d - %d = %d\n", a, b, POPi) ;
+        printf ("%d + %d = %d\n", a, b, POPi) ;
+
+        PUTBACK ;
+        FREETMPS ;
+        LEAVE ;
+    }
+
+If I<call_AddSubtract> is called like this
+
+    call_AddSubtract(7, 4) ;
+
+then here is the output
+
+    7 - 4 = 3
+    7 + 4 = 11
+
+Notes
+
+=over 5
+
+=item 1.
+
+We wanted array context, so G_ARRAY was used.
+
+=item 2.
+
+Not surprisingly C<POPi> is used twice this time because we were
+retrieving 2 values from the stack. The important thing to note is that
+when using the C<POP*> macros they come off the stack in I<reverse>
+order.
+
+=back
+
+=head2 Returning a list in a scalar context
+
+Say the Perl subroutine in the previous section was called in a scalar
+context, like this
+
+    static void
+    call_AddSubScalar(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        int count ;
+        int i ;
+
+        ENTER ;
+        SAVETMPS;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(a)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        count = perl_call_pv("AddSubtract", G_SCALAR);
+
+        SPAGAIN ;
+
+        printf ("Items Returned = %d\n", count) ;
+
+        for (i = 1 ; i <= count ; ++i)
+            printf ("Value %d = %d\n", i, POPi) ;
+
+        PUTBACK ;
+        FREETMPS ;
+        LEAVE ;
+    }
+
+The other modification made is that I<call_AddSubScalar> will print the
+number of items returned from the Perl subroutine and their value (for
+simplicity it assumes that they are integer).  So if
+I<call_AddSubScalar> is called
+
+    call_AddSubScalar(7, 4) ;
+
+then the output will be
+
+    Items Returned = 1
+    Value 1 = 3
+
+In this case the main point to note is that only the last item in the
+list returned from the subroutine, I<Adder> actually made it back to
+I<call_AddSubScalar>.
+
+
+=head2 Returning Data from Perl via the parameter list
+
+It is also possible to return values directly via the parameter list -
+whether it is actually desirable to do it is another matter entirely.
+
+The Perl subroutine, I<Inc>, below takes 2 parameters and increments
+each directly.
+
+    sub Inc
+    {
+        ++ $_[0] ;
+        ++ $_[1] ;
+    }
+
+and here is a C function to call it.
+
+    static void
+    call_Inc(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        int count ;
+        SV * sva ;
+        SV * svb ;
+
+        ENTER ;
+        SAVETMPS;
+
+        sva = sv_2mortal(newSViv(a)) ;
+        svb = sv_2mortal(newSViv(b)) ;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sva);
+        XPUSHs(svb);
+        PUTBACK ;
+
+        count = perl_call_pv("Inc", G_DISCARD);
+
+        if (count != 0)
+            croak ("call_Inc: expected 0 values from 'Inc', got %d\n",
+                   count) ;
+
+        printf ("%d + 1 = %d\n", a, SvIV(sva)) ;
+        printf ("%d + 1 = %d\n", b, SvIV(svb)) ;
+
+    	FREETMPS ;
+        LEAVE ;
+    }
+
+To be able to access the two parameters that were pushed onto the stack
+after they return from I<perl_call_pv> it is necessary to make a note
+of their addresses - thus the two variables C<sva> and C<svb>.
+
+The reason this is necessary is that the area of the Perl stack which
+held them will very likely have been overwritten by something else by
+the time control returns from I<perl_call_pv>.
+
+
+
+
+=head2 Using G_EVAL
+
+Now an example using G_EVAL. Below is a Perl subroutine which computes
+the difference of its 2 parameters. If this would result in a negative
+result, the subroutine calls I<die>.
+
+    sub Subtract
+    {
+        my ($a, $b) = @_ ;
+
+        die "death can be fatal\n" if $a < $b ;
+
+        $a - $b ;
+    }
+
+and some C to call it
+
+    static void
+    call_Subtract(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        int count ;
+
+        ENTER ;
+        SAVETMPS;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(a)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        count = perl_call_pv("Subtract", G_EVAL|G_SCALAR);
+
+        SPAGAIN ;
+
+        /* Check the eval first */
+        if (SvTRUE(GvSV(errgv)))
+        {
+            printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
+            POPs ;
+        }
+        else
+        {
+            if (count != 1)
+               croak("call_Subtract: wanted 1 value from 'Subtract', got %d\n",
+                        count) ;
+
+            printf ("%d - %d = %d\n", a, b, POPi) ;
+        }
+
+        PUTBACK ;
+        FREETMPS ;
+        LEAVE ;
+    }
+
+If I<call_Subtract> is called thus
+
+    call_Subtract(4, 5)
+
+the following will be printed
+
+    Uh oh - death can be fatal
+
+Notes
+
+=over 5
+
+=item 1.
+
+We want to be able to catch the I<die> so we have used the G_EVAL
+flag.  Not specifying this flag would mean that the program would
+terminate immediately at the I<die> statement in the subroutine
+I<Subtract>.
+
+=item 2.
+
+The code 
+
+    if (SvTRUE(GvSV(errgv)))
+    {
+        printf ("Uh oh - %s\n", SvPV(GvSV(errgv), na)) ;
+        POPs ;
+    }
+
+is the direct equivalent of this bit of Perl
+
+    print "Uh oh - $@\n" if $@ ;
+
+C<errgv> is a perl global of type C<GV *> that points to the
+symbol table entry containing the error.  C<GvSV(errgv)> therefore
+refers to the C equivalent of C<$@>.
+
+=item 3.
+
+Note that the stack is popped using C<POPs> in the block where
+C<SvTRUE(GvSV(errgv))> is true.  This is necessary because whenever a
+I<perl_call_*> function invoked with G_EVAL|G_SCALAR returns an error,
+the top of the stack holds the value I<undef>. Since we want the
+program to continue after detecting this error, it is essential that
+the stack is tidied up by removing the I<undef>.
+
+=back
+
+
+=head2 Using G_KEEPERR
+
+Consider this rather facetious example, where we have used an XS
+version of the call_Subtract example above inside a destructor:
+
+    package Foo;
+    sub new { bless {}, $_[0] }
+    sub Subtract { 
+        my($a,$b) = @_;
+        die "death can be fatal" if $a < $b ;
+        $a - $b;
+    }
+    sub DESTROY { call_Subtract(5, 4); }
+    sub foo { die "foo dies"; }
+
+    package main;
+    eval { Foo->new->foo };
+    print "Saw: $@" if $@;             # should be, but isn't
+
+This example will fail to recognize that an error occurred inside the
+C<eval {}>.  Here's why: the call_Subtract code got executed while perl
+was cleaning up temporaries when exiting the eval block, and since
+call_Subtract is implemented with I<perl_call_pv> using the G_EVAL
+flag, it promptly reset C<$@>.  This results in the failure of the
+outermost test for C<$@>, and thereby the failure of the error trap.
+
+Appending the G_KEEPERR flag, so that the I<perl_call_pv> call in
+call_Subtract reads:
+
+        count = perl_call_pv("Subtract", G_EVAL|G_SCALAR|G_KEEPERR);
+
+will preserve the error and restore reliable error handling.
+
+=head2 Using perl_call_sv
+
+In all the previous examples I have 'hard-wired' the name of the Perl
+subroutine to be called from C.  Most of the time though, it is more
+convenient to be able to specify the name of the Perl subroutine from
+within the Perl script.
+
+Consider the Perl code below
+
+    sub fred
+    {
+        print "Hello there\n" ;
+    }
+
+    CallSubPV("fred") ;
+
+Here is a snippet of XSUB which defines I<CallSubPV>.
+
+    void
+    CallSubPV(name)
+    	char *	name
+    	CODE:
+    	PUSHMARK(sp) ;
+    	perl_call_pv(name, G_DISCARD|G_NOARGS) ;
+
+That is fine as far as it goes. The thing is, the Perl subroutine 
+can be specified only as a string.  For Perl 4 this was adequate,
+but Perl 5 allows references to subroutines and anonymous subroutines.
+This is where I<perl_call_sv> is useful.
+
+The code below for I<CallSubSV> is identical to I<CallSubPV> except
+that the C<name> parameter is now defined as an SV* and we use
+I<perl_call_sv> instead of I<perl_call_pv>.
+
+    void
+    CallSubSV(name)
+    	SV *	name
+    	CODE:
+    	PUSHMARK(sp) ;
+    	perl_call_sv(name, G_DISCARD|G_NOARGS) ;
+
+Since we are using an SV to call I<fred> the following can all be used
+
+    CallSubSV("fred") ;
+    CallSubSV(\&fred) ;
+    $ref = \&fred ;
+    CallSubSV($ref) ;
+    CallSubSV( sub { print "Hello there\n" } ) ;
+
+As you can see, I<perl_call_sv> gives you much greater flexibility in
+how you can specify the Perl subroutine.
+
+You should note that if it is necessary to store the SV (C<name> in the
+example above) which corresponds to the Perl subroutine so that it can
+be used later in the program, it not enough to just store a copy of the
+pointer to the SV. Say the code above had been like this
+
+    static SV * rememberSub ;
+
+    void
+    SaveSub1(name)
+    	SV *	name
+    	CODE:
+    	rememberSub = name ;
+
+    void
+    CallSavedSub1()
+    	CODE:
+    	PUSHMARK(sp) ;
+    	perl_call_sv(rememberSub, G_DISCARD|G_NOARGS) ;
+
+The reason this is wrong is that by the time you come to use the
+pointer C<rememberSub> in C<CallSavedSub1>, it may or may not still refer
+to the Perl subroutine that was recorded in C<SaveSub1>.  This is
+particularly true for these cases
+
+    SaveSub1(\&fred) ;
+    CallSavedSub1() ;
+
+    SaveSub1( sub { print "Hello there\n" } ) ;
+    CallSavedSub1() ;
+
+By the time each of the C<SaveSub1> statements above have been executed,
+the SV*'s which corresponded to the parameters will no longer exist.
+Expect an error message from Perl of the form
+
+    Can't use an undefined value as a subroutine reference at ...
+
+for each of the C<CallSavedSub1> lines.
+
+Similarly, with this code 
+
+    $ref = \&fred ;
+    SaveSub1($ref) ;
+    $ref = 47 ;
+    CallSavedSub1() ;
+
+you can expect one of these messages (which you actually get is dependant on 
+the version of Perl you are using) 
+
+    Not a CODE reference at ...
+    Undefined subroutine &main::47 called ...
+
+The variable C<$ref> may have referred to the subroutine C<fred>
+whenever the call to C<SaveSub1> was made but by the time
+C<CallSavedSub1> gets called it now holds the number C<47>. Since we
+saved only a pointer to the original SV in C<SaveSub1>, any changes to
+C<$ref> will be tracked by the pointer C<rememberSub>. This means that
+whenever C<CallSavedSub1> gets called, it will attempt to execute the
+code which is referenced by the SV* C<rememberSub>.  In this case
+though, it now refers to the integer C<47>, so expect Perl to complain
+loudly.
+
+A similar but more subtle problem is illustrated with this code
+
+    $ref = \&fred ;
+    SaveSub1($ref) ;
+    $ref = \&joe ;
+    CallSavedSub1() ;
+
+This time whenever C<CallSavedSub1> get called it will execute the Perl
+subroutine C<joe> (assuming it exists) rather than C<fred> as was 
+originally requested in the call to C<SaveSub1>.
+
+To get around these problems it is necessary to take a full copy of the
+SV.  The code below shows C<SaveSub2> modified to do that
+
+    static SV * keepSub = (SV*)NULL ;
+
+    void
+    SaveSub2(name)
+        SV *	name
+    	CODE:
+     	/* Take a copy of the callback */
+    	if (keepSub == (SV*)NULL)
+    	    /* First time, so create a new SV */
+    	    keepSub = newSVsv(name) ;
+    	else
+    	    /* Been here before, so overwrite */
+    	    SvSetSV(keepSub, name) ;
+
+    void
+    CallSavedSub2()
+    	CODE:
+    	PUSHMARK(sp) ;
+    	perl_call_sv(keepSub, G_DISCARD|G_NOARGS) ;
+
+In order to avoid creating a new SV every time C<SaveSub2> is called,
+the function first checks to see if it has been called before.  If not,
+then space for a new SV is allocated and the reference to the Perl
+subroutine, C<name> is copied to the variable C<keepSub> in one
+operation using C<newSVsv>.  Thereafter, whenever C<SaveSub2> is called
+the existing SV, C<keepSub>, is overwritten with the new value using
+C<SvSetSV>.
+
+=head2 Using perl_call_argv
+
+Here is a Perl subroutine which prints whatever parameters are passed
+to it.
+
+    sub PrintList
+    {
+        my(@list) = @_ ;
+
+        foreach (@list) { print "$_\n" }
+    }
+
+and here is an example of I<perl_call_argv> which will call
+I<PrintList>.
+
+    static char * words[] = {"alpha", "beta", "gamma", "delta", NULL} ;
+
+    static void
+    call_PrintList()
+    {
+        dSP ;
+
+        perl_call_argv("PrintList", G_DISCARD, words) ;
+    }
+
+Note that it is not necessary to call C<PUSHMARK> in this instance.
+This is because I<perl_call_argv> will do it for you.
+
+=head2 Using perl_call_method
+
+Consider the following Perl code
+
+    {
+        package Mine ;
+
+        sub new
+        {
+            my($type) = shift ;
+            bless [@_]
+        }
+
+        sub Display
+        {
+            my ($self, $index) = @_ ;
+            print "$index: $$self[$index]\n" ;
+        }
+
+        sub PrintID
+        {
+            my($class) = @_ ;
+            print "This is Class $class version 1.0\n" ;
+        }
+    }
+
+It just implements a very simple class to manage an array.  Apart from
+the constructor, C<new>, it declares methods, one static and one
+virtual. The static method, C<PrintID>, simply prints out the class
+name and a version number. The virtual method, C<Display>, prints out a
+single element of the array.  Here is an all Perl example of using it.
+
+    $a = new Mine ('red', 'green', 'blue') ;
+    $a->Display(1) ;
+    PrintID Mine;
+
+will print
+
+    1: green
+    This is Class Mine version 1.0 
+
+Calling a Perl method from C is fairly straightforward. The following
+things are required
+
+=over 5
+
+=item *
+
+a reference to the object for a virtual method or the name of the class
+for a static method.
+
+=item *
+
+the name of the method.
+
+=item *
+
+any other parameters specific to the method.
+
+=back
+
+Here is a simple XSUB which illustrates the mechanics of calling both
+the C<PrintID> and C<Display> methods from C.
+
+    void
+    call_Method(ref, method, index)
+        SV *	ref
+        char *	method
+        int		index
+        CODE:
+        PUSHMARK(sp);
+        XPUSHs(ref);
+        XPUSHs(sv_2mortal(newSViv(index))) ;
+        PUTBACK;
+
+        perl_call_method(method, G_DISCARD) ;
+
+    void
+    call_PrintID(class, method)
+        char *	class
+        char *	method
+        CODE:
+        PUSHMARK(sp);
+        XPUSHs(sv_2mortal(newSVpv(class, 0))) ;
+        PUTBACK;
+
+        perl_call_method(method, G_DISCARD) ;
+
+
+So the methods C<PrintID> and C<Display> can be invoked like this
+
+    $a = new Mine ('red', 'green', 'blue') ;
+    call_Method($a, 'Display', 1) ;
+    call_PrintID('Mine', 'PrintID') ;
+
+The only thing to note is that in both the static and virtual methods,
+the method name is not passed via the stack - it is used as the first
+parameter to I<perl_call_method>.
+
+=head2 Using GIMME
+
+Here is a trivial XSUB which prints the context in which it is 
+currently executing.
+
+    void
+    PrintContext()
+        CODE:
+        if (GIMME == G_SCALAR)
+            printf ("Context is Scalar\n") ;
+        else
+            printf ("Context is Array\n") ;
+
+and here is some Perl to test it
+
+    $a = PrintContext ;
+    @a = PrintContext ;
+
+The output from that will be
+
+    Context is Scalar
+    Context is Array
+
+=head2 Using Perl to dispose of temporaries
+
+In the examples given to date, any temporaries created in the callback
+(i.e. parameters passed on the stack to the I<perl_call_*> function or
+values returned via the stack) have been freed by one of these methods
+
+=over 5
+
+=item *
+
+specifying the G_DISCARD flag with I<perl_call_*>.
+
+=item *
+
+explicitly disposed of using the C<ENTER>/C<SAVETMPS> -
+C<FREETMPS>/C<LEAVE> pairing.
+
+=back
+
+There is another method which can be used, namely letting Perl do it
+for you automatically whenever it regains control after the callback
+has terminated.  This is done by simply not using the
+
+    ENTER ;
+    SAVETMPS ;
+    ...
+    FREETMPS ;
+    LEAVE ;
+
+sequence in the callback (and not, of course, specifying the G_DISCARD
+flag).
+
+If you are going to use this method you have to be aware of a possible
+memory leak which can arise under very specific circumstances.  To
+explain these circumstances you need to know a bit about the flow of
+control between Perl and the callback routine.
+
+The examples given at the start of the document (an error handler and
+an event driven program) are typical of the two main sorts of flow
+control that you are likely to encounter with callbacks.  There is a
+very important distinction between them, so pay attention.
+
+In the first example, an error handler, the flow of control could be as
+follows.  You have created an interface to an external library.
+Control can reach the external library like this
+
+    perl --> XSUB --> external library
+
+Whilst control is in the library, an error condition occurs. You have
+previously set up a Perl callback to handle this situation, so it will
+get executed. Once the callback has finished, control will drop back to
+Perl again.  Here is what the flow of control will be like in that
+situation
+
+    perl --> XSUB --> external library
+                      ...
+                      error occurs
+                      ...
+                      external library --> perl_call --> perl
+                                                          |
+    perl <-- XSUB <-- external library <-- perl_call <----+
+
+After processing of the error using I<perl_call_*> is completed,
+control reverts back to Perl more or less immediately.
+
+In the diagram, the further right you go the more deeply nested the
+scope is.  It is only when control is back with perl on the extreme
+left of the diagram that you will have dropped back to the enclosing
+scope and any temporaries you have left hanging around will be freed.
+
+In the second example, an event driven program, the flow of control
+will be more like this
+
+    perl --> XSUB --> event handler
+                      ...
+                      event handler --> perl_call --> perl 
+                                                       |
+                      event handler <-- perl_call --<--+
+                      ...
+                      event handler --> perl_call --> perl 
+                                                       |
+                      event handler <-- perl_call --<--+
+                      ...
+                      event handler --> perl_call --> perl 
+                                                       |
+                      event handler <-- perl_call --<--+
+
+In this case the flow of control can consist of only the repeated
+sequence
+
+    event handler --> perl_call --> perl
+
+for the practically the complete duration of the program.  This means
+that control may I<never> drop back to the surrounding scope in Perl at
+the extreme left.
+
+So what is the big problem? Well, if you are expecting Perl to tidy up
+those temporaries for you, you might be in for a long wait.  For Perl
+to actually dispose of your temporaries, control must drop back to the
+enclosing scope at some stage.  In the event driven scenario that may
+never happen.  This means that as time goes on, your program will
+create more and more temporaries, none of which will ever be freed. As
+each of these temporaries consumes some memory your program will
+eventually consume all the available memory in your system - kapow!
+
+So here is the bottom line - if you are sure that control will revert
+back to the enclosing Perl scope fairly quickly after the end of your
+callback, then it isn't absolutely necessary to explicitly dispose of
+any temporaries you may have created. Mind you, if you are at all
+uncertain about what to do, it doesn't do any harm to tidy up anyway.
+
+
+=head2 Strategies for storing Callback Context Information
+
+
+Potentially one of the trickiest problems to overcome when designing a
+callback interface can be figuring out how to store the mapping between
+the C callback function and the Perl equivalent.
+
+To help understand why this can be a real problem first consider how a
+callback is set up in an all C environment.  Typically a C API will
+provide a function to register a callback.  This will expect a pointer
+to a function as one of its parameters.  Below is a call to a
+hypothetical function C<register_fatal> which registers the C function
+to get called when a fatal error occurs.
+
+    register_fatal(cb1) ;
+
+The single parameter C<cb1> is a pointer to a function, so you must
+have defined C<cb1> in your code, say something like this
+
+    static void
+    cb1()
+    {
+        printf ("Fatal Error\n") ;
+        exit(1) ;
+    }
+
+Now change that to call a Perl subroutine instead
+
+    static SV * callback = (SV*)NULL;
+
+    static void
+    cb1()
+    {
+        dSP ;
+
+        PUSHMARK(sp) ;
+
+        /* Call the Perl sub to process the callback */
+        perl_call_sv(callback, G_DISCARD) ;
+    }
+
+
+    void
+    register_fatal(fn)
+        SV *	fn
+        CODE:
+        /* Remember the Perl sub */
+        if (callback == (SV*)NULL)
+            callback = newSVsv(fn) ;
+        else
+            SvSetSV(callback, fn) ;
+
+        /* register the callback with the external library */
+        register_fatal(cb1) ;
+
+where the Perl equivalent of C<register_fatal> and the callback it
+registers, C<pcb1>, might look like this
+
+    # Register the sub pcb1
+    register_fatal(\&pcb1) ;
+
+    sub pcb1
+    {
+        die "I'm dying...\n" ;
+    }
+
+The mapping between the C callback and the Perl equivalent is stored in
+the global variable C<callback>.
+
+This will be adequate if you ever need to have only 1 callback
+registered at any time. An example could be an error handler like the
+code sketched out above. Remember though, repeated calls to
+C<register_fatal> will replace the previously registered callback
+function with the new one.
+
+Say for example you want to interface to a library which allows asynchronous
+file i/o.  In this case you may be able to register a callback whenever
+a read operation has completed. To be of any use we want to be able to
+call separate Perl subroutines for each file that is opened.  As it
+stands, the error handler example above would not be adequate as it
+allows only a single callback to be defined at any time. What we
+require is a means of storing the mapping between the opened file and
+the Perl subroutine we want to be called for that file.
+
+Say the i/o library has a function C<asynch_read> which associates a C
+function C<ProcessRead> with a file handle C<fh> - this assumes that it
+has also provided some routine to open the file and so obtain the file
+handle.
+
+    asynch_read(fh, ProcessRead)
+
+This may expect the C I<ProcessRead> function of this form
+
+    void
+    ProcessRead(fh, buffer)
+    int	fh ;
+    char *	buffer ;
+    {
+         ... 
+    }
+
+To provide a Perl interface to this library we need to be able to map
+between the C<fh> parameter and the Perl subroutine we want called.  A
+hash is a convenient mechanism for storing this mapping.  The code
+below shows a possible implementation
+
+    static HV * Mapping = (HV*)NULL ;
+
+    void
+    asynch_read(fh, callback)
+        int	fh
+        SV *	callback
+        CODE:
+        /* If the hash doesn't already exist, create it */
+        if (Mapping == (HV*)NULL)
+            Mapping = newHV() ;
+
+        /* Save the fh -> callback mapping */
+        hv_store(Mapping, (char*)&fh, sizeof(fh), newSVsv(callback), 0) ;
+
+        /* Register with the C Library */
+        asynch_read(fh, asynch_read_if) ;
+
+and C<asynch_read_if> could look like this
+
+    static void
+    asynch_read_if(fh, buffer)
+    int	fh ;
+    char *	buffer ;
+    {
+        dSP ;
+        SV ** sv ;
+
+        /* Get the callback associated with fh */
+        sv =  hv_fetch(Mapping, (char*)&fh , sizeof(fh), FALSE) ;
+        if (sv == (SV**)NULL)
+            croak("Internal error...\n") ;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(fh))) ;
+        XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
+        PUTBACK ;
+
+        /* Call the Perl sub */
+        perl_call_sv(*sv, G_DISCARD) ;
+    }
+
+For completeness, here is C<asynch_close>.  This shows how to remove
+the entry from the hash C<Mapping>.
+
+    void
+    asynch_close(fh)
+        int	fh
+        CODE:
+        /* Remove the entry from the hash */
+        (void) hv_delete(Mapping, (char*)&fh, sizeof(fh), G_DISCARD) ;
+
+        /* Now call the real asynch_close */
+        asynch_close(fh) ;
+
+So the Perl interface would look like this
+
+    sub callback1
+    {
+        my($handle, $buffer) = @_ ;
+    }
+
+    # Register the Perl callback
+    asynch_read($fh, \&callback1) ;
+
+    asynch_close($fh) ;
+
+The mapping between the C callback and Perl is stored in the global
+hash C<Mapping> this time. Using a hash has the distinct advantage that
+it allows an unlimited number of callbacks to be registered.
+
+What if the interface provided by the C callback doesn't contain a
+parameter which allows the file handle to Perl subroutine mapping?  Say
+in the asynchronous i/o package, the callback function gets passed only
+the C<buffer> parameter like this
+
+    void
+    ProcessRead(buffer)
+    char *	buffer ;
+    {
+        ...
+    }
+
+Without the file handle there is no straightforward way to map from the
+C callback to the Perl subroutine.
+
+In this case a possible way around this problem is to pre-define a
+series of C functions to act as the interface to Perl, thus
+
+    #define MAX_CB		3
+    #define NULL_HANDLE	-1
+    typedef void (*FnMap)() ;
+
+    struct MapStruct {
+        FnMap    Function ;
+        SV *     PerlSub ;
+        int      Handle ;
+      } ;
+
+    static void  fn1() ;
+    static void  fn2() ;
+    static void  fn3() ;
+
+    static struct MapStruct Map [MAX_CB] =
+        {
+            { fn1, NULL, NULL_HANDLE },
+            { fn2, NULL, NULL_HANDLE },
+            { fn3, NULL, NULL_HANDLE }
+        } ;
+
+    static void
+    Pcb(index, buffer)
+    int index ;
+    char * buffer ;
+    {
+        dSP ;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSVpv(buffer, 0))) ;
+        PUTBACK ;
+
+        /* Call the Perl sub */
+        perl_call_sv(Map[index].PerlSub, G_DISCARD) ;
+    }
+
+    static void
+    fn1(buffer)
+    char * buffer ;
+    {
+        Pcb(0, buffer) ;
+    }
+
+    static void
+    fn2(buffer)
+    char * buffer ;
+    {
+        Pcb(1, buffer) ;
+    }
+
+    static void
+    fn3(buffer)
+    char * buffer ;
+    {
+        Pcb(2, buffer) ;
+    }
+
+    void
+    array_asynch_read(fh, callback)
+        int		fh
+        SV *	callback
+        CODE:
+        int index ;
+        int null_index = MAX_CB ;
+
+        /* Find the same handle or an empty entry */
+        for (index = 0 ; index < MAX_CB ; ++index)
+        {
+            if (Map[index].Handle == fh)
+                break ;
+
+            if (Map[index].Handle == NULL_HANDLE)
+                null_index = index ;
+        }
+
+        if (index == MAX_CB && null_index == MAX_CB)
+            croak ("Too many callback functions registered\n") ;
+
+        if (index == MAX_CB)
+            index = null_index ;
+
+        /* Save the file handle */
+        Map[index].Handle = fh ;
+
+        /* Remember the Perl sub */
+        if (Map[index].PerlSub == (SV*)NULL)
+            Map[index].PerlSub = newSVsv(callback) ;
+        else
+            SvSetSV(Map[index].PerlSub, callback) ;
+
+        asynch_read(fh, Map[index].Function) ;
+
+    void
+    array_asynch_close(fh)
+        int	fh
+        CODE:
+        int index ;
+
+        /* Find the file handle */
+        for (index = 0; index < MAX_CB ; ++ index)
+            if (Map[index].Handle == fh)
+                break ;
+
+        if (index == MAX_CB)
+            croak ("could not close fh %d\n", fh) ;
+
+        Map[index].Handle = NULL_HANDLE ;
+        SvREFCNT_dec(Map[index].PerlSub) ;
+        Map[index].PerlSub = (SV*)NULL ;
+
+        asynch_close(fh) ;
+
+In this case the functions C<fn1>, C<fn2> and C<fn3> are used to
+remember the Perl subroutine to be called. Each of the functions holds
+a separate hard-wired index which is used in the function C<Pcb> to
+access the C<Map> array and actually call the Perl subroutine.
+
+There are some obvious disadvantages with this technique.
+
+Firstly, the code is considerably more complex than with the previous
+example.
+
+Secondly, there is a hard-wired limit (in this case 3) to the number of
+callbacks that can exist simultaneously. The only way to increase the
+limit is by modifying the code to add more functions and then
+re-compiling.  None the less, as long as the number of functions is
+chosen with some care, it is still a workable solution and in some
+cases is the only one available.
+
+To summarize, here are a number of possible methods for you to consider
+for storing the mapping between C and the Perl callback
+
+=over 5
+
+=item 1. Ignore the problem - Allow only 1 callback
+
+For a lot of situations, like interfacing to an error handler, this may
+be a perfectly adequate solution.
+
+=item 2. Create a sequence of callbacks - hard wired limit
+
+If it is impossible to tell from the parameters passed back from the C
+callback what the context is, then you may need to create a sequence of C
+callback interface functions, and store pointers to each in an array.
+
+=item 3. Use a parameter to map to the Perl callback
+
+A hash is an ideal mechanism to store the mapping between C and Perl.
+
+=back
+
+
+=head2 Alternate Stack Manipulation
+
+
+Although I have made use of only the C<POP*> macros to access values
+returned from Perl subroutines, it is also possible to bypass these
+macros and read the stack using the C<ST> macro (See L<perlxs> for a
+full description of the C<ST> macro).
+
+Most of the time the C<POP*> macros should be adequate, the main
+problem with them is that they force you to process the returned values
+in sequence. This may not be the most suitable way to process the
+values in some cases. What we want is to be able to access the stack in
+a random order. The C<ST> macro as used when coding an XSUB is ideal
+for this purpose.
+
+The code below is the example given in the section I<Returning a list
+of values> recoded to use C<ST> instead of C<POP*>.
+
+    static void
+    call_AddSubtract2(a, b)
+    int a ;
+    int b ;
+    {
+        dSP ;
+        I32 ax ;
+        int count ;
+
+        ENTER ;
+        SAVETMPS;
+
+        PUSHMARK(sp) ;
+        XPUSHs(sv_2mortal(newSViv(a)));
+        XPUSHs(sv_2mortal(newSViv(b)));
+        PUTBACK ;
+
+        count = perl_call_pv("AddSubtract", G_ARRAY);
+
+        SPAGAIN ;
+        sp -= count ;
+        ax = (sp - stack_base) + 1 ;
+
+        if (count != 2)
+            croak("Big trouble\n") ;
+
+        printf ("%d + %d = %d\n", a, b, SvIV(ST(0))) ;
+        printf ("%d - %d = %d\n", a, b, SvIV(ST(1))) ;
+
+        PUTBACK ;
+        FREETMPS ;
+        LEAVE ;
+    }
+
+Notes
+
+=over 5
+
+=item 1.
+
+Notice that it was necessary to define the variable C<ax>.  This is
+because the C<ST> macro expects it to exist.  If we were in an XSUB it
+would not be necessary to define C<ax> as it is already defined for
+you.
+
+=item 2.
+
+The code
+
+        SPAGAIN ;
+        sp -= count ;
+        ax = (sp - stack_base) + 1 ;
+
+sets the stack up so that we can use the C<ST> macro.
+
+=item 3.
+
+Unlike the original coding of this example, the returned
+values are not accessed in reverse order.  So C<ST(0)> refers to the
+first value returned by the Perl subroutine and C<ST(count-1)> 
+refers to the last.
+
+=back
+
+=head1 SEE ALSO
+
+L<perlxs>, L<perlguts>, L<perlembed>
+
+=head1 AUTHOR
+
+Paul Marquess <pmarquess@bfsec.bt.co.uk>
+
+Special thanks to the following people who assisted in the creation of
+the document.
+
+Jeff Okamoto, Tim Bunce, Nick Gianniotis, Steve Kelem, Gurusamy Sarathy
+and Larry Wall.
+
+=head1 DATE
+
+Version 1.2, 16th Jan 1996
diff --git a/gnu/usr.bin/perl/pod/perldata.pod b/gnu/usr.bin/perl/pod/perldata.pod
new file mode 100644
index 00000000000..4b6e4335153
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perldata.pod
@@ -0,0 +1,521 @@
+=head1 NAME
+
+perldata - Perl data types
+
+=head1 DESCRIPTION
+
+=head2 Variable names
+
+Perl has three data structures: scalars, arrays of scalars, and
+associative arrays of scalars, known as "hashes".  Normal arrays are
+indexed by number, starting with 0.  (Negative subscripts count from
+the end.)  Hash arrays are indexed by string.
+
+Scalar values are always named with '$', even when referring to a scalar
+that is part of an array.  It works like the English word "the".  Thus
+we have:
+
+    $days		# the simple scalar value "days"
+    $days[28]		# the 29th element of array @days
+    $days{'Feb'}	# the 'Feb' value from hash %days
+    $#days		# the last index of array @days
+
+but entire arrays or array slices are denoted by '@', which works much like
+the word "these" or "those":
+
+    @days		# ($days[0], $days[1],... $days[n])
+    @days[3,4,5]	# same as @days[3..5]
+    @days{'a','c'}	# same as ($days{'a'},$days{'c'})
+
+and entire hashes are denoted by '%':
+
+    %days		# (key1, val1, key2, val2 ...)
+
+In addition, subroutines are named with an initial '&', though this is
+optional when it's otherwise unambiguous (just as "do" is often
+redundant in English).  Symbol table entries can be named with an
+initial '*', but you don't really care about that yet.
+
+Every variable type has its own namespace.  You can, without fear of
+conflict, use the same name for a scalar variable, an array, or a hash
+(or, for that matter, a filehandle, a subroutine name, or a label).
+This means that $foo and @foo are two different variables.  It also
+means that C<$foo[1]> is a part of @foo, not a part of $foo.  This may
+seem a bit weird, but that's okay, because it is weird.
+
+Since variable and array references always start with '$', '@', or '%',
+the "reserved" words aren't in fact reserved with respect to variable
+names.  (They ARE reserved with respect to labels and filehandles,
+however, which don't have an initial special character.  You can't have
+a filehandle named "log", for instance.  Hint: you could say
+C<open(LOG,'logfile')> rather than C<open(log,'logfile')>.  Using uppercase
+filehandles also improves readability and protects you from conflict
+with future reserved words.)  Case I<IS> significant--"FOO", "Foo" and
+"foo" are all different names.  Names that start with a letter or
+underscore may also contain digits and underscores.
+
+It is possible to replace such an alphanumeric name with an expression
+that returns a reference to an object of that type.  For a description
+of this, see L<perlref>.
+
+Names that start with a digit may only contain more digits.  Names
+which do not start with a letter, underscore,  or digit are limited to
+one character, e.g.  C<$%> or C<$$>.  (Most of these one character names
+have a predefined significance to Perl.  For instance, C<$$> is the
+current process id.)
+
+=head2 Context
+
+The interpretation of operations and values in Perl sometimes depends
+on the requirements of the context around the operation or value.
+There are two major contexts: scalar and list.  Certain operations
+return list values in contexts wanting a list, and scalar values
+otherwise.  (If this is true of an operation it will be mentioned in
+the documentation for that operation.)  In other words, Perl overloads
+certain operations based on whether the expected return value is
+singular or plural.  (Some words in English work this way, like "fish"
+and "sheep".)
+
+In a reciprocal fashion, an operation provides either a scalar or a
+list context to each of its arguments.  For example, if you say
+
+    int( <STDIN> )
+
+the integer operation provides a scalar context for the <STDIN>
+operator, which responds by reading one line from STDIN and passing it
+back to the integer operation, which will then find the integer value
+of that line and return that.  If, on the other hand, you say
+
+    sort( <STDIN> )
+
+then the sort operation provides a list context for <STDIN>, which
+will proceed to read every line available up to the end of file, and
+pass that list of lines back to the sort routine, which will then
+sort those lines and return them as a list to whatever the context
+of the sort was.
+
+Assignment is a little bit special in that it uses its left argument to
+determine the context for the right argument.  Assignment to a scalar
+evaluates the righthand side in a scalar context, while assignment to
+an array or array slice evaluates the righthand side in a list
+context.  Assignment to a list also evaluates the righthand side in a
+list context.
+
+User defined subroutines may choose to care whether they are being
+called in a scalar or list context, but most subroutines do not
+need to care, because scalars are automatically interpolated into
+lists.  See L<perlfunc/wantarray>.
+
+=head2 Scalar values
+
+All data in Perl is a scalar or an array of scalars or a hash of scalars.
+Scalar variables may contain various kinds of singular data, such as
+numbers, strings, and references.  In general, conversion from one form to
+another is transparent.  (A scalar may not contain multiple values, but
+may contain a reference to an array or hash containing multiple values.)
+Because of the automatic conversion of scalars, operations and functions
+that return scalars don't need to care (and, in fact, can't care) whether
+the context is looking for a string or a number.
+
+Scalars aren't necessarily one thing or another.  There's no place to
+declare a scalar variable to be of type "string", or of type "number", or
+type "filehandle", or anything else.  Perl is a contextually polymorphic
+language whose scalars can be strings, numbers, or references (which
+includes objects).  While strings and numbers are considered pretty
+much same thing for nearly all purposes, references are strongly-typed
+uncastable pointers with built-in reference-counting and destructor
+invocation.
+
+A scalar value is interpreted as TRUE in the Boolean sense if it is not
+the null string or the number 0 (or its string equivalent, "0").  The
+Boolean context is just a special kind of scalar context.  
+
+There are actually two varieties of null scalars: defined and
+undefined.  Undefined null scalars are returned when there is no real
+value for something, such as when there was an error, or at end of
+file, or when you refer to an uninitialized variable or element of an
+array.  An undefined null scalar may become defined the first time you
+use it as if it were defined, but prior to that you can use the
+defined() operator to determine whether the value is defined or not.
+
+To find out whether a given string is a valid non-zero number, it's usually
+enough to test it against both numeric 0 and also lexical "0" (although
+this will cause B<-w> noises).  That's because strings that aren't
+numbers count as 0, just as the do in I<awk>:
+
+    if ($str == 0 && $str ne "0")  {
+	warn "That doesn't look like a number";
+    } 
+
+That's usually preferable because otherwise you won't treat IEEE notations
+like C<NaN> or C<Infinity> properly.  At other times you might prefer to
+use a regular expression to check whether data is numeric.  See L<perlre>
+for details on regular expressions.
+
+    warn "has nondigits"	if     /\D/;
+    warn "not a whole number"   unless /^\d+$/;
+    warn "not an integer"       unless /^[+-]?\d+$/     
+    warn "not a decimal number" unless /^[+-]?\d+\.?\d*$/ 
+    warn "not a C float" 
+	unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
+
+The length of an array is a scalar value.  You may find the length of
+array @days by evaluating C<$#days>, as in B<csh>.  (Actually, it's not
+the length of the array, it's the subscript of the last element, since
+there is (ordinarily) a 0th element.)  Assigning to C<$#days> changes the
+length of the array.  Shortening an array by this method destroys
+intervening values.  Lengthening an array that was previously shortened
+I<NO LONGER> recovers the values that were in those elements.  (It used to
+in Perl 4, but we had to break this make to make sure destructors were
+called when expected.)  You can also gain some measure of efficiency by
+preextending an array that is going to get big.  (You can also extend
+an array by assigning to an element that is off the end of the array.)
+You can truncate an array down to nothing by assigning the null list ()
+to it.  The following are equivalent:
+
+    @whatever = ();
+    $#whatever = $[ - 1;
+
+If you evaluate a named array in a scalar context, it returns the length of
+the array.  (Note that this is not true of lists, which return the
+last value, like the C comma operator.)  The following is always true:
+
+    scalar(@whatever) == $#whatever - $[ + 1;
+
+Version 5 of Perl changed the semantics of $[: files that don't set
+the value of $[ no longer need to worry about whether another
+file changed its value.  (In other words, use of $[ is deprecated.)
+So in general you can just assume that
+
+    scalar(@whatever) == $#whatever + 1;
+
+Some programmers choose to use an explicit conversion so nothing's
+left to doubt:
+
+    $element_count = scalar(@whatever);
+
+If you evaluate a hash in a scalar context, it returns a value which is
+true if and only if the hash contains any key/value pairs.  (If there
+are any key/value pairs, the value returned is a string consisting of
+the number of used buckets and the number of allocated buckets, separated
+by a slash.  This is pretty much only useful to find out whether Perl's
+(compiled in) hashing algorithm is performing poorly on your data set.
+For example, you stick 10,000 things in a hash, but evaluating %HASH in
+scalar context reveals "1/16", which means only one out of sixteen buckets
+has been touched, and presumably contains all 10,000 of your items.  This
+isn't supposed to happen.)
+
+=head2 Scalar value constructors
+
+Numeric literals are specified in any of the customary floating point or
+integer formats:
+
+    12345
+    12345.67
+    .23E-10
+    0xffff		# hex
+    0377		# octal
+    4_294_967_296	# underline for legibility
+
+String literals are usually delimited by either single or double quotes.  They
+work much like shell quotes:  double-quoted string literals are subject
+to backslash and variable substitution; single-quoted strings are not
+(except for "C<\'>" and "C<\\>").  The usual Unix backslash rules apply for making
+characters such as newline, tab, etc., as well as some more exotic
+forms.  See L<perlop/qq> for a list.
+
+You can also embed newlines directly in your strings, i.e. they can end
+on a different line than they begin.  This is nice, but if you forget
+your trailing quote, the error will not be reported until Perl finds
+another line containing the quote character, which may be much further
+on in the script.  Variable substitution inside strings is limited to
+scalar variables, arrays, and array slices.  (In other words,
+identifiers beginning with $ or @, followed by an optional bracketed
+expression as a subscript.)  The following code segment prints out "The
+price is $100."
+
+    $Price = '$100';	# not interpreted
+    print "The price is $Price.\n";	# interpreted
+
+As in some shells, you can put curly brackets around the identifier to
+delimit it from following alphanumerics.  In fact, an identifier
+within such curlies is forced to be a string, as is any single
+identifier within a hash subscript.  Our earlier example,
+
+    $days{'Feb'}
+
+can be written as
+
+    $days{Feb}
+
+and the quotes will be assumed automatically.  But anything more complicated
+in the subscript will be interpreted as an expression.
+
+Note that a
+single-quoted string must be separated from a preceding word by a
+space, since single quote is a valid (though deprecated) character in
+an identifier (see L<perlmod/Packages>).
+
+Two special literals are __LINE__ and __FILE__, which represent the
+current line number and filename at that point in your program.  They
+may only be used as separate tokens; they will not be interpolated into
+strings.  In addition, the token __END__ may be used to indicate the
+logical end of the script before the actual end of file.  Any following
+text is ignored, but may be read via the DATA filehandle.  (The DATA
+filehandle may read data only from the main script, but not from any
+required file or evaluated string.)  The two control characters ^D and
+^Z are synonyms for __END__ (or __DATA__ in a module; see L<SelfLoader> for 
+details on __DATA__).
+
+A word that has no other interpretation in the grammar will
+be treated as if it were a quoted string.  These are known as
+"barewords".  As with filehandles and labels, a bareword that consists
+entirely of lowercase letters risks conflict with future reserved
+words, and if you use the B<-w> switch, Perl will warn you about any
+such words.  Some people may wish to outlaw barewords entirely.  If you
+say
+
+    use strict 'subs';
+
+then any bareword that would NOT be interpreted as a subroutine call
+produces a compile-time error instead.  The restriction lasts to the
+end of the enclosing block.  An inner block may countermand this 
+by saying C<no strict 'subs'>.
+
+Array variables are interpolated into double-quoted strings by joining all
+the elements of the array with the delimiter specified in the C<$">
+variable ($LIST_SEPARATOR in English), space by default.  The following
+are equivalent:
+
+    $temp = join($",@ARGV);
+    system "echo $temp";
+
+    system "echo @ARGV";
+
+Within search patterns (which also undergo double-quotish substitution)
+there is a bad ambiguity:  Is C</$foo[bar]/> to be interpreted as
+C</${foo}[bar]/> (where C<[bar]> is a character class for the regular
+expression) or as C</${foo[bar]}/> (where C<[bar]> is the subscript to array
+@foo)?  If @foo doesn't otherwise exist, then it's obviously a
+character class.  If @foo exists, Perl takes a good guess about C<[bar]>,
+and is almost always right.  If it does guess wrong, or if you're just
+plain paranoid, you can force the correct interpretation with curly
+brackets as above.
+
+A line-oriented form of quoting is based on the shell "here-doc" syntax.
+Following a C<E<lt>E<lt>> you specify a string to terminate the quoted material,
+and all lines following the current line down to the terminating string
+are the value of the item.  The terminating string may be either an
+identifier (a word), or some quoted text.  If quoted, the type of
+quotes you use determines the treatment of the text, just as in regular
+quoting.  An unquoted identifier works like double quotes.  There must
+be no space between the C<E<lt>E<lt>> and the identifier.  (If you put a space it
+will be treated as a null identifier, which is valid, and matches the
+first blank line.)  The terminating string must appear by itself 
+(unquoted and with no surrounding whitespace) on the terminating line.
+
+	print <<EOF;	
+    The price is $Price.
+    EOF
+
+	print <<"EOF";	# same as above
+    The price is $Price.
+    EOF
+
+	print <<`EOC`;	# execute commands
+    echo hi there
+    echo lo there
+    EOC
+
+	print <<"foo", <<"bar";	# you can stack them
+    I said foo.
+    foo
+    I said bar.
+    bar
+
+	myfunc(<<"THIS", 23, <<'THAT');
+    Here's a line
+    or two.
+    THIS
+    and here another.
+    THAT
+
+Just don't forget that you have to put a semicolon on the end 
+to finish the statement, as Perl doesn't know you're not going to 
+try to do this:
+
+	print <<ABC
+    179231
+    ABC
+	+ 20;
+
+
+=head2 List value constructors
+
+List values are denoted by separating individual values by commas
+(and enclosing the list in parentheses where precedence requires it):
+
+    (LIST)
+
+In a context not requiring a list value, the value of the list
+literal is the value of the final element, as with the C comma operator.
+For example,
+
+    @foo = ('cc', '-E', $bar);
+
+assigns the entire list value to array foo, but
+
+    $foo = ('cc', '-E', $bar);
+
+assigns the value of variable bar to variable foo.  Note that the value
+of an actual array in a scalar context is the length of the array; the
+following assigns to $foo the value 3:
+
+    @foo = ('cc', '-E', $bar);
+    $foo = @foo;		# $foo gets 3
+
+You may have an optional comma before the closing parenthesis of an
+list literal, so that you can say:
+
+    @foo = (
+	1,
+	2,
+	3,
+    );
+
+LISTs do automatic interpolation of sublists.  That is, when a LIST is
+evaluated, each element of the list is evaluated in a list context, and
+the resulting list value is interpolated into LIST just as if each
+individual element were a member of LIST.  Thus arrays lose their
+identity in a LIST--the list
+
+    (@foo,@bar,&SomeSub)
+
+contains all the elements of @foo followed by all the elements of @bar,
+followed by all the elements returned by the subroutine named SomeSub when
+it's called in a list context.
+To make a list reference that does I<NOT> interpolate, see L<perlref>.
+
+The null list is represented by ().  Interpolating it in a list
+has no effect.  Thus ((),(),()) is equivalent to ().  Similarly,
+interpolating an array with no elements is the same as if no
+array had been interpolated at that point.
+
+A list value may also be subscripted like a normal array.  You must
+put the list in parentheses to avoid ambiguity.  Examples:
+
+    # Stat returns list value.
+    $time = (stat($file))[8];
+
+    # SYNTAX ERROR HERE.
+    $time = stat($file)[8];  # OOPS, FORGOT PARENS
+
+    # Find a hex digit.
+    $hexdigit = ('a','b','c','d','e','f')[$digit-10];
+
+    # A "reverse comma operator".
+    return (pop(@foo),pop(@foo))[0];
+
+Lists may be assigned to if and only if each element of the list
+is legal to assign to:
+
+    ($a, $b, $c) = (1, 2, 3);
+
+    ($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
+
+Array assignment in a scalar context returns the number of elements
+produced by the expression on the right side of the assignment:
+
+    $x = (($foo,$bar) = (3,2,1));	# set $x to 3, not 2
+    $x = (($foo,$bar) = f());	        # set $x to f()'s return count
+
+This is very handy when you want to do a list assignment in a Boolean
+context, since most list functions return a null list when finished,
+which when assigned produces a 0, which is interpreted as FALSE.
+
+The final element may be an array or a hash:
+
+    ($a, $b, @rest) = split;
+    local($a, $b, %rest) = @_;
+
+You can actually put an array or hash anywhere in the list, but the first one
+in the list will soak up all the values, and anything after it will get
+a null value.  This may be useful in a local() or my().
+
+A hash literal contains pairs of values to be interpreted
+as a key and a value:
+
+    # same as map assignment above
+    %map = ('red',0x00f,'blue',0x0f0,'green',0xf00);
+
+While literal lists and named arrays are usually interchangeable, that's
+not the case for hashes.  Just because you can subscript a list value like
+a normal array does not mean that you can subscript a list value as a
+hash.  Likewise, hashes included as parts of other lists (including
+parameters lists and return lists from functions) always flatten out into
+key/value pairs.  That's why it's good to use references sometimes.
+
+It is often more readable to use the C<=E<gt>> operator between key/value
+pairs.  The C<=E<gt>> operator is mostly just a more visually distinctive
+synonym for a comma, but it also quotes its left-hand operand, which makes
+it nice for initializing hashes:
+
+    %map = (
+		 red   => 0x00f,
+		 blue  => 0x0f0,
+		 green => 0xf00,
+   );
+
+or for initializing hash references to be used as records:
+
+    $rec = {
+		witch => 'Mable the Merciless',
+		cat   => 'Fluffy the Ferocious',
+		date  => '10/31/1776',
+    };
+
+or for using call-by-named-parameter to complicated functions:
+
+   $field = $query->radio_group( 
+	       name      => 'group_name',
+               values    => ['eenie','meenie','minie'],
+               default   => 'meenie',
+               linebreak => 'true',
+               labels    => \%labels
+   );
+
+Note that just because a hash is initialized in that order doesn't
+mean that it comes out in that order.  See L<perlfunc/sort> for examples
+of how to arrange for an output ordering.
+
+=head2 Typeglobs and FileHandles
+
+Perl uses an internal type called a I<typeglob> to hold an entire
+symbol table entry.  The type prefix of a typeglob is a C<*>, because
+it represents all types.  This used to be the preferred way to 
+pass arrays and hashes by reference into a function, but now that
+we have real references, this is seldom needed.
+
+One place where you still use typeglobs (or references thereto)
+is for passing or storing filehandles.  If you want to save away
+a filehandle, do it this way:
+
+    $fh = *STDOUT;
+
+or perhaps as a real reference, like this:
+
+    $fh = \*STDOUT;
+
+This is also the way to create a local filehandle.  For example:
+
+    sub newopen {
+	my $path = shift;
+	local *FH;  # not my!
+	open (FH, $path) || return undef;
+	return \*FH;
+    }
+    $fh = newopen('/etc/passwd');
+
+See L<perlref>, L<perlsub>, and L<perlmod/"Symbols Tables"> for more
+discussion on typeglobs.  See L<perlfunc/open> for other ways of
+generating filehandles.
diff --git a/gnu/usr.bin/perl/pod/perldebug.pod b/gnu/usr.bin/perl/pod/perldebug.pod
new file mode 100644
index 00000000000..17fe25926fe
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perldebug.pod
@@ -0,0 +1,249 @@
+=head1 NAME
+
+perldebug - Perl debugging
+
+=head1 DESCRIPTION
+
+First of all, have you tried using the B<-w> switch?
+
+=head2 Debugging
+
+If you invoke Perl with a B<-d> switch, your script will be run under the
+debugger.  However, the Perl debugger is not a separate program as it is
+in a C environment.  Instead, the B<-d> flag tells the compiler to insert
+source information into the pseudocode it's about to hand to the
+interpreter.  (That means your code must compile correctly for the
+debugger to work on it.)  Then when the interpreter starts up, it
+pre-loads a Perl library file containing the debugger itself.  The program
+will halt before the first executable statement (but see below) and ask
+you for one of the following commands:
+
+=over 12
+
+=item h
+
+Prints out a help message.
+
+=item T
+
+Stack trace.
+If you do bizarre things to your @_ arguments in a subroutine, the stack
+backtrace will not always show the original values.
+
+=item s
+
+Single step.  Executes until it reaches the beginning of another
+statement.
+
+=item n
+
+Next.  Executes over subroutine calls, until it reaches the beginning
+of the next statement.
+
+=item f
+
+Finish.  Executes statements until it has finished the current
+subroutine.
+
+=item c
+
+Continue.  Executes until the next breakpoint is reached.
+
+=item c line
+
+Continue to the specified line.  Inserts a one-time-only breakpoint at
+the specified line.
+
+=item <CR>
+
+Repeat last n or s.
+
+=item l min+incr
+
+List incr+1 lines starting at min.  If min is omitted, starts where
+last listing left off.  If incr is omitted, previous value of incr is
+used.
+
+=item l min-max
+
+List lines in the indicated range.
+
+=item l line
+
+List just the indicated line.
+
+=item l
+
+List next window.
+
+=item -
+
+List previous window.
+
+=item w line
+
+List window (a few lines worth of code) around line.
+
+=item l subname
+
+List subroutine.  If it's a long subroutine it just lists the
+beginning.  Use "l" to list more.
+
+=item /pattern/
+
+Regular expression search forward in the source code for pattern; the
+final / is optional.
+
+=item ?pattern?
+
+Regular expression search backward in the source code for pattern; the
+final ? is optional.
+
+=item L
+
+List lines that have breakpoints or actions.
+
+=item S
+
+Lists the names of all subroutines.
+
+=item t
+
+Toggle trace mode on or off.
+
+=item b line [ condition ]
+
+Set a breakpoint.  If line is omitted, sets a breakpoint on the line
+that is about to be executed.  If a condition is specified, it is
+evaluated each time the statement is reached and a breakpoint is taken
+only if the condition is true.  Breakpoints may only be set on lines
+that begin an executable statement.  Conditions don't use C<if>:
+
+    b 237 $x > 30
+    b 33 /pattern/i
+
+=item b subname [ condition ]
+
+Set breakpoint at first executable line of subroutine.
+
+=item d line
+
+Delete breakpoint.  If line is omitted, deletes the breakpoint on the
+line that is about to be executed.
+
+=item D
+
+Delete all breakpoints.
+
+=item a line command
+
+Set an action for line.  A multiline command may be entered by
+backslashing the newlines.  This command is Perl code, not another
+debugger command.
+
+=item A
+
+Delete all line actions.
+
+=item < command
+
+Set an action to happen before every debugger prompt.  A multiline
+command may be entered by backslashing the newlines.
+
+=item > command
+
+Set an action to happen after the prompt when you've just given a
+command to return to executing the script.  A multiline command may be
+entered by backslashing the newlines.
+
+=item V package [symbols]
+
+Display all (or some) variables in package (defaulting to the C<main>
+package) using a data pretty-printer (hashes show their keys and values so
+you see what's what, control characters are made printable, etc.).  Make
+sure you don't put the type specifier (like $) there, just the symbol
+names, like this:
+
+    V DB filename line 
+
+=item X [symbols] 
+
+Same as as "V" command, but within the current package.  
+
+=item ! number
+
+Redo a debugging command.  If number is omitted, redoes the previous
+command.
+
+=item ! -number
+
+Redo the command that was that many commands ago.
+
+=item H -number
+
+Display last n commands.  Only commands longer than one character are
+listed.  If number is omitted, lists them all.
+
+=item q or ^D
+
+Quit.  ("quit" doesn't work for this.)
+
+=item command
+
+Execute command as a Perl statement.  A missing semicolon will be
+supplied.
+
+=item p expr
+
+Same as C<print DB::OUT expr>.  The DB::OUT filehandle is opened to
+/dev/tty, regardless of where STDOUT may be redirected to.
+
+=back
+
+Any command you type in that isn't recognized by the debugger will be
+directly executed (C<eval>'d) as Perl code.  Leading white space will
+cause the debugger to think it's C<NOT> a debugger command.
+
+If you have any compile-time executable statements (code within a BEGIN 
+block or a C<use> statement), these will I<NOT> be stopped by debugger,
+although C<require>s will.  From your own code, however, you can transfer
+control back to the debugger using the following statement, which is harmless
+if the debugger is not running:
+
+    $DB::single = 1;
+
+=head2 Customization
+
+If you want to modify the debugger, copy F<perl5db.pl> from the Perl
+library to another name and modify it as necessary.  You'll also want
+to set environment variable PERL5DB to say something like this:
+
+    BEGIN { require "myperl5db.pl" }
+
+You can do some customization by setting up a F<.perldb> file which
+contains initialization code.  For instance, you could make aliases
+like these (the last one in particular most people seem to expect to 
+be there):
+
+    $DB::alias{'len'} = 's/^len(.*)/p length($1)/';
+    $DB::alias{'stop'} = 's/^stop (at|in)/b/';
+    $DB::alias{'.'} = 's/^\./p '
+		    . '"\$DB::sub(\$DB::filename:\$DB::line):\t"'
+		    . ',\$DB::dbline[\$DB::line]/' ;
+
+
+=head2 Other resources
+
+You did try the B<-w> switch, didn't you?
+
+=head1 BUGS
+
+If your program exit()s or die()s, so does the debugger.
+
+There's no builtin way to restart the debugger without exiting and coming back
+into it.  You could use an alias like this:
+
+    $DB::alias{'rerun'} = 'exec "perl -d $DB::filename"';
+
+But you'd lose any pending breakpoint information, and that might not
+be the right path, etc.
diff --git a/gnu/usr.bin/perl/pod/perldiag.pod b/gnu/usr.bin/perl/pod/perldiag.pod
new file mode 100644
index 00000000000..38edda19827
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perldiag.pod
@@ -0,0 +1,2339 @@
+=head1 NAME
+
+perldiag - various Perl diagnostics
+
+=head1 DESCRIPTION
+
+These messages are classified as follows (listed in increasing order of
+desperation):
+
+    (W) A warning (optional).
+    (D) A deprecation (optional).
+    (S) A severe warning (mandatory).
+    (F) A fatal error (trappable).
+    (P) An internal error you should never see (trappable).
+    (X) A very fatal error (non-trappable).
+    (A) An alien error message (not generated by Perl).
+
+Optional warnings are enabled by using the B<-w> switch.  Warnings may
+be captured by setting C<$^Q> to a reference to a routine that will be
+called on each warning instead of printing it.  See L<perlvar>.
+Trappable errors may be trapped using the eval operator.  See
+L<perlfunc/eval>.
+
+Some of these messages are generic.  Spots that vary are denoted with a %s,
+just as in a printf format.  Note that some message start with a %s!
+The symbols C<"%-?@> sort before the letters, while C<[> and C<\> sort after.
+
+=over 4
+
+=item "my" variable %s can't be in a package
+
+(F) Lexically scoped variables aren't in a package, so it doesn't make sense
+to try to declare one with a package qualifier on the front.  Use local()
+if you want to localize a package variable.
+
+=item "no" not allowed in expression
+
+(F) The "no" keyword is recognized and executed at compile time, and returns
+no useful value.  See L<perlmod>.
+
+=item "use" not allowed in expression
+
+(F) The "use" keyword is recognized and executed at compile time, and returns
+no useful value.  See L<perlmod>.
+
+=item % may only be used in unpack
+
+(F) You can't pack a string by supplying a checksum, since the
+checksumming process loses information, and you can't go the other
+way.  See L<perlfunc/unpack>.
+
+=item %s (...) interpreted as function
+
+(W) You've run afoul of the rule that says that any list operator followed
+by parentheses turns into a function, with all the list operators arguments 
+found inside the parens.  See L<perlop/Terms and List Operators (Leftward)>.
+
+=item %s argument is not a HASH element
+
+(F) The argument to delete() or exists() must be a hash element, such as
+
+    $foo{$bar}
+    $ref->[12]->{"susie"}
+
+=item %s did not return a true value
+
+(F) A required (or used) file must return a true value to indicate that
+it compiled correctly and ran its initialization code correctly.  It's
+traditional to end such a file with a "1;", though any true value would
+do.  See L<perlfunc/require>.
+
+=item %s found where operator expected
+
+(S) The Perl lexer knows whether to expect a term or an operator.  If it
+sees what it knows to be a term when it was expecting to see an operator,
+it gives you this warning.  Usually it indicates that an operator or
+delimiter was omitted, such as a semicolon.
+
+=item %s had compilation errors.
+
+(F) The final summary message when a C<perl -c> fails.
+
+=item %s has too many errors.
+
+(F) The parser has given up trying to parse the program after 10 errors.
+Further error messages would likely be uninformative.
+
+=item %s matches null string many times
+
+(W) The pattern you've specified would be an infinite loop if the
+regular expression engine didn't specifically check for that.  See L<perlre>.
+
+=item %s never introduced
+
+(S) The symbol in question was declared but somehow went out of scope
+before it could possibly have been used.
+
+=item %s syntax OK
+
+(F) The final summary message when a C<perl -c> succeeds.
+
+=item %s: Command not found.
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item %s: Expression syntax.
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item %s: Undefined variable.
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item %s: not found
+
+(A) You've accidentally run your script through the Bourne shell 
+instead of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item B<-P> not allowed for setuid/setgid script
+
+(F) The script would have to be opened by the C preprocessor by name,
+which provides a race condition that breaks security.
+
+=item C<-T> and C<-B> not implemented on filehandles
+
+(F) Perl can't peek at the stdio buffer of filehandles when it doesn't
+know about your kind of stdio.  You'll have to use a filename instead.
+
+=item 500 Server error
+
+See Server error.
+
+=item ?+* follows nothing in regexp
+
+(F) You started a regular expression with a quantifier.  Backslash it
+if you meant it literally.   See L<perlre>.
+
+=item @ outside of string
+
+(F) You had a pack template that specified an absolution position outside
+the string being unpacked.  See L<perlfunc/pack>.
+
+=item accept() on closed fd
+
+(W) You tried to do an accept on a closed socket.  Did you forget to check
+the return value of your socket() call?  See L<perlfunc/accept>.
+
+=item Allocation too large: %lx
+
+(F) You can't allocate more than 64K on an MSDOS machine.
+
+=item Arg too short for msgsnd
+
+(F) msgsnd() requires a string at least as long as sizeof(long).
+
+=item Ambiguous use of %s resolved as %s
+
+(W)(S) You said something that may not be interpreted the way
+you thought.  Normally it's pretty easy to disambiguate it by supplying
+a missing quote, operator, paren pair or declaration.
+
+=item Args must match #! line
+
+(F) The setuid emulator requires that the arguments Perl was invoked
+with match the arguments specified on the #! line.
+
+=item Argument "%s" isn't numeric
+
+(W) The indicated string was fed as an argument to an operator that
+expected a numeric value instead.  If you're fortunate the message
+will identify which operator was so unfortunate.
+
+=item Array @%s missing the @ in argument %d of %s()
+
+(D) Really old Perl let you omit the @ on array names in some spots.  This
+is now heavily deprecated.
+
+=item assertion botched: %s
+
+(P) The malloc package that comes with Perl had an internal failure.
+
+=item Assertion failed: file "%s"
+
+(P) A general assertion failed.  The file in question must be examined.
+
+=item Assignment to both a list and a scalar
+
+(F) If you assign to a conditional operator, the 2nd and 3rd arguments
+must either both be scalars or both be lists.  Otherwise Perl won't
+know which context to supply to the right side.
+
+=item Attempt to free non-arena SV: 0x%lx
+
+(P) All SV objects are supposed to be allocated from arenas that will
+be garbage collected on exit.  An SV was discovered to be outside any
+of those arenas.
+
+=item Attempt to free temp prematurely
+
+(W) Mortalized values are supposed to be freed by the free_tmps()
+routine.  This indicates that something else is freeing the SV before
+the free_tmps() routine gets a chance, which means that the free_tmps()
+routine will be freeing an unreferenced scalar when it does try to free
+it.
+
+=item Attempt to free unreferenced glob pointers
+
+(P) The reference counts got screwed up on symbol aliases.
+
+=item Attempt to free unreferenced scalar
+
+(W) Perl went to decrement the reference count of a scalar to see if it
+would go to 0, and discovered that it had already gone to 0 earlier,
+and should have been freed, and in fact, probably was freed.  This
+could indicate that SvREFCNT_dec() was called too many times, or that
+SvREFCNT_inc() was called too few times, or that the SV was mortalized
+when it shouldn't have been, or that memory has been corrupted.
+
+=item Bad arg length for %s, is %d, should be %d
+
+(F) You passed a buffer of the wrong size to one of msgctl(), semctl() or
+shmctl().  In C parlance, the correct sized are, respectively,
+S<sizeof(struct msqid_ds *)>, S<sizeof(struct semid_ds *)> and
+S<sizeof(struct shmid_ds *)>.
+
+=item Bad associative array
+
+(P) One of the internal hash routines was passed a null HV pointer.
+
+=item Bad filehandle: %s
+
+(F) A symbol was passed to something wanting a filehandle, but the symbol
+has no filehandle associated with it.  Perhaps you didn't do an open(), or
+did it in another package.
+
+=item Bad free() ignored
+
+(S) An internal routine called free() on something that had never been
+malloc()ed in the first place.
+
+=item Bad name after %s::
+
+(F) You started to name a symbol by using a package prefix, and then didn't
+finish the symbol.  In particular, you can't interpolate outside of quotes,
+so
+
+    $var = 'myvar';
+    $sym = mypack::$var;
+
+is not the same as
+
+    $var = 'myvar';
+    $sym = "mypack::$var";
+
+=item Bad symbol for array
+
+(P) An internal request asked to add an array entry to something that
+wasn't a symbol table entry.
+
+=item Bad symbol for filehandle
+
+(P) An internal request asked to add a filehandle entry to something that
+wasn't a symbol table entry.
+
+=item Bad symbol for hash
+
+(P) An internal request asked to add a hash entry to something that
+wasn't a symbol table entry.
+
+=item Badly places ()'s
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item BEGIN failed--compilation aborted
+
+(F) An untrapped exception was raised while executing a BEGIN subroutine.
+Compilation stops immediately and the interpreter is exited.
+
+=item bind() on closed fd
+
+(W) You tried to do a bind on a closed socket.  Did you forget to check
+the return value of your socket() call?  See L<perlfunc/bind>.
+
+=item Bizarre copy of %s in %s
+
+(P) Perl detected an attempt to copy an internal value that is not copiable.
+
+=item Callback called exit
+
+(F) A subroutine invoked from an external package via perl_call_sv()
+exited by calling exit.
+
+=item Can't "last" outside a block
+
+(F) A "last" statement was executed to break out of the current block,
+except that there's this itty bitty problem called there isn't a
+current block.  Note that an "if" or "else" block doesn't count as a
+"loopish" block.  You can usually double the curlies to get the same
+effect though, since the inner curlies will be considered a block
+that loops once.  See L<perlfunc/last>.
+
+=item Can't "next" outside a block
+
+(F) A "next" statement was executed to reiterate the current block, but
+there isn't a current block.  Note that an "if" or "else" block doesn't
+count as a "loopish" block.  You can usually double the curlies to get
+the same effect though, since the inner curlies will be considered a block
+that loops once.  See L<perlfunc/last>.
+
+=item Can't "redo" outside a block
+
+(F) A "redo" statement was executed to restart the current block, but
+there isn't a current block.  Note that an "if" or "else" block doesn't
+count as a "loopish" block.  You can usually double the curlies to get
+the same effect though, since the inner curlies will be considered a block
+that loops once.  See L<perlfunc/last>.
+
+=item Can't bless non-reference value
+
+(F) Only hard references may be blessed.  This is how Perl "enforces"
+encapsulation of objects.  See L<perlobj>.
+
+=item Can't break at that line
+
+(S) A warning intended for while running within the debugger, indicating
+the line number specified wasn't the location of a statement that could
+be stopped at.
+
+=item Can't call method "%s" in empty package "%s"
+
+(F) You called a method correctly, and it correctly indicated a package
+functioning as a class, but that package doesn't have ANYTHING defined
+in it, let alone methods.  See L<perlobj>.
+
+=item Can't call method "%s" on unblessed reference
+
+(F) A method call must know what package it's supposed to run in.  It
+ordinarily finds this out from the object reference you supply, but
+you didn't supply an object reference in this case.  A reference isn't
+an object reference until it has been blessed.  See L<perlobj>.
+
+=item Can't call method "%s" without a package or object reference
+
+(F) You used the syntax of a method call, but the slot filled by the
+object reference or package name contains an expression that returns
+neither an object reference nor a package name.  (Perhaps it's null?)
+Something like this will reproduce the error:
+
+    $BADREF = undef;
+    process $BADREF 1,2,3;
+    $BADREF->process(1,2,3);
+
+=item Can't chdir to %s
+
+(F) You called C<perl -x/foo/bar>, but C</foo/bar> is not a directory
+that you can chdir to, possibly because it doesn't exist.
+
+=item Can't coerce %s to integer in %s
+
+(F) Certain types of SVs, in particular real symbol table entries
+(type GLOB), can't be forced to stop being what they are.  So you can't
+say things like:
+
+    *foo += 1;
+
+You CAN say
+
+    $foo = *foo;
+    $foo += 1;
+
+but then $foo no longer contains a glob.
+
+=item Can't coerce %s to number in %s
+
+(F) Certain types of SVs, in particular real symbol table entries
+(type GLOB), can't be forced to stop being what they are.
+
+=item Can't coerce %s to string in %s
+
+(F) Certain types of SVs, in particular real symbol table entries
+(type GLOB), can't be forced to stop being what they are.
+
+=item Can't create pipe mailbox
+
+(P) An error peculiar to VMS.  The process is suffering from exhausted quotas
+or other plumbing problems.
+
+=item Can't declare %s in my
+
+(F) Only scalar, array and hash variables may be declared as lexical variables.
+They must have ordinary identifiers as names.
+
+=item Can't do inplace edit on %s: %s
+
+(S) The creation of the new file failed for the indicated reason.
+
+=item Can't do inplace edit without backup
+
+(F) You're on a system such as MSDOS that gets confused if you try reading
+from a deleted (but still opened) file.  You have to say B<-i>C<.bak>, or some
+such.
+
+=item Can't do inplace edit: %s > 14 characters
+
+(S) There isn't enough room in the filename to make a backup name for the file.
+
+=item Can't do inplace edit: %s is not a regular file
+
+(S) You tried to use the B<-i> switch on a special file, such as a file in
+/dev, or a FIFO.  The file was ignored.
+
+=item Can't do setegid!
+
+(P) The setegid() call failed for some reason in the setuid emulator
+of suidperl.
+
+=item Can't do seteuid!
+
+(P) The setuid emulator of suidperl failed for some reason.
+
+=item Can't do setuid
+
+(F) This typically means that ordinary perl tried to exec suidperl to
+do setuid emulation, but couldn't exec it.  It looks for a name of the
+form sperl5.000 in the same directory that the perl executable resides
+under the name perl5.000, typically /usr/local/bin on Unix machines.
+If the file is there, check the execute permissions.  If it isn't, ask
+your sysadmin why he and/or she removed it.
+
+=item Can't do waitpid with flags
+
+(F) This machine doesn't have either waitpid() or wait4(), so only waitpid()
+without flags is emulated.
+
+=item Can't do {n,m} with n > m
+
+(F) Minima must be less than or equal to maxima.  If you really want
+your regexp to match something 0 times, just put {0}.  See L<perlre>.
+
+=item Can't emulate -%s on #! line
+
+(F) The #! line specifies a switch that doesn't make sense at this point.
+For example, it'd be kind of silly to put a B<-x> on the #! line.
+
+=item Can't exec "%s": %s
+
+(W) An system(), exec() or piped open call could not execute the named
+program for the indicated reason.  Typical reasons include: the permissions
+were wrong on the file, the file wasn't found in C<$ENV{PATH}>, the
+executable in question was compiled for another architecture, or the
+#! line in a script points to an interpreter that can't be run for
+similar reasons.  (Or maybe your system doesn't support #! at all.)
+
+=item Can't exec %s
+
+(F) Perl was trying to execute the indicated program for you because that's
+what the #! line said.  If that's not what you wanted, you may need to
+mention "perl" on the #! line somewhere.
+
+=item Can't execute %s
+
+(F) You used the B<-S> switch, but the script to execute could not be found
+in the PATH, or at least not with the correct permissions.
+
+=item Can't find label %s
+
+(F) You said to goto a label that isn't mentioned anywhere that it's possible
+for us to go to.  See L<perlfunc/goto>.
+
+=item Can't find string terminator %s anywhere before EOF
+
+(F) Perl strings can stretch over multiple lines.  This message means that
+the closing delimiter was omitted.  Since bracketed quotes count nesting
+levels, the following is missing its final parenthesis:
+
+    print q(The character '(' starts a side comment.)
+
+=item Can't fork
+
+(F) A fatal error occurred while trying to fork while opening a pipeline.
+
+=item Can't get filespec - stale stat buffer?
+
+(S) A warning peculiar to VMS.  This arises because of the difference between
+access checks under VMS and under the Unix model Perl assumes.  Under VMS,
+access checks are done by filename, rather than by bits in the stat buffer, so
+that ACLs and other protections can be taken into account.  Unfortunately, Perl
+assumes that the stat buffer contains all the necessary information, and passes
+it, instead of the filespec, to the access checking routine.  It will try to
+retrieve the filespec using the device name and FID present in the stat buffer,
+but this works only if you haven't made a subsequent call to the CRTL stat()
+routine, since the device name is overwritten with each call.  If this warning
+appears, the name lookup failed, and the access checking routine gave up and
+returned FALSE, just to be conservative.  (Note: The access checking routine
+knows about the Perl C<stat> operator and file tests, so you shouldn't ever
+see this warning in response to a Perl command; it arises only if some internal
+code takes stat buffers lightly.)
+
+=item Can't get pipe mailbox device name
+
+(P) An error peculiar to VMS.  After creating a mailbox to act as a pipe, Perl
+can't retrieve its name for later use.
+
+=item Can't get SYSGEN parameter value for MAXBUF
+
+(P) An error peculiar to VMS.  Perl asked $GETSYI how big you want your
+mailbox buffers to be, and didn't get an answer.
+
+=item Can't goto subroutine outside a subroutine
+
+(F) The deeply magical "goto subroutine" call can only replace one subroutine
+call for another.  It can't manufacture one out of whole cloth.  In general
+you should only be calling it out of an AUTOLOAD routine anyway.  See
+L<perlfunc/goto>.
+
+=item Can't localize a reference
+
+(F) You said something like C<local $$ref>, which is not allowed because
+the compiler can't determine whether $ref will end up pointing to anything
+with a symbol table entry, and a symbol table entry is necessary to
+do a local.
+
+=item Can't localize lexical variable %s
+
+(F) You used local on a variable name that was previous declared as a
+lexical variable using "my".  This is not allowed.  If you want to
+localize a package variable of the same name, qualify it with the
+package name.
+
+=item Can't locate %s in @INC
+
+(F) You said to do (or require, or use) a file that couldn't be found
+in any of the libraries mentioned in @INC.  Perhaps you need to set
+the PERL5LIB environment variable to say where the extra library is,
+or maybe the script needs to add the library name to @INC.  Or maybe
+you just misspelled the name of the file.  See L<perlfunc/require>.
+
+=item Can't locate object method "%s" via package "%s"
+
+(F) You called a method correctly, and it correctly indicated a package
+functioning as a class, but that package doesn't define that particular
+method, nor does any of it's base classes.  See L<perlobj>.
+
+=item Can't locate package %s for @%s::ISA
+
+(W) The @ISA array contained the name of another package that doesn't seem
+to exist.
+
+=item Can't mktemp()
+
+(F) The mktemp() routine failed for some reason while trying to process
+a B<-e> switch.  Maybe your /tmp partition is full, or clobbered.
+
+=item Can't modify %s in %s
+
+(F) You aren't allowed to assign to the item indicated, or otherwise try to
+change it, such as with an autoincrement.
+
+=item Can't modify non-existent substring
+
+(P) The internal routine that does assignment to a substr() was handed
+a NULL.
+
+=item Can't msgrcv to readonly var
+
+(F) The target of a msgrcv must be modifiable in order to be used as a receive
+buffer.
+
+=item Can't open %s: %s
+
+(S) An inplace edit couldn't open the original file for the indicated reason.
+Usually this is because you don't have read permission for the file.
+
+=item Can't open bidirectional pipe
+
+(W) You tried to say C<open(CMD, "|cmd|")>, which is not supported.  You can
+try any of several modules in the Perl library to do this, such as
+"open2.pl".  Alternately, direct the pipe's output to a file using ">",
+and then read it in under a different file handle.
+
+=item Can't open error file %s as stderr
+
+(F) An error peculiar to VMS.  Perl does its own command line redirection, and
+couldn't open the file specified after '2>' or '2>>' on the command line for
+writing.
+
+=item Can't open input file %s as stdin
+
+(F) An error peculiar to VMS.  Perl does its own command line redirection, and
+couldn't open the file specified after '<' on the command line for reading.
+
+=item Can't open output file %s as stdout
+
+(F) An error peculiar to VMS.  Perl does its own command line redirection, and
+couldn't open the file specified after '>' or '>>' on the command line for
+writing.
+
+=item Can't open output pipe (name: %s)
+
+(P) An error peculiar to VMS.  Perl does its own command line redirection, and
+couldn't open the pipe into which to send data destined for stdout.
+
+=item Can't open perl script "%s": %s
+
+(F) The script you specified can't be opened for the indicated reason.
+
+=item Can't rename %s to %s: %s, skipping file
+
+(S) The rename done by the B<-i> switch failed for some reason, probably because
+you don't have write permission to the directory.
+
+=item Can't reopen input pipe (name: %s) in binary mode
+
+(P) An error peculiar to VMS.  Perl thought stdin was a pipe, and tried to
+reopen it to accept binary data.  Alas, it failed.
+
+=item Can't reswap uid and euid
+
+(P) The setreuid() call failed for some reason in the setuid emulator
+of suidperl.
+
+=item Can't return outside a subroutine
+
+(F) The return statement was executed in mainline code, that is, where
+there was no subroutine call to return out of.  See L<perlsub>.
+
+=item Can't stat script "%s"
+
+(P) For some reason you can't fstat() the script even though you have
+it open already.  Bizarre.
+
+=item Can't swap uid and euid
+
+(P) The setreuid() call failed for some reason in the setuid emulator
+of suidperl.
+
+=item Can't take log of %g
+
+(F) Logarithms are only defined on positive real numbers.
+
+=item Can't take sqrt of %g
+
+(F) For ordinary real numbers, you can't take the square root of a
+negative number.  There's a Complex package available for Perl, though,
+if you really want to do that.
+
+=item Can't undef active subroutine
+
+(F) You can't undefine a routine that's currently running.  You can,
+however, redefine it while it's running, and you can even undef the
+redefined subroutine while the old routine is running.  Go figure.
+
+=item Can't unshift
+
+(F) You tried to unshift an "unreal" array that can't be unshifted, such
+as the main Perl stack.
+
+=item Can't upgrade that kind of scalar
+
+(P) The internal sv_upgrade routine adds "members" to an SV, making
+it into a more specialized kind of SV.  The top several SV types are
+so specialized, however, that they cannot be interconverted.  This
+message indicates that such a conversion was attempted.
+
+=item Can't upgrade to undef
+
+(P) The undefined SV is the bottom of the totem pole, in the scheme
+of upgradability.  Upgrading to undef indicates an error in the
+code calling sv_upgrade.
+
+=item Can't use "my %s" in sort comparison
+
+(F) The global variables $a and $b are reserved for sort comparisons.
+You mentioned $a or $b in the same line as the <=> or cmp operator,
+and the variable had earlier been declared as a lexical variable.
+Either qualify the sort variable with the package name, or rename the
+lexical variable.
+
+=item Can't use %s for loop variable
+
+(F) Only a simple scalar variable may be used as a loop variable on a foreach.
+
+=item Can't use %s ref as %s ref
+
+(F) You've mixed up your reference types.  You have to dereference a
+reference of the type needed.  You can use the ref() function to
+test the type of the reference, if need be.
+
+=item Can't use \1 to mean $1 in expression
+
+(W) In an ordinary expression, backslash is a unary operator that creates
+a reference to its argument.  The use of backslash to indicate a backreference
+to a matched substring is only valid as part of a regular expression pattern.
+Trying to do this in ordinary Perl code produces a value that prints
+out looking like SCALAR(0xdecaf).  Use the $1 form instead.
+
+=item Can't use string ("%s") as %s ref while "strict refs" in use
+
+(F) Only hard references are allowed by "strict refs".  Symbolic references
+are disallowed.  See L<perlref>.
+
+=item Can't use an undefined value as %s reference
+
+(F) A value used as either a hard reference or a symbolic reference must
+be a defined value.  This helps to de-lurk some insidious errors.
+
+=item Can't use delimiter brackets within expression
+
+(F) The ${name} construct is for disambiguating identifiers in strings, not
+in ordinary code.
+
+=item Can't use global %s in "my"
+
+(F) You tried to declare a magical variable as a lexical variable.  This is
+not allowed, because the magic can only be tied to one location (namely
+the global variable) and it would be incredibly confusing to have
+variables in your program that looked like magical variables but
+weren't.
+
+=item Can't use subscript on %s
+
+(F) The compiler tried to interpret a bracketed expression as a
+subscript.  But to the left of the brackets was an expression that
+didn't look like an array reference, or anything else subscriptable.
+
+=item Can't write to temp file for B<-e>: %s
+
+(F) The write routine failed for some reason while trying to process
+a B<-e> switch.  Maybe your /tmp partition is full, or clobbered.
+
+=item Can't x= to readonly value
+
+(F) You tried to repeat a constant value (often the undefined value) with
+an assignment operator, which implies modifying the value itself.
+Perhaps you need to copy the value to a temporary, and repeat that.
+
+=item Cannot open temporary file
+
+(F) The create routine failed for some reaon while trying to process
+a B<-e> switch.  Maybe your /tmp partition is full, or clobbered.
+
+=item chmod: mode argument is missing initial 0
+
+(W) A novice will sometimes say
+
+    chmod 777, $filename
+
+not realizing that 777 will be interpreted as a decimal number, equivalent
+to 01411.  Octal constants are introduced with a leading 0 in Perl, as in C.
+
+=item Close on unopened file <%s>
+
+(W) You tried to close a filehandle that was never opened.
+
+=item connect() on closed fd
+
+(W) You tried to do a connect on a closed socket.  Did you forget to check
+the return value of your socket() call?  See L<perlfunc/connect>.
+
+=item Corrupt malloc ptr 0x%lx at 0x%lx
+
+(P) The malloc package that comes with Perl had an internal failure.
+
+=item corrupted regexp pointers
+
+(P) The regular expression engine got confused by what the regular
+expression compiler gave it.
+
+=item corrupted regexp program
+
+(P) The regular expression engine got passed a regexp program without
+a valid magic number.
+
+=item Deep recursion on subroutine "%s"
+
+(W) This subroutine has called itself (directly or indirectly) 100
+times than it has returned.  This probably indicates an infinite
+recursion, unless you're writing strange benchmark programs, in which
+case it indicates something else.
+
+=item Did you mean &%s instead?
+
+(W) You probably referred to an imported subroutine &FOO as $FOO or some such.
+
+=item Did you mean $ or @ instead of %?
+
+(W) You probably said %hash{$key} when you meant $hash{$key} or @hash{@keys}.
+On the other hand, maybe you just meant %hash and got carried away.
+
+=item Do you need to predeclare %s?
+
+(S) This is an educated guess made in conjunction with the message "%s
+found where operator expected".  It often means a subroutine or module
+name is being referenced that hasn't been declared yet.  This may be
+because of ordering problems in your file, or because of a missing
+"sub", "package", "require", or "use" statement.  If you're
+referencing something that isn't defined yet, you don't actually have
+to define the subroutine or package before the current location.  You
+can use an empty "sub foo;" or "package FOO;" to enter a "forward"
+declaration.
+
+=item Don't know how to handle magic of type '%s'
+
+(P) The internal handling of magical variables has been cursed.
+
+=item do_study: out of memory
+
+(P) This should have been caught by safemalloc() instead.
+
+=item Duplicate free() ignored
+
+(S) An internal routine called free() on something that had already
+been freed.
+
+=item elseif should be elsif
+
+(S) There is no keyword "elseif" in Perl because Larry thinks it's
+ugly.  Your code will be interpreted as an attempt to call a method
+named "elseif" for the class returned by the following block.  This is
+unlikely to be what you want.
+
+=item END failed--cleanup aborted
+
+(F) An untrapped exception was raised while executing an END subroutine.
+The interpreter is immediately exited.
+
+=item Error converting file specification %s
+
+(F) An error peculiar to VMS.  Since Perl may have to deal with file
+specifications in either VMS or Unix syntax, it converts them to a
+single form when it must operate on them directly.  Either you've
+passed an invalid file specification to Perl, or you've found a
+case the conversion routines don't handle.  Drat.
+
+=item Execution of %s aborted due to compilation errors.
+
+(F) The final summary message when a Perl compilation fails.
+
+=item Exiting eval via %s
+
+(W) You are exiting an eval by unconventional means, such as a
+a goto, or a loop control statement.
+
+=item Exiting subroutine via %s
+
+(W) You are exiting a subroutine by unconventional means, such as a
+a goto, or a loop control statement.
+
+=item Exiting substitution via %s
+
+(W) You are exiting a substitution by unconventional means, such as a
+a return, a goto, or a loop control statement.
+
+=item Fatal VMS error at %s, line %d
+
+(P) An error peculiar to VMS.  Something untoward happened in a VMS system
+service or RTL routine; Perl's exit status should provide more details.  The
+filename in "at %s" and the line number in "line %d" tell you which section of
+the Perl source code is distressed.
+
+=item fcntl is not implemented
+
+(F) Your machine apparently doesn't implement fcntl().  What is this, a
+PDP-11 or something?
+
+=item Filehandle %s never opened
+
+(W) An I/O operation was attempted on a filehandle that was never initialized.
+You need to do an open() or a socket() call, or call a constructor from
+the FileHandle package.
+
+=item Filehandle %s opened only for input
+
+(W) You tried to write on a read-only filehandle.  If you
+intended it to be a read-write filehandle, you needed to open it with
+"+<" or "+>" or "+>>" instead of with "<" or nothing.  If you only
+intended to write the file, use ">" or ">>".  See L<perlfunc/open>.
+
+=item Filehandle only opened for input
+
+(W) You tried to write on a read-only filehandle.  If you
+intended it to be a read-write filehandle, you needed to open it with
+"+<" or "+>" or "+>>" instead of with "<" or nothing.  If you only
+intended to write the file, use ">" or ">>".  See L<perlfunc/open>.
+
+=item Final $ should be \$ or $name
+
+(F) You must now decide whether the final $ in a string was meant to be
+a literal dollar sign, or was meant to introduce a variable name
+that happens to be missing.  So you have to put either the backslash or
+the name.
+
+=item Final @ should be \@ or @name
+
+(F) You must now decide whether the final @ in a string was meant to be
+a literal "at" sign, or was meant to introduce a variable name
+that happens to be missing.  So you have to put either the backslash or
+the name.
+
+=item Format %s redefined
+
+(W) You redefined a format.  To suppress this warning, say
+
+    {
+	local $^W = 0;
+	eval "format NAME =...";
+    }
+
+=item Format not terminated
+
+(F) A format must be terminated by a line with a solitary dot.  Perl got
+to the end of your file without finding such a line.
+
+=item Found = in conditional, should be ==
+
+(W) You said
+
+    if ($foo = 123)
+
+when you meant
+
+    if ($foo == 123)
+
+(or something like that).
+
+=item gdbm store returned %d, errno %d, key "%s"
+
+(S) A warning from the GDBM_File extension that a store failed.
+
+=item gethostent not implemented
+
+(F) Your C library apparently doesn't implement gethostent(), probably
+because if it did, it'd feel morally obligated to return every hostname
+on the Internet.
+
+=item get{sock,peer}name() on closed fd
+
+(W) You tried to get a socket or peer socket name on a closed socket.
+Did you forget to check the return value of your socket() call?
+
+=item getpwnam returned invalid UIC %#o for user "%s"
+
+(S) A warning peculiar to VMS.  The call to C<sys$getuai> underlying the
+C<getpwnam> operator returned an invalid UIC.
+
+
+=item Glob not terminated
+
+(F) The lexer saw a left angle bracket in a place where it was expecting
+a term, so it's looking for the corresponding right angle bracket, and not
+finding it.  Chances are you left some needed parentheses out earlier in
+the line, and you really meant a "less than".
+
+=item Global symbol "%s" requires explicit package name
+
+(F) You've said "use strict vars", which indicates that all variables must
+either be lexically scoped (using "my"), or explicitly qualified to
+say which package the global variable is in (using "::").
+
+=item goto must have label
+
+(F) Unlike with "next" or "last", you're not allowed to goto an
+unspecified destination.  See L<perlfunc/goto>.
+
+=item Had to create %s unexpectedly
+
+(S) A routine asked for a symbol from a symbol table that ought to have
+existed already, but for some reason it didn't, and had to be created on
+an emergency basis to prevent a core dump.
+
+=item Hash %%s missing the % in argument %d of %s()
+
+(D) Really old Perl let you omit the % on hash names in some spots.  This
+is now heavily deprecated.
+
+=item Identifier "%s::%s" used only once: possible typo
+
+(W) Typographical errors often show up as unique identifiers.  If you
+had a good reason for having a unique identifier, then just mention it
+again somehow to suppress the message.
+
+=item Illegal division by zero
+
+(F) You tried to divide a number by 0.  Either something was wrong in your
+logic, or you need to put a conditional in to guard against meaningless input.
+
+=item Illegal modulus zero
+
+(F) You tried to divide a number by 0 to get the remainder.  Most numbers
+don't take to this kindly.
+
+=item Illegal octal digit
+
+(F) You used an 8 or 9 in a octal number.
+
+=item Illegal octal digit ignored
+
+(W) You may have tried to use an 8 or 9 in a octal number.  Interpretation
+of the octal number stopped before the 8 or 9.
+
+=item Insecure dependency in %s
+
+(F) You tried to do something that the tainting mechanism didn't like. 
+The tainting mechanism is turned on when you're running setuid or setgid,
+or when you specify B<-T> to turn it on explicitly.  The tainting mechanism
+labels all data that's derived directly or indirectly from the user,
+who is considered to be unworthy of your trust.  If any such data is
+used in a "dangerous" operation, you get this error.  See L<perlsec>
+for more information.
+
+=item Insecure directory in %s
+
+(F) You can't use system(), exec(), or a piped open in a setuid or setgid
+script if $ENV{PATH} contains a directory that is writable by the world.
+See L<perlsec>.
+
+=item Insecure PATH
+
+(F) You can't use system(), exec(), or a piped open in a setuid or
+setgid script if $ENV{PATH} is derived from data supplied (or
+potentially supplied) by the user.  The script must set the path to a
+known value, using trustworthy data.  See L<perlsec>.
+
+=item Internal inconsistency in tracking vforks
+
+(S) A warning peculiar to VMS.  Perl keeps track of the number
+of times you've called C<fork> and C<exec>, in order to determine
+whether the current call to C<exec> should be affect the current
+script or a subprocess (see L<perlvms/exec>).  Somehow, this count
+has become scrambled, so Perl is making a guess and treating
+this C<exec> as a request to terminate the Perl script
+and execute the specified command.
+
+=item internal disaster in regexp
+
+(P) Something went badly wrong in the regular expression parser.
+
+=item internal urp in regexp at /%s/
+
+(P) Something went badly awry in the regular expression parser.
+
+=item invalid [] range in regexp
+
+(F) The range specified in a character class had a minimum character
+greater than the maximum character.  See L<perlre>.
+
+=item ioctl is not implemented
+
+(F) Your machine apparently doesn't implement ioctl(), which is pretty
+strange for a machine that supports C.
+
+=item junk on end of regexp
+
+(P) The regular expression parser is confused.
+
+=item Label not found for "last %s"
+
+(F) You named a loop to break out of, but you're not currently in a
+loop of that name, not even if you count where you were called from.
+See L<perlfunc/last>.
+
+=item Label not found for "next %s"
+
+(F) You named a loop to continue, but you're not currently in a loop of
+that name, not even if you count where you were called from.  See
+L<perlfunc/last>.
+
+=item Label not found for "redo %s"
+
+(F) You named a loop to restart, but you're not currently in a loop of
+that name, not even if you count where you were called from.  See
+L<perlfunc/last>.
+
+=item listen() on closed fd
+
+(W) You tried to do a listen on a closed socket.  Did you forget to check
+the return value of your socket() call?  See L<perlfunc/listen>.
+
+=item Literal @%s now requires backslash
+
+(F) It used to be that Perl would try to guess whether you wanted an
+array interpolated or a literal @.  It did this when the string was
+first used at runtime.  Now strings are parsed at compile time, and
+ambiguous instances of @ must be disambiguated, either by putting a
+backslash to indicate a literal, or by declaring (or using) the array
+within the program before the string (lexically).  (Someday it will simply
+assume that an unbackslashed @ interpolates an array.)
+
+=item Method for operation %s not found in package %s during blessing
+
+(F) An attempt was made to specify an entry in an overloading table that
+doesn't somehow point to a valid method.  See L<perlovl>.
+
+=item Might be a runaway multi-line %s string starting on line %d
+
+(S) An advisory indicating that the previous error may have been caused
+by a missing delimiter on a string or pattern, because it eventually
+ended earlier on the current line.
+
+=item Misplaced _ in number
+
+(W) An underline in a decimal constant wasn't on a 3-digit boundary.
+
+=item Missing $ on loop variable
+
+(F) Apparently you've been programming in csh too much.  Variables are always
+mentioned with the $ in Perl, unlike in the shells, where it can vary from 
+one line to the next.
+
+=item Missing comma after first argument to %s function
+
+(F) While certain functions allow you to specify a filehandle or an
+"indirect object" before the argument list, this ain't one of them.
+
+=item Missing operator before %s?
+
+(S) This is an educated guess made in conjunction with the message "%s
+found where operator expected".  Often the missing operator is a comma.
+
+=item Missing right bracket
+
+(F) The lexer counted more opening curly brackets (braces) than closing ones.
+As a general rule, you'll find it's missing near the place you were last
+editing.
+
+=item Missing semicolon on previous line?
+
+(S) This is an educated guess made in conjunction with the message "%s
+found where operator expected".  Don't automatically put a semicolon on
+the previous line just because you saw this message.
+
+=item Modification of a read-only value attempted
+
+(F) You tried, directly or indirectly, to change the value of a
+constant.  You didn't, of course, try "2 = 1", since the compiler
+catches that.  But an easy way to do the same thing is:
+
+    sub mod { $_[0] = 1 }
+    mod(2);
+
+Another way is to assign to a substr() that's off the end of the string.
+
+=item Modification of non-creatable array value attempted, subscript %d
+
+(F) You tried to make an array value spring into existence, and the
+subscript was probably negative, even counting from end of the array
+backwards.
+
+=item Modification of non-creatable hash value attempted, subscript "%s"
+
+(F) You tried to make a hash value spring into existence, and it couldn't
+be created for some peculiar reason.
+
+=item Module name must be constant
+
+(F) Only a bare module name is allowed as the first argument to a "use".
+
+=item msg%s not implemented
+
+(F) You don't have System V message IPC on your system.
+
+=item Multidimensional syntax %s not supported
+
+(W) Multidimensional arrays aren't written like $foo[1,2,3].  They're written
+like $foo[1][2][3], as in C.
+
+=item Negative length
+
+(F) You tried to do a read/write/send/recv operation with a buffer length
+that is less than 0.  This is difficult to imagine.
+
+=item nested *?+ in regexp
+
+(F) You can't quantify a quantifier without intervening parens.  So
+things like ** or +* or ?* are illegal.
+
+Note, however, that the minimal matching quantifiers, *?, +? and ?? appear
+to be nested quantifiers, but aren't.  See L<perlre>.
+
+=item No #! line
+
+(F) The setuid emulator requires that scripts have a well-formed #! line
+even on machines that don't support the #! construct.
+
+=item No %s allowed while running setuid
+
+(F) Certain operations are deemed to be too insecure for a setuid or setgid
+script to even be allowed to attempt.  Generally speaking there will be
+another way to do what you want that is, if not secure, at least securable.
+See L<perlsec>.
+
+=item No B<-e> allowed in setuid scripts
+
+(F) A setuid script can't be specified by the user.
+
+=item No comma allowed after %s
+
+(F) A list operator that has a filehandle or "indirect object" is not
+allowed to have a comma between that and the following arguments.
+Otherwise it'd be just another one of the arguments.
+
+=item No command into which to pipe on command line
+
+(F) An error peculiar to VMS.  Perl handles its own command line redirection,
+and found a '|' at the end of the command line, so it doesn't know whither you
+want to pipe the output from this command.
+
+=item No DB::DB routine defined
+
+(F) The currently executing code was compiled with the B<-d> switch,
+but for some reason the perl5db.pl file (or some facsimile thereof)
+didn't define a routine to be called at the beginning of each
+statement.  Which is odd, because the file should have been required
+automatically, and should have blown up the require if it didn't parse
+right.
+
+=item No dbm on this machine
+
+(P) This is counted as an internal error, because every machine should
+supply dbm nowadays, since Perl comes with SDBM.  See L<SDBM_File>.
+
+=item No DBsub routine
+
+(F) The currently executing code was compiled with the B<-d> switch,
+but for some reason the perl5db.pl file (or some facsimile thereof)
+didn't define a DB::sub routine to be called at the beginning of each
+ordinary subroutine call.
+
+=item No error file after 2> or 2>> on command line
+
+(F) An error peculiar to VMS.  Perl handles its own command line redirection,
+and found a '2>' or a '2>>' on the command line, but can't find the name of the
+file to which to write data destined for stderr.
+
+=item No input file after < on command line
+
+(F) An error peculiar to VMS.  Perl handles its own command line redirection,
+and found a '<' on the command line, but can't find the name of the file from
+which to read data for stdin.
+
+=item No output file after > on command line
+
+(F) An error peculiar to VMS.  Perl handles its own command line redirection,
+and found a lone '>' at the end of the command line, so it doesn't know whither
+you wanted to redirect stdout.
+
+=item No output file after > or >> on command line
+
+(F) An error peculiar to VMS.  Perl handles its own command line redirection,
+and found a '>' or a '>>' on the command line, but can't find the name of the
+file to which to write data destined for stdout.
+
+=item No Perl script found in input
+
+(F) You called C<perl -x>, but no line was found in the file beginning
+with #! and containing the word "perl".
+
+=item No setregid available
+
+(F) Configure didn't find anything resembling the setregid() call for
+your system.
+
+=item No setreuid available
+
+(F) Configure didn't find anything resembling the setreuid() call for
+your system.
+
+=item No space allowed after B<-I>
+
+(F) The argument to B<-I> must follow the B<-I> immediately with no
+intervening space.
+
+=item No such pipe open
+
+(P) An error peculiar to VMS.  The internal routine my_pclose() tried to
+close a pipe which hadn't been opened.  This should have been caught earlier as
+an attempt to close an unopened filehandle.
+
+=item No such signal: SIG%s
+
+(W) You specified a signal name as a subscript to %SIG that was not recognized.
+Say C<kill -l> in your shell to see the valid signal names on your system.
+
+=item Not a CODE reference
+
+(F) Perl was trying to evaluate a reference to a code value (that is, a
+subroutine), but found a reference to something else instead.  You can
+use the ref() function to find out what kind of ref it really was.
+See also L<perlref>.
+
+=item Not a format reference
+
+(F) I'm not sure how you managed to generate a reference to an anonymous
+format, but this indicates you did, and that it didn't exist.
+
+=item Not a GLOB reference
+
+(F) Perl was trying to evaluate a reference to a "type glob" (that is,
+a symbol table entry that looks like C<*foo>), but found a reference to
+something else instead.  You can use the ref() function to find out
+what kind of ref it really was.  See L<perlref>.
+
+=item Not a HASH reference
+
+(F) Perl was trying to evaluate a reference to a hash value, but
+found a reference to something else instead.  You can use the ref()
+function to find out what kind of ref it really was.  See L<perlref>.
+
+=item Not a perl script
+
+(F) The setuid emulator requires that scripts have a well-formed #! line
+even on machines that don't support the #! construct.  The line must
+mention perl.
+
+=item Not a SCALAR reference
+
+(F) Perl was trying to evaluate a reference to a scalar value, but
+found a reference to something else instead.  You can use the ref()
+function to find out what kind of ref it really was.  See L<perlref>.
+
+=item Not a subroutine reference
+
+(F) Perl was trying to evaluate a reference to a code value (that is, a
+subroutine), but found a reference to something else instead.  You can
+use the ref() function to find out what kind of ref it really was.
+See also L<perlref>.
+
+=item Not a subroutine reference in %OVERLOAD
+
+(F) An attempt was made to specify an entry in an overloading table that
+doesn't somehow point to a valid subroutine.  See L<perlovl>.
+
+=item Not an ARRAY reference
+
+(F) Perl was trying to evaluate a reference to an array value, but
+found a reference to something else instead.  You can use the ref()
+function to find out what kind of ref it really was.  See L<perlref>.
+
+=item Not enough arguments for %s
+
+(F) The function requires more arguments than you specified.
+
+=item Not enough format arguments
+
+(W) A format specified more picture fields than the next line supplied.
+See L<perlform>.
+
+=item Null filename used
+
+(F) You can't require the null filename, especially since on many machines
+that means the current directory!  See L<perlfunc/require>.
+
+=item NULL OP IN RUN
+
+(P) Some internal routine called run() with a null opcode pointer.
+
+=item Null realloc
+
+(P) An attempt was made to realloc NULL.
+
+=item NULL regexp argument
+
+(P) The internal pattern matching routines blew it bigtime.
+
+=item NULL regexp parameter
+
+(P) The internal pattern matching routines are out of their gourd.
+
+=item Odd number of elements in hash list
+
+(S) You specified an odd number of elements to a hash list, which is odd,
+since hash lists come in key/value pairs.
+
+=item oops: oopsAV
+
+(S) An internal warning that the grammar is screwed up.
+
+=item oops: oopsHV
+
+(S) An internal warning that the grammar is screwed up.
+
+=item Operation `%s' %s: no method found,
+
+(F) An attempt was made to use an entry in an overloading table that
+somehow no longer points to a valid method.  See L<perlovl>.
+
+=item Operator or semicolon missing before %s
+
+(S) You used a variable or subroutine call where the parser was
+expecting an operator.  The parser has assumed you really meant
+to use an operator, but this is highly likely to be incorrect.
+For example, if you say "*foo *foo" it will be interpreted as
+if you said "*foo * 'foo'".
+
+=item Out of memory for yacc stack
+
+(F) The yacc parser wanted to grow its stack so it could continue parsing,
+but realloc() wouldn't give it more memory, virtual or otherwise.
+
+=item Out of memory!
+
+(X) The malloc() function returned 0, indicating there was insufficient
+remaining memory (or virtual memory) to satisfy the request.
+
+=item page overflow
+
+(W) A single call to write() produced more lines than can fit on a page.
+See L<perlform>.
+
+=item panic: ck_grep
+
+(P) Failed an internal consistency check trying to compile a grep.
+
+=item panic: ck_split
+
+(P) Failed an internal consistency check trying to compile a split.
+
+=item panic: corrupt saved stack index
+
+(P) The savestack was requested to restore more localized values than there
+are in the savestack.
+
+=item panic: die %s
+
+(P) We popped the context stack to an eval context, and then discovered
+it wasn't an eval context.
+
+=item panic: do_match
+
+(P) The internal pp_match() routine was called with invalid operational data.
+
+=item panic: do_split
+
+(P) Something terrible went wrong in setting up for the split.
+
+=item panic: do_subst
+
+(P) The internal pp_subst() routine was called with invalid operational data.
+
+=item panic: do_trans
+
+(P) The internal do_trans() routine was called with invalid operational data.
+
+=item panic: goto
+
+(P) We popped the context stack to a context with the specified label,
+and then discovered it wasn't a context we know how to do a goto in.
+
+=item panic: INTERPCASEMOD
+
+(P) The lexer got into a bad state at a case modifier.
+
+=item panic: INTERPCONCAT
+
+(P) The lexer got into a bad state parsing a string with brackets.
+
+=item panic: last
+
+(P) We popped the context stack to a block context, and then discovered
+it wasn't a block context.
+
+=item panic: leave_scope clearsv
+
+(P) A writable lexical variable became readonly somehow within the scope.
+
+=item panic: leave_scope inconsistency
+
+(P) The savestack probably got out of sync.  At least, there was an
+invalid enum on the top of it.
+
+=item panic: malloc
+
+(P) Something requested a negative number of bytes of malloc.
+
+=item panic: mapstart
+
+(P) The compiler is screwed up with respect to the map() function.
+
+=item panic: null array
+
+(P) One of the internal array routines was passed a null AV pointer.
+
+=item panic: pad_alloc
+
+(P) The compiler got confused about which scratch pad it was allocating
+and freeing temporaries and lexicals from.
+
+=item panic: pad_free curpad
+
+(P) The compiler got confused about which scratch pad it was allocating
+and freeing temporaries and lexicals from.
+
+=item panic: pad_free po
+
+(P) An invalid scratch pad offset was detected internally.
+
+=item panic: pad_reset curpad
+
+(P) The compiler got confused about which scratch pad it was allocating
+and freeing temporaries and lexicals from.
+
+=item panic: pad_sv po
+
+(P) An invalid scratch pad offset was detected internally.
+
+=item panic: pad_swipe curpad
+
+(P) The compiler got confused about which scratch pad it was allocating
+and freeing temporaries and lexicals from.
+
+=item panic: pad_swipe po
+
+(P) An invalid scratch pad offset was detected internally.
+
+=item panic: pp_iter
+
+(P) The foreach iterator got called in a non-loop context frame.
+
+=item panic: realloc
+
+(P) Something requested a negative number of bytes of realloc.
+
+=item panic: restartop
+
+(P) Some internal routine requested a goto (or something like it), and
+didn't supply the destination.
+
+=item panic: return
+
+(P) We popped the context stack to a subroutine or eval context, and
+then discovered it wasn't a subroutine or eval context.
+
+=item panic: scan_num
+
+(P) scan_num() got called on something that wasn't a number.
+
+=item panic: sv_insert
+
+(P) The sv_insert() routine was told to remove more string than there
+was string.
+
+=item panic: top_env
+
+(P) The compiler attempted to do a goto, or something weird like that.
+
+=item panic: yylex
+
+(P) The lexer got into a bad state while processing a case modifier.
+
+=item Parens missing around "%s" list
+
+(W) You said something like
+
+    my $foo, $bar = @_;
+
+when you meant
+
+    my ($foo, $bar) = @_;
+
+Remember that "my" and "local" bind closer than comma.
+
+=item Perl %3.3f required--this is only version %s, stopped
+
+(F) The module in question uses features of a version of Perl more recent
+than the currently running version.  How long has it been since you upgraded,
+anyway?  See L<perlfunc/require>.
+
+=item Permission denied
+
+(F) The setuid emulator in suidperl decided you were up to no good.
+
+=item pid %d not a child
+
+(W) A warning peculiar to VMS.  Waitpid() was asked to wait for a process which
+isn't a subprocess of the current process.  While this is fine from VMS'
+perspective, it's probably not what you intended.
+
+=item POSIX getpgrp can't take an argument
+
+(F) Your C compiler uses POSIX getpgrp(), which takes no argument, unlike
+the BSD version, which takes a pid.
+
+=item Possible memory corruption: %s overflowed 3rd argument
+
+(F) An ioctl() or fcntl() returned more than Perl was bargaining for.
+Perl guesses a reasonable buffer size, but puts a sentinel byte at the
+end of the buffer just in case.  This sentinel byte got clobbered, and
+Perl assumes that memory is now corrupted.  See L<perlfunc/ioctl>.
+
+=item Precedence problem: open %s should be open(%s)
+
+(S) The old irregular construct
+
+    open FOO || die;
+
+is now misinterpreted as
+
+    open(FOO || die);
+
+because of the strict regularization of Perl 5's grammar into unary and
+list operators.  (The old open was a little of both.) You must put
+parens around the filehandle, or use the new "or" operator instead of "||".
+
+=item print on closed filehandle %s
+
+(W) The filehandle you're printing on got itself closed sometime before now.
+Check your logic flow.
+
+=item printf on closed filehandle %s
+
+(W) The filehandle you're writing to got itself closed sometime before now.
+Check your logic flow.
+
+=item Probable precedence problem on %s
+
+(W) The compiler found a bare word where it expected a conditional,
+which often indicates that an || or && was parsed as part of the
+last argument of the previous construct, for example:
+
+    open FOO || die;
+
+=item Prototype mismatch: (%s) vs (%s)
+
+(S) The subroutine being defined had a predeclared (forward) declaration
+with a different function prototype.
+
+=item Read on closed filehandle <%s>
+
+(W) The filehandle you're reading from got itself closed sometime before now.
+Check your logic flow.
+
+=item Reallocation too large: %lx
+
+(F) You can't allocate more than 64K on an MSDOS machine.
+
+=item Recompile perl with B<-D>DEBUGGING to use B<-D> switch
+
+(F) You can't use the B<-D> option unless the code to produce the
+desired output is compiled into Perl, which entails some overhead,
+which is why it's currently left out of your copy.
+
+=item Recursive inheritance detected
+
+(F) More than 100 levels of inheritance were used.  Probably indicates
+an unintended loop in your inheritance hierarchy.
+
+=item Reference miscount in sv_replace()
+
+(W) The internal sv_replace() function was handed a new SV with a
+reference count of other than 1.
+
+=item regexp memory corruption
+
+(P) The regular expression engine got confused by what the regular
+expression compiler gave it.
+
+=item regexp out of space
+
+(P) A "can't happen" error, because safemalloc() should have caught it earlier.
+
+=item regexp too big
+
+(F) The current implementation of regular expression uses shorts as
+address offsets within a string.  Unfortunately this means that if
+the regular expression compiles to longer than 32767, it'll blow up.
+Usually when you want a regular expression this big, there is a better
+way to do it with multiple statements.  See L<perlre>.
+
+=item Reversed %s= operator
+
+(W) You wrote your assignment operator backwards.  The = must always
+comes last, to avoid ambiguity with subsequent unary operators.
+
+=item Runaway format
+
+(F) Your format contained the ~~ repeat-until-blank sequence, but it
+produced 200 lines at once, and the 200th line looked exactly like the
+199th line.  Apparently you didn't arrange for the arguments to exhaust
+themselves, either by using ^ instead of @ (for scalar variables), or by
+shifting or popping (for array variables).  See L<perlform>.
+
+=item Scalar value @%s[%s] better written as $%s[%s]
+
+(W) You've used an array slice (indicated by @) to select a single value of
+an array.  Generally it's better to ask for a scalar value (indicated by $).
+The difference is that $foo[&bar] always behaves like a scalar, both when
+assigning to it and when evaluating its argument, while @foo[&bar] behaves
+like a list when you assign to it, and provides a list context to its
+subscript, which can do weird things if you're only expecting one subscript.
+
+On the other hand, if you were actually hoping to treat the array
+element as a list, you need to look into how references work, since
+Perl will not magically convert between scalars and lists for you.  See
+L<perlref>.
+
+=item Script is not setuid/setgid in suidperl
+
+(F) Oddly, the suidperl program was invoked on a script with its setuid
+or setgid bit set.  This doesn't make much sense.
+
+=item Search pattern not terminated
+
+(F) The lexer couldn't find the final delimiter of a // or m{}
+construct.  Remember that bracketing delimiters count nesting level.
+
+=item seek() on unopened file
+
+(W) You tried to use the seek() function on a filehandle that was either
+never opened or has been closed since.
+
+=item select not implemented
+
+(F) This machine doesn't implement the select() system call.
+
+=item sem%s not implemented
+
+(F) You don't have System V semaphore IPC on your system.
+
+=item semi-panic: attempt to dup freed string
+
+(S) The internal newSVsv() routine was called to duplicate a scalar
+that had previously been marked as free.
+
+=item Semicolon seems to be missing
+
+(W) A nearby syntax error was probably caused by a missing semicolon,
+or possibly some other missing operator, such as a comma.
+
+=item Send on closed socket
+
+(W) The filehandle you're sending to got itself closed sometime before now.
+Check your logic flow.
+
+=item Sequence (?#... not terminated
+
+(F) A regular expression comment must be terminated by a closing
+parenthesis.  Embedded parens aren't allowed.  See L<perlre>.
+
+=item Sequence (?%s...) not implemented
+
+(F) A proposed regular expression extension has the character reserved
+but has not yet been written.  See L<perlre>.
+
+=item Sequence (?%s...) not recognized
+
+(F) You used a regular expression extension that doesn't make sense.
+See L<perlre>.
+
+=item Server error
+
+Also known as "500 Server error".  This is a CGI error, not a Perl
+error.  You need to make sure your script is executable, is accessible
+by the user CGI is running the script under (which is probably not
+the user account you tested it under), does not rely on any environment
+variables (like PATH) from the user it isn't running under, and isn't
+in a location where the CGI server can't find it, basically, more or less.
+
+=item setegid() not implemented
+
+(F) You tried to assign to $), and your operating system doesn't support
+the setegid() system call (or equivalent), or at least Configure didn't
+think so.
+
+=item seteuid() not implemented
+
+(F) You tried to assign to $>, and your operating system doesn't support
+the seteuid() system call (or equivalent), or at least Configure didn't
+think so.
+
+=item setrgid() not implemented
+
+(F) You tried to assign to $(, and your operating system doesn't support
+the setrgid() system call (or equivalent), or at least Configure didn't
+think so.
+
+=item setruid() not implemented
+
+(F) You tried to assign to $<, and your operating system doesn't support
+the setruid() system call (or equivalent), or at least Configure didn't
+think so.
+
+=item Setuid/gid script is writable by world
+
+(F) The setuid emulator won't run a script that is writable by the world,
+because the world might have written on it already.
+
+=item shm%s not implemented
+
+(F) You don't have System V shared memory IPC on your system.
+
+=item shutdown() on closed fd
+
+(W) You tried to do a shutdown on a closed socket.  Seems a bit superfluous.
+
+=item SIG%s handler "%s" not defined.
+
+(W) The signal handler named in %SIG doesn't, in fact, exist.  Perhaps you
+put it into the wrong package?
+
+=item sort is now a reserved word
+
+(F) An ancient error message that almost nobody ever runs into anymore.
+But before sort was a keyword, people sometimes used it as a filehandle.
+
+=item Sort subroutine didn't return a numeric value
+
+(F) A sort comparison routine must return a number.  You probably blew
+it by not using C<E<lt>=E<gt>> or C<cmp>, or by not using them correctly.
+See L<perlfunc/sort>.
+
+=item Sort subroutine didn't return single value
+
+(F) A sort comparison subroutine may not return a list value with more
+or less than one element.  See L<perlfunc/sort>.
+
+=item Split loop
+
+(P) The split was looping infinitely.  (Obviously, a split shouldn't iterate
+more times than there are characters of input, which is what happened.)
+See L<perlfunc/split>.
+
+=item Stat on unopened file <%s>
+
+(W) You tried to use the stat() function (or an equivalent file test)
+on a filehandle that was either never opened or has been closed since.
+
+=item Statement unlikely to be reached
+
+(W) You did an exec() with some statement after it other than a die().
+This is almost always an error, because exec() never returns unless
+there was a failure.  You probably wanted to use system() instead,
+which does return.  To suppress this warning, put the exec() in a block
+by itself.
+
+=item Subroutine %s redefined
+
+(W) You redefined a subroutine.  To suppress this warning, say
+
+    {
+	local $^W = 0;
+	eval "sub name { ... }";
+    }
+
+=item Substitution loop
+
+(P) The substitution was looping infinitely.  (Obviously, a
+substitution shouldn't iterate more times than there are characters of
+input, which is what happened.) See the discussion of substitution in
+L<perlop/"Quote and Quotelike Operators">.
+
+=item Substitution pattern not terminated
+
+(F) The lexer couldn't find the interior delimiter of a s/// or s{}{}
+construct.  Remember that bracketing delimiters count nesting level.
+
+=item Substitution replacement not terminated
+
+(F) The lexer couldn't find the final delimiter of a s/// or s{}{}
+construct.  Remember that bracketing delimiters count nesting level.
+
+=item substr outside of string
+
+(W) You tried to reference a substr() that pointed outside of a string.
+That is, the absolute value of the offset was larger than the length of
+the string.  See L<perlfunc/substr>.
+
+=item suidperl is no longer needed since...
+
+(F) Your Perl was compiled with B<-D>SETUID_SCRIPTS_ARE_SECURE_NOW, but a
+version of the setuid emulator somehow got run anyway.
+
+=item syntax error
+
+(F) Probably means you had a syntax error.  Common reasons include:
+
+    A keyword is misspelled.
+    A semicolon is missing.
+    A comma is missing.
+    An opening or closing parenthesis is missing.
+    An opening or closing brace is missing.
+    A closing quote is missing.
+
+Often there will be another error message associated with the syntax
+error giving more information.  (Sometimes it helps to turn on B<-w>.)
+The error message itself often tells you where it was in the line when
+it decided to give up.  Sometimes the actual error is several tokens
+before this, since Perl is good at understanding random input.
+Occasionally the line number may be misleading, and once in a blue moon
+the only way to figure out what's triggering the error is to call
+C<perl -c> repeatedly, chopping away half the program each time to see
+if the error went away.  Sort of the cybernetic version of S<20 questions>.
+
+=item syntax error at line %d: `%s' unexpected
+
+(A) You've accidentally run your script through the Bourne shell 
+instead of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item System V IPC is not implemented on this machine
+
+(F) You tried to do something with a function beginning with "sem", "shm"
+or "msg".  See L<perlfunc/semctl>, for example.
+
+=item Syswrite on closed filehandle
+
+(W) The filehandle you're writing to got itself closed sometime before now.
+Check your logic flow.
+
+=item tell() on unopened file
+
+(W) You tried to use the tell() function on a filehandle that was either
+never opened or has been closed since.
+
+=item Test on unopened file <%s>
+
+(W) You tried to invoke a file test operator on a filehandle that isn't
+open.  Check your logic.  See also L<perlfunc/-X>.
+
+=item That use of $[ is unsupported
+
+(F) Assignment to $[ is now strictly circumscribed, and interpreted as
+a compiler directive.  You may only say one of
+
+    $[ = 0;
+    $[ = 1;
+    ...
+    local $[ = 0;
+    local $[ = 1;
+    ...
+
+This is to prevent the problem of one module changing the array base
+out from under another module inadvertently.  See L<perlvar/$[>.
+
+=item The %s function is unimplemented
+
+The function indicated isn't implemented on this architecture, according
+to the probings of Configure.
+
+=item The crypt() function is unimplemented due to excessive paranoia.
+
+(F) Configure couldn't find the crypt() function on your machine,
+probably because your vendor didn't supply it, probably because they
+think the U.S. Govermnment thinks it's a secret, or at least that they
+will continue to pretend that it is.  And if you quote me on that, I
+will deny it.
+
+=item The stat preceding C<-l _> wasn't an lstat
+
+(F) It makes no sense to test the current stat buffer for symbolic linkhood
+if the last stat that wrote to the stat buffer already went past
+the symlink to get to the real file.  Use an actual filename instead.
+
+=item times not implemented
+
+(F) Your version of the C library apparently doesn't do times().  I suspect
+you're not running on Unix.
+
+=item Too few args to syscall
+
+(F) There has to be at least one argument to syscall() to specify the
+system call to call, silly dilly.
+
+=item Too many ('s
+
+=item Too many )'s
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item Too many args to syscall
+
+(F) Perl only supports a maximum of 14 args to syscall().
+
+=item Too many arguments for %s
+
+(F) The function requires fewer arguments than you specified.
+
+=item trailing \ in regexp
+
+(F) The regular expression ends with an unbackslashed backslash.  Backslash
+it.   See L<perlre>.
+
+=item Translation pattern not terminated
+
+(F) The lexer couldn't find the interior delimiter of a tr/// or tr[][]
+construct.
+
+=item Translation replacement not terminated
+
+(F) The lexer couldn't find the final delimiter of a tr/// or tr[][]
+construct.
+
+=item truncate not implemented
+
+(F) Your machine doesn't implement a file truncation mechanism that
+Configure knows about.
+
+=item Type of arg %d to %s must be %s (not %s)
+
+(F) This function requires the argument in that position to be of a
+certain type.  Arrays must be @NAME or @{EXPR}.  Hashes must be
+%NAME or %{EXPR}.  No implicit dereferencing is allowed--use the
+{EXPR} forms as an explicit dereference.  See L<perlref>.
+
+=item umask: argument is missing initial 0
+
+(W) A umask of 222 is incorrect.  It should be 0222, since octal literals
+always start with 0 in Perl, as in C.
+
+=item Unable to create sub named "%s"
+
+(F) You attempted to create or access a subroutine with an illegal name.
+
+=item Unbalanced context: %d more PUSHes than POPs
+
+(W) The exit code detected an internal inconsistency in how many execution
+contexts were entered and left.
+
+=item Unbalanced saves: %d more saves than restores
+
+(W) The exit code detected an internal inconsistency in how many
+values were temporarily localized.
+
+=item Unbalanced scopes: %d more ENTERs than LEAVEs
+
+(W) The exit code detected an internal inconsistency in how many blocks
+were entered and left.
+
+=item Unbalanced tmps: %d more allocs than frees
+
+(W) The exit code detected an internal inconsistency in how many mortal
+scalars were allocated and freed.
+
+=item Undefined format "%s" called
+
+(F) The format indicated doesn't seem to exist.  Perhaps it's really in
+another package?  See L<perlform>.
+
+=item Undefined sort subroutine "%s" called
+
+(F) The sort comparison routine specified doesn't seem to exist.  Perhaps
+it's in a different package?  See L<perlfunc/sort>.
+
+=item Undefined subroutine &%s called
+
+(F) The subroutine indicated hasn't been defined, or if it was, it
+has since been undefined.
+
+=item Undefined subroutine called
+
+(F) The anonymous subroutine you're trying to call hasn't been defined,
+or if it was, it has since been undefined.
+
+=item Undefined subroutine in sort
+
+(F) The sort comparison routine specified is declared but doesn't seem to
+have been defined yet.  See L<perlfunc/sort>.
+
+=item Undefined top format "%s" called
+
+(F) The format indicated doesn't seem to exist.  Perhaps it's really in
+another package?  See L<perlform>.
+
+=item unexec of %s into %s failed!
+
+(F) The unexec() routine failed for some reason.  See your local FSF
+representative, who probably put it there in the first place.
+
+=item Unknown BYTEORDER
+
+(F) There are no byteswapping functions for a machine with this byte order.
+
+=item unmatched () in regexp
+
+(F) Unbackslashed parentheses must always be balanced in regular
+expressions.  If you're a vi user, the % key is valuable for finding
+the matching paren.  See L<perlre>.
+
+=item Unmatched right bracket
+
+(F) The lexer counted more closing curly brackets (braces) than opening
+ones, so you're probably missing an opening bracket.  As a general
+rule, you'll find the missing one (so to speak) near the place you were
+last editing.
+
+=item unmatched [] in regexp
+
+(F) The brackets around a character class must match.  If you wish to
+include a closing bracket in a character class, backslash it or put it first.
+See L<perlre>.
+
+=item Unquoted string "%s" may clash with future reserved word
+
+(W) You used a bare word that might someday be claimed as a reserved word.
+It's best to put such a word in quotes, or capitalize it somehow, or insert
+an underbar into it.  You might also declare it as a subroutine.
+
+=item Unrecognized character \%03o ignored
+
+(S) A garbage character was found in the input, and ignored, in case it's
+a weird control character on an EBCDIC machine, or some such.
+
+=item Unrecognized signal name "%s"
+
+(F) You specified a signal name to the kill() function that was not recognized.
+Say C<kill -l> in your shell to see the valid signal names on your system.
+
+=item Unrecognized switch: -%s
+
+(F) You specified an illegal option to Perl.  Don't do that.
+(If you think you didn't do that, check the #! line to see if it's
+supplying the bad switch on your behalf.)
+
+=item Unsuccessful %s on filename containing newline
+
+(W) A file operation was attempted on a filename, and that operation
+failed, PROBABLY because the filename contained a newline, PROBABLY
+because you forgot to chop() or chomp() it off.  See L<perlfunc/chop>.
+
+=item Unsupported directory function "%s" called
+
+(F) Your machine doesn't support opendir() and readdir().
+
+=item Unsupported function %s
+
+(F) This machines doesn't implement the indicated function, apparently.
+At least, Configure doesn't think so.
+
+=item Unsupported socket function "%s" called
+
+(F) Your machine doesn't support the Berkeley socket mechanism, or at
+least that's what Configure thought.
+
+=item Unterminated <> operator
+
+(F) The lexer saw a left angle bracket in a place where it was expecting
+a term, so it's looking for the corresponding right angle bracket, and not
+finding it.  Chances are you left some needed parentheses out earlier in
+the line, and you really meant a "less than".
+
+=item Use of $# is deprecated
+
+(D) This was an ill-advised attempt to emulate a poorly defined awk feature.
+Use an explicit printf() or sprintf() instead.
+
+=item Use of $* is deprecated
+
+(D) This variable magically turned on multiline pattern matching, both for
+you and for any luckless subroutine that you happen to call.  You should
+use the new C<//m> and C<//s> modifiers now to do that without the dangerous
+action-at-a-distance effects of C<$*>.
+
+=item Use of %s in printf format not supported
+
+(F) You attempted to use a feature of printf that is accessible only
+from C.  This usually means there's a better way to do it in Perl.
+
+=item Use of %s is deprecated
+
+(D) The construct indicated is no longer recommended for use, generally
+because there's a better way to do it, and also because the old way has
+bad side effects.
+
+=item Use of bare << to mean <<"" is deprecated
+
+(D) You are now encouraged to use the explicitly quoted form if you
+wish to use a blank line as the terminator of the here-document.
+
+=item Use of implicit split to @_ is deprecated
+
+(D) It makes a lot of work for the compiler when you clobber a
+subroutine's argument list, so it's better if you assign the results of
+a split() explicitly to an array (or list).
+
+=item Use of uninitialized value
+
+(W) An undefined value was used as if it were already defined.  It was
+interpreted as a "" or a 0, but maybe it was a mistake.  To suppress this
+warning assign an initial value to your variables.
+
+=item Useless use of %s in void context
+
+(W) You did something without a side effect in a context that does nothing
+with the return value, such as a statement that doesn't return a value
+from a block, or the left side of a scalar comma operator.  Very often
+this points not to stupidity on your part, but a failure of Perl to parse
+your program the way you thought it would.  For example, you'd get this
+if you mixed up your C precedence with Python precedence and said
+
+    $one, $two = 1, 2;
+
+when you meant to say
+
+    ($one, $two) = (1, 2);
+
+Another common error is to use ordinary parentheses to construct a list
+reference when you should be using square or curly brackets, for
+example, if you say
+
+    $array = (1,2);
+
+when you should have said
+
+    $array = [1,2];
+
+The square brackets explicitly turn a list value into a scalar value,
+while parentheses do not.  So when a parenthesized list is evaluated in
+a scalar context, the comma is treated like C's comma operator, which
+throws away the left argument, which is not what you want.  See
+L<perlref> for more on this.
+
+=item Variable "%s" is not exported
+
+(F) While "use strict" in effect, you referred to a global variable
+that you apparently thought was imported from another module, because
+something else of the same name (usually a subroutine) is exported
+by that module.  It usually means you put the wrong funny character
+on the front of your variable.
+
+=item Variable syntax.
+
+(A) You've accidentally run your script through B<csh> instead
+of Perl.  Check the <#!> line, or manually feed your script
+into Perl yourself.
+
+=item Warning: unable to close filehandle %s properly.
+
+(S) The implicit close() done by an open() got an error indication on the 
+close(0.  This usually indicates your filesystem ran out of disk space.
+
+=item Warning: Use of "%s" without parens is ambiguous
+
+(S) You wrote a unary operator followed by something that looks like a
+binary operator that could also have been interpreted as a term or
+unary operator.  For instance, if you know that the rand function
+has a default argument of 1.0, and you write
+
+    rand + 5;
+
+you may THINK you wrote the same thing as
+
+    rand() + 5;
+
+but in actual fact, you got
+
+    rand(+5);
+
+So put in parens to say what you really mean.
+
+=item Write on closed filehandle
+
+(W) The filehandle you're writing to got itself closed sometime before now.
+Check your logic flow.
+
+=item X outside of string
+
+(F) You had a pack template that specified a relative position before
+the beginning of the string being unpacked.  See L<perlfunc/pack>.
+
+=item x outside of string
+
+(F) You had a pack template that specified a relative position after
+the end of the string being unpacked.  See L<perlfunc/pack>.
+
+=item Xsub "%s" called in sort
+
+(F) The use of an external subroutine as a sort comparison is not yet supported.
+
+=item Xsub called in sort
+
+(F) The use of an external subroutine as a sort comparison is not yet supported.
+
+=item You can't use C<-l> on a filehandle
+
+(F) A filehandle represents an opened file, and when you opened the file it
+already went past any symlink you are presumably trying to look for.
+Use a filename instead.
+
+=item YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!
+
+(F) And you probably never will, since you probably don't have the
+sources to your kernel, and your vendor probably doesn't give a rip
+about what you want.  Your best bet is to use the wrapsuid script in
+the eg directory to put a setuid C wrapper around your script.
+
+=item You need to quote "%s"
+
+(W) You assigned a bareword as a signal handler name.  Unfortunately, you
+already have a subroutine of that name declared, which means that Perl 5
+will try to call the subroutine when the assignment is executed, which is
+probably not what you want.  (If it IS what you want, put an & in front.)
+
+=item [gs]etsockopt() on closed fd
+
+(W) You tried to get or set a socket option on a closed socket.
+Did you forget to check the return value of your socket() call?
+See L<perlfunc/getsockopt>.
+
+=item \1 better written as $1
+
+(W) Outside of patterns, backreferences live on as variables.  The use
+of backslashes is grandfathered on the righthand side of a
+substitution, but stylistically it's better to use the variable form
+because other Perl programmers will expect it, and it works better
+if there are more than 9 backreferences.
+
+=item '|' and '<' may not both be specified on command line
+
+(F) An error peculiar to VMS.  Perl does its own command line redirection, and
+found that STDIN was a pipe, and that you also tried to redirect STDIN using
+'<'.  Only one STDIN stream to a customer, please.
+
+=item '|' and '>' may not both be specified on command line
+
+(F) An error peculiar to VMS.  Perl does its own command line redirection, and
+thinks you tried to redirect stdout both to a file and into a pipe to another
+command.  You need to choose one or the other, though nothing's stopping you
+from piping into a program or Perl script which 'splits' output into two
+streams, such as
+
+    open(OUT,">$ARGV[0]") or die "Can't write to $ARGV[0]: $!";
+    while (<STDIN>) {
+        print;
+        print OUT;
+    }
+    close OUT;
+
+=back
+
diff --git a/gnu/usr.bin/perl/pod/perldsc.pod b/gnu/usr.bin/perl/pod/perldsc.pod
new file mode 100644
index 00000000000..7e18e7405c2
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perldsc.pod
@@ -0,0 +1,837 @@
+=head1 NAME
+
+perldsc - Perl Data Structures Cookbook
+
+=head1 DESCRIPTION
+
+The single feature most sorely lacking in the Perl programming language
+prior to its 5.0 release was complex data structures.  Even without direct
+language support, some valiant programmers did manage to emulate them, but
+it was hard work and not for the faint of heart.  You could occasionally
+get away with the C<$m{$LoL,$b}> notation borrowed from I<awk> in which the
+keys are actually more like a single concatenated string C<"$LoL$b">, but
+traversal and sorting were difficult.  More desperate programmers even
+hacked Perl's internal symbol table directly, a strategy that proved hard
+to develop and maintain--to put it mildly.
+
+The 5.0 release of Perl let us have complex data structures.  You
+may now write something like this and all of a sudden, you'd have a array
+with three dimensions!
+
+    for $x (1 .. 10) {
+	for $y (1 .. 10) {
+	    for $z (1 .. 10) {
+		$LoL[$x][$y][$z] = 
+		    $x ** $y + $z;
+	    }
+	}
+    }
+
+Alas, however simple this may appear, underneath it's a much more
+elaborate construct than meets the eye!
+
+How do you print it out?  Why can't you just say C<print @LoL>?  How do
+you sort it?  How can you pass it to a function or get one of these back
+from a function?  Is is an object?  Can you save it to disk to read
+back later?  How do you access whole rows or columns of that matrix?  Do
+all the values have to be numeric?  
+
+As you see, it's quite easy to become confused.  While some small portion
+of the blame for this can be attributed to the reference-based
+implementation, it's really more due to a lack of existing documentation with
+examples designed for the beginner.
+
+This document is meant to be a detailed but understandable treatment of
+the many different sorts of data structures you might want to develop.  It should
+also serve as a cookbook of examples.  That way, when you need to create one of these
+complex data structures, you can just pinch, pilfer, or purloin
+a drop-in example from here.
+
+Let's look at each of these possible constructs in detail.  There are separate
+documents on each of the following:
+
+=over 5
+
+=item * arrays of arrays
+
+=item * hashes of arrays
+
+=item * arrays of hashes
+
+=item * hashes of hashes
+
+=item * more elaborate constructs
+
+=item * recursive and self-referential data structures
+
+=item * objects
+
+=back
+
+But for now, let's look at some of the general issues common to all
+of these types of data structures. 
+
+=head1 REFERENCES
+
+The most important thing to understand about all data structures in Perl
+-- including multidimensional arrays--is that even though they might
+appear otherwise, Perl C<@ARRAY>s and C<%HASH>es are all internally
+one-dimensional.  They can only hold scalar values (meaning a string,
+number, or a reference).  They cannot directly contain other arrays or
+hashes, but instead contain I<references> to other arrays or hashes.
+
+You can't use a reference to a array or hash in quite the same way that
+you would a real array or hash.  For C or C++ programmers unused to distinguishing
+between arrays and pointers to the same, this can be confusing.  If so,
+just think of it as the difference between a structure and a pointer to a
+structure.  
+
+You can (and should) read more about references in the perlref(1) man
+page.  Briefly, references are rather like pointers that know what they
+point to.  (Objects are also a kind of reference, but we won't be needing
+them right away--if ever.)  That means that when you have something that
+looks to you like an access to two-or-more-dimensional array and/or hash,
+that what's really going on is that in all these cases, the base type is
+merely a one-dimensional entity that contains references to the next
+level.  It's just that you can I<use> it as though it were a
+two-dimensional one.  This is actually the way almost all C
+multidimensional arrays work as well.
+
+    $list[7][12]			# array of arrays
+    $list[7]{string}			# array of hashes
+    $hash{string}[7]			# hash of arrays
+    $hash{string}{'another string'}	# hash of hashes
+
+Now, because the top level only contains references, if you try to print
+out your array in with a simple print() function, you'll get something
+that doesn't look very nice, like this:
+
+    @LoL = ( [2, 3], [4, 5, 7], [0] );
+    print $LoL[1][2];
+  7
+    print @LoL;
+  ARRAY(0x83c38)ARRAY(0x8b194)ARRAY(0x8b1d0)
+
+
+That's because Perl doesn't (ever) implicitly dereference your variables.
+If you want to get at the thing a reference is referring to, then you have
+to do this yourself using either prefix typing indicators, like
+C<${$blah}>, C<@{$blah}>, C<@{$blah[$i]}>, or else postfix pointer arrows,
+like C<$a-E<gt>[3]>, C<$h-E<gt>{fred}>, or even C<$ob-E<gt>method()-E<gt>[3]>.
+
+=head1 COMMON MISTAKES
+
+The two most common mistakes made in constructing something like
+an array of arrays is either accidentally counting the number of
+elements or else taking a reference to the same memory location
+repeatedly.  Here's the case where you just get the count instead
+of a nested array:
+
+    for $i (1..10) {
+	@list = somefunc($i);
+	$LoL[$i] = @list;	# WRONG!
+    } 
+
+That's just the simple case of assigning a list to a scalar and getting
+its element count.  If that's what you really and truly want, then you
+might do well to consider being a tad more explicit about it, like this:
+
+    for $i (1..10) {
+	@list = somefunc($i);
+	$counts[$i] = scalar @list;	
+    } 
+
+Here's the case of taking a reference to the same memory location
+again and again:
+
+    for $i (1..10) {
+	@list = somefunc($i);
+	$LoL[$i] = \@list;	# WRONG!
+    } 
+
+So, just what's the big problem with that?  It looks right, doesn't it?
+After all, I just told you that you need an array of references, so by
+golly, you've made me one!
+
+Unfortunately, while this is true, it's still broken.  All the references
+in @LoL refer to the I<very same place>, and they will therefore all hold
+whatever was last in @list!  It's similar to the problem demonstrated in
+the following C program:
+
+    #include <pwd.h>
+    main() {
+	struct passwd *getpwnam(), *rp, *dp;
+	rp = getpwnam("root");
+	dp = getpwnam("daemon");
+
+	printf("daemon name is %s\nroot name is %s\n", 
+		dp->pw_name, rp->pw_name);
+    }
+
+Which will print
+
+    daemon name is daemon
+    root name is daemon 
+
+The problem is that both C<rp> and C<dp> are pointers to the same location
+in memory!  In C, you'd have to remember to malloc() yourself some new
+memory.  In Perl, you'll want to use the array constructor C<[]> or the
+hash constructor C<{}> instead.   Here's the right way to do the preceding
+broken code fragments
+
+    for $i (1..10) {
+	@list = somefunc($i);
+	$LoL[$i] = [ @list ];
+    } 
+
+The square brackets make a reference to a new array with a I<copy>
+of what's in @list at the time of the assignment.  This is what
+you want.  
+
+Note that this will produce something similar, but it's
+much harder to read:
+
+    for $i (1..10) {
+	@list = 0 .. $i;
+	@{$LoL[$i]} = @list;
+    } 
+
+Is it the same?  Well, maybe so--and maybe not.  The subtle difference
+is that when you assign something in square brackets, you know for sure
+it's always a brand new reference with a new I<copy> of the data.
+Something else could be going on in this new case with the C<@{$LoL[$i]}}>
+dereference on the left-hand-side of the assignment.  It all depends on
+whether C<$LoL[$i]> had been undefined to start with, or whether it
+already contained a reference.  If you had already populated @LoL with
+references, as in
+
+    $LoL[3] = \@another_list;
+
+Then the assignment with the indirection on the left-hand-side would
+use the existing reference that was already there:
+
+    @{$LoL[3]} = @list;
+
+Of course, this I<would> have the "interesting" effect of clobbering
+@another_list.  (Have you ever noticed how when a programmer says
+something is "interesting", that rather than meaning "intriguing",
+they're disturbingly more apt to mean that it's "annoying",
+"difficult", or both?  :-)
+
+So just remember to always use the array or hash constructors with C<[]>
+or C<{}>, and you'll be fine, although it's not always optimally
+efficient.  
+
+Surprisingly, the following dangerous-looking construct will
+actually work out fine:
+
+    for $i (1..10) {
+        my @list = somefunc($i);
+        $LoL[$i] = \@list;
+    } 
+
+That's because my() is more of a run-time statement than it is a
+compile-time declaration I<per se>.  This means that the my() variable is
+remade afresh each time through the loop.  So even though it I<looks> as
+though you stored the same variable reference each time, you actually did
+not!  This is a subtle distinction that can produce more efficient code at
+the risk of misleading all but the most experienced of programmers.  So I
+usually advise against teaching it to beginners.  In fact, except for
+passing arguments to functions, I seldom like to see the gimme-a-reference
+operator (backslash) used much at all in code.  Instead, I advise
+beginners that they (and most of the rest of us) should try to use the
+much more easily understood constructors C<[]> and C<{}> instead of
+relying upon lexical (or dynamic) scoping and hidden reference-counting to
+do the right thing behind the scenes.
+
+In summary:
+
+    $LoL[$i] = [ @list ];	# usually best
+    $LoL[$i] = \@list;		# perilous; just how my() was that list?
+    @{ $LoL[$i] } = @list;	# way too tricky for most programmers
+
+
+=head1 CAVEAT ON PRECEDENCE 
+
+Speaking of things like C<@{$LoL[$i]}>, the following are actually the
+same thing:
+
+    $listref->[2][2]	# clear
+    $$listref[2][2]	# confusing
+
+That's because Perl's precedence rules on its five prefix dereferencers
+(which look like someone swearing: C<$ @ * % &>) make them bind more
+tightly than the postfix subscripting brackets or braces!  This will no
+doubt come as a great shock to the C or C++ programmer, who is quite
+accustomed to using C<*a[i]> to mean what's pointed to by the I<i'th>
+element of C<a>.  That is, they first take the subscript, and only then
+dereference the thing at that subscript.  That's fine in C, but this isn't C.
+
+The seemingly equivalent construct in Perl, C<$$listref[$i]> first does
+the deref of C<$listref>, making it take $listref as a reference to an
+array, and then dereference that, and finally tell you the I<i'th> value
+of the array pointed to by $LoL. If you wanted the C notion, you'd have to
+write C<${$LoL[$i]}> to force the C<$LoL[$i]> to get evaluated first
+before the leading C<$> dereferencer.
+
+=head1 WHY YOU SHOULD ALWAYS C<use strict>
+
+If this is starting to sound scarier than it's worth, relax.  Perl has
+some features to help you avoid its most common pitfalls.  The best
+way to avoid getting confused is to start every program like this:
+
+    #!/usr/bin/perl -w
+    use strict;
+
+This way, you'll be forced to declare all your variables with my() and
+also disallow accidental "symbolic dereferencing".  Therefore if you'd done
+this:
+
+    my $listref = [
+	[ "fred", "barney", "pebbles", "bambam", "dino", ],
+	[ "homer", "bart", "marge", "maggie", ],
+	[ "george", "jane", "alroy", "judy", ],
+    ];
+
+    print $listref[2][2];
+
+The compiler would immediately flag that as an error I<at compile time>,
+because you were accidentally accessing C<@listref>, an undeclared
+variable, and it would thereby remind you to instead write:
+
+    print $listref->[2][2]
+
+=head1 DEBUGGING
+
+The standard Perl debugger in 5.001 doesn't do a very nice job of 
+printing out complex data structures.  However, the perl5db that
+Ilya Zakharevich E<lt>F<ilya@math.ohio-state.edu>E<gt>
+wrote, which is accessible at
+
+    ftp://ftp.perl.com/pub/perl/ext/perl5db-kit-0.9.tar.gz
+
+has several new features, including command line editing as well
+as the C<x> command to dump out complex data structures.  For example, 
+given the assignment to $LoL above, here's the debugger output:
+
+    DB<1> X $LoL
+    $LoL = ARRAY(0x13b5a0)
+       0  ARRAY(0x1f0a24)
+	  0  'fred'
+	  1  'barney'
+	  2  'pebbles'
+	  3  'bambam'
+	  4  'dino'
+       1  ARRAY(0x13b558)
+	  0  'homer'
+	  1  'bart'
+	  2  'marge'
+	  3  'maggie'
+       2  ARRAY(0x13b540)
+	  0  'george'
+	  1  'jane'
+	  2  'alroy'
+	  3  'judy'
+
+There's also a lower-case B<x> command which is nearly the same.
+
+=head1 CODE EXAMPLES
+
+Presented with little comment (these will get their own man pages someday)
+here are short code examples illustrating access of various 
+types of data structures.
+
+=head1 LISTS OF LISTS
+
+=head2 Declaration of a LIST OF LISTS
+
+ @LoL = (
+        [ "fred", "barney" ],
+        [ "george", "jane", "elroy" ],
+        [ "homer", "marge", "bart" ],
+      );
+
+=head2 Generation of a LIST OF LISTS
+
+ # reading from file
+ while ( <> ) {
+     push @LoL, [ split ];
+
+
+ # calling a function
+ for $i ( 1 .. 10 ) {
+     $LoL[$i] = [ somefunc($i) ];
+
+
+ # using temp vars
+ for $i ( 1 .. 10 ) {
+     @tmp = somefunc($i);
+     $LoL[$i] = [ @tmp ];
+
+
+ # add to an existing row
+ push @{ $LoL[0] }, "wilma", "betty";
+
+=head2 Access and Printing of a LIST OF LISTS
+
+ # one element
+ $LoL[0][0] = "Fred";
+
+ # another element
+ $LoL[1][1] =~ s/(\w)/\u$1/;
+
+ # print the whole thing with refs
+ for $aref ( @LoL ) {
+     print "\t [ @$aref ],\n";
+
+
+ # print the whole thing with indices
+ for $i ( 0 .. $#LoL ) {
+     print "\t [ @{$LoL[$i]} ],\n";
+
+
+ # print the whole thing one at a time
+ for $i ( 0 .. $#LoL ) {
+     for $j ( 0 .. $#{$LoL[$i]} ) {
+         print "elt $i $j is $LoL[$i][$j]\n";
+     }
+
+
+=head1 HASHES OF LISTS
+
+=head2 Declaration of a HASH OF LISTS
+
+ %HoL = (
+        "flintstones"        => [ "fred", "barney" ],
+        "jetsons"            => [ "george", "jane", "elroy" ],
+        "simpsons"           => [ "homer", "marge", "bart" ],
+      );
+
+=head2 Generation of a HASH OF LISTS
+
+ # reading from file
+ # flintstones: fred barney wilma dino
+ while ( <> ) {
+     next unless s/^(.*?):\s*//;
+     $HoL{$1} = [ split ];
+
+
+ # reading from file; more temps
+ # flintstones: fred barney wilma dino
+ while ( $line = <> ) {
+     ($who, $rest) = split /:\s*/, $line, 2;
+     @fields = split ' ', $rest;
+     $HoL{$who} = [ @fields ];
+
+
+ # calling a function that returns a list
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     $HoL{$group} = [ get_family($group) ];
+
+
+ # likewise, but using temps
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     @members = get_family($group);
+     $HoL{$group} = [ @members ];
+
+
+ # append new members to an existing family
+ push @{ $HoL{"flintstones"} }, "wilma", "betty";
+
+=head2 Access and Printing of a HASH OF LISTS
+
+ # one element
+ $HoL{flintstones}[0] = "Fred";
+
+ # another element
+ $HoL{simpsons}[1] =~ s/(\w)/\u$1/;
+
+ # print the whole thing
+ foreach $family ( keys %HoL ) {
+     print "$family: @{ $HoL{$family} }\n"
+
+
+ # print the whole thing with indices
+ foreach $family ( keys %HoL ) {
+     print "family: ";
+     foreach $i ( 0 .. $#{ $HoL{$family} ) {
+         print " $i = $HoL{$family}[$i]";
+     }
+     print "\n";
+
+
+ # print the whole thing sorted by number of members
+ foreach $family ( sort { @{$HoL{$b}} <=> @{$HoL{$b}} } keys %HoL ) {
+     print "$family: @{ $HoL{$family} }\n"
+
+ # print the whole thing sorted by number of members and name
+ foreach $family ( sort { @{$HoL{$b}} <=> @{$HoL{$a}} } keys %HoL ) {
+     print "$family: ", join(", ", sort @{ $HoL{$family}), "\n";
+
+=head1 LISTS OF HASHES
+
+=head2 Declaration of a LIST OF HASHES
+
+ @LoH = (
+        {
+           Lead      => "fred",
+           Friend    => "barney",
+        },
+        {
+            Lead     => "george",
+            Wife     => "jane",
+            Son      => "elroy",
+        },
+        {
+            Lead     => "homer",
+            Wife     => "marge",
+            Son      => "bart",
+        }
+  );
+
+=head2 Generation of a LIST OF HASHES
+
+ # reading from file
+ # format: LEAD=fred FRIEND=barney
+ while ( <> ) {
+     $rec = {};
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
+         $rec->{$key} = $value;
+     }
+     push @LoH, $rec;
+
+
+ # reading from file
+ # format: LEAD=fred FRIEND=barney
+ # no temp
+ while ( <> ) {
+     push @LoH, { split /[\s+=]/ };
+
+
+ # calling a function  that returns a key,value list, like
+ # "lead","fred","daughter","pebbles"
+ while ( %fields = getnextpairset() )
+     push @LoH, { %fields };
+
+
+ # likewise, but using no temp vars
+ while (<>) {
+     push @LoH, { parsepairs($_) };
+
+
+ # add key/value to an element
+ $LoH[0]{"pet"} = "dino";
+ $LoH[2]{"pet"} = "santa's little helper";
+
+=head2 Access and Printing of a LIST OF HASHES
+
+ # one element
+ $LoH[0]{"lead"} = "fred";
+
+ # another element
+ $LoH[1]{"lead"} =~ s/(\w)/\u$1/;
+
+ # print the whole thing with refs
+ for $href ( @LoH ) {
+     print "{ ";
+     for $role ( keys %$href ) {
+         print "$role=$href->{$role} ";
+     }
+     print "}\n";
+
+
+ # print the whole thing with indices
+ for $i ( 0 .. $#LoH ) {
+     print "$i is { ";
+     for $role ( keys %{ $LoH[$i] } ) {
+         print "$role=$LoH[$i]{$role} ";
+     }
+     print "}\n";
+
+
+ # print the whole thing one at a time
+ for $i ( 0 .. $#LoH ) {
+     for $role ( keys %{ $LoH[$i] } ) {
+         print "elt $i $role is $LoH[$i]{$role}\n";
+     }
+
+=head1 HASHES OF HASHES
+
+=head2 Declaration of a HASH OF HASHES
+
+ %HoH = (
+        "flintstones" => {
+            "lead"    => "fred",
+            "pal"     => "barney",
+        },
+        "jetsons"     => {
+             "lead"   => "george",
+             "wife"   => "jane",
+             "his boy"=> "elroy",
+         }
+        "simpsons"    => {
+             "lead"   => "homer",
+             "wife"   => "marge",
+             "kid"    => "bart",
+      );
+
+=head2 Generation of a HASH OF HASHES
+
+ # reading from file
+ # flintstones: lead=fred pal=barney wife=wilma pet=dino
+ while ( <> ) {
+     next unless s/^(.*?):\s*//;
+     $who = $1;
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
+         $HoH{$who}{$key} = $value;
+     }
+
+
+ # reading from file; more temps
+ while ( <> ) {
+     next unless s/^(.*?):\s*//;
+     $who = $1;
+     $rec = {};
+     $HoH{$who} = $rec;
+     for $field ( split ) {
+         ($key, $value) = split /=/, $field;
+         $rec->{$key} = $value;
+     }
+
+
+ # calling a function  that returns a key,value list, like
+ # "lead","fred","daughter","pebbles"
+ while ( %fields = getnextpairset() )
+     push @a, { %fields };
+
+
+ # calling a function  that returns a key,value hash
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     $HoH{$group} = { get_family($group) };
+
+
+ # likewise, but using temps
+ for $group ( "simpsons", "jetsons", "flintstones" ) {
+     %members = get_family($group);
+     $HoH{$group} = { %members };
+
+
+ # append new members to an existing family
+ %new_folks = (
+     "wife" => "wilma",
+     "pet"  => "dino";
+ );
+ for $what (keys %new_folks) {
+     $HoH{flintstones}{$what} = $new_folks{$what};
+
+
+=head2 Access and Printing of a HASH OF HASHES
+
+ # one element
+ $HoH{"flintstones"}{"wife"} = "wilma";
+
+ # another element
+ $HoH{simpsons}{lead} =~ s/(\w)/\u$1/;
+
+ # print the whole thing
+ foreach $family ( keys %HoH ) {
+     print "$family: ";
+     for $role ( keys %{ $HoH{$family} } {
+         print "$role=$HoH{$family}{$role} ";
+     }
+     print "}\n";
+
+
+ # print the whole thing  somewhat sorted
+ foreach $family ( sort keys %HoH ) {
+     print "$family: ";
+     for $role ( sort keys %{ $HoH{$family} } {
+         print "$role=$HoH{$family}{$role} ";
+     }
+     print "}\n";
+
+
+ # print the whole thing sorted by number of members
+ foreach $family ( sort { keys %{$HoH{$b}} <=> keys %{$HoH{$b}} } keys %HoH ) {
+     print "$family: ";
+     for $role ( sort keys %{ $HoH{$family} } {
+         print "$role=$HoH{$family}{$role} ";
+     }
+     print "}\n";
+
+
+ # establish a sort order (rank) for each role
+ $i = 0;
+ for ( qw(lead wife son daughter pal pet) ) { $rank{$_} = ++$i }
+
+ # now print the whole thing sorted by number of members
+ foreach $family ( sort { keys %{$HoH{$b}} <=> keys %{$HoH{$b}} } keys %HoH ) {
+     print "$family: ";
+     # and print these according to rank order
+     for $role ( sort { $rank{$a} <=> $rank{$b} keys %{ $HoH{$family} } {
+         print "$role=$HoH{$family}{$role} ";
+     }
+     print "}\n";
+
+
+=head1 MORE ELABORATE RECORDS
+
+=head2 Declaration of MORE ELABORATE RECORDS
+
+Here's a sample showing how to create and use a record whose fields are of
+many different sorts:
+
+     $rec = {
+         STRING  => $string,
+         LIST    => [ @old_values ],
+         LOOKUP  => { %some_table },
+         FUNC    => \&some_function,
+         FANON   => sub { $_[0] ** $_[1] },
+         FH      => \*STDOUT,
+     };
+
+     print $rec->{STRING};
+
+     print $rec->{LIST}[0];
+     $last = pop @ { $rec->{LIST} };
+
+     print $rec->{LOOKUP}{"key"};
+     ($first_k, $first_v) = each %{ $rec->{LOOKUP} };
+
+     $answer = &{ $rec->{FUNC} }($arg);
+     $answer = &{ $rec->{FANON} }($arg1, $arg2);
+
+     # careful of extra block braces on fh ref
+     print { $rec->{FH} } "a string\n";
+
+     use FileHandle;
+     $rec->{FH}->autoflush(1);
+     $rec->{FH}->print(" a string\n");
+
+=head2 Declaration of a HASH OF COMPLEX RECORDS
+
+     %TV = (
+        "flintstones" => {
+            series   => "flintstones",
+            nights   => [ qw(monday thursday friday) ];
+            members  => [
+                { name => "fred",    role => "lead", age  => 36, },
+                { name => "wilma",   role => "wife", age  => 31, },
+                { name => "pebbles", role => "kid", age  =>  4, },
+            ],
+        },
+
+        "jetsons"     => {
+            series   => "jetsons",
+            nights   => [ qw(wednesday saturday) ];
+            members  => [
+                { name => "george",  role => "lead", age  => 41, },
+                { name => "jane",    role => "wife", age  => 39, },
+                { name => "elroy",   role => "kid",  age  =>  9, },
+            ],
+         },
+
+        "simpsons"    => {
+            series   => "simpsons",
+            nights   => [ qw(monday) ];
+            members  => [
+                { name => "homer", role => "lead", age  => 34, },
+                { name => "marge", role => "wife", age => 37, },
+                { name => "bart",  role => "kid",  age  =>  11, },
+            ],
+         },
+      );
+
+=head2 Generation of a HASH OF COMPLEX RECORDS
+
+     # reading from file
+     # this is most easily done by having the file itself be
+     # in the raw data format as shown above.  perl is happy
+     # to parse complex datastructures if declared as data, so
+     # sometimes it's easiest to do that
+
+     # here's a piece by piece build up
+     $rec = {};
+     $rec->{series} = "flintstones";
+     $rec->{nights} = [ find_days() ];
+
+     @members = ();
+     # assume this file in field=value syntax
+     while () {
+         %fields = split /[\s=]+/;
+         push @members, { %fields };
+     }
+     $rec->{members} = [ @members ];
+
+     # now remember the whole thing
+     $TV{ $rec->{series} } = $rec;
+
+     ###########################################################
+     # now, you might want to make interesting extra fields that
+     # include pointers back into the same data structure so if
+     # change one piece, it changes everywhere, like for examples
+     # if you wanted a {kids} field that was an array reference
+     # to a list of the kids' records without having duplicate
+     # records and thus update problems.
+     ###########################################################
+     foreach $family (keys %TV) {
+         $rec = $TV{$family}; # temp pointer
+         @kids = ();
+         for $person ( @{$rec->{members}} ) {
+             if ($person->{role} =~ /kid|son|daughter/) {
+                 push @kids, $person;
+             }
+         }
+         # REMEMBER: $rec and $TV{$family} point to same data!!
+         $rec->{kids} = [ @kids ];
+     }
+
+     # you copied the list, but the list itself contains pointers
+     # to uncopied objects. this means that if you make bart get
+     # older via
+
+     $TV{simpsons}{kids}[0]{age}++;
+
+     # then this would also change in
+     print $TV{simpsons}{members}[2]{age};
+
+     # because $TV{simpsons}{kids}[0] and $TV{simpsons}{members}[2]
+     # both point to the same underlying anonymous hash table
+
+     # print the whole thing
+     foreach $family ( keys %TV ) {
+         print "the $family";
+         print " is on during @{ $TV{$family}{nights} }\n";
+         print "its members are:\n";
+         for $who ( @{ $TV{$family}{members} } ) {
+             print " $who->{name} ($who->{role}), age $who->{age}\n";
+         }
+         print "it turns out that $TV{$family}{'lead'} has ";
+         print scalar ( @{ $TV{$family}{kids} } ), " kids named ";
+         print join (", ", map { $_->{name} } @{ $TV{$family}{kids} } );
+         print "\n";
+     }
+
+=head1 Database Ties
+
+You cannot easily tie a multilevel data structure (such as a hash of
+hashes) to a dbm file.  The first problem is that all but GDBM and
+Berkeley DB have size limitations, but beyond that, you also have problems
+with how references are to be represented on disk.  One experimental
+module that does attempt to partially address this need is the MLDBM
+module.  Check your nearest CPAN site as described in L<perlmod> for
+source code to MLDBM.
+
+=head1 SEE ALSO
+
+L<perlref>, L<perllol>, L<perldata>, L<perlobj>
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt>
+
+Last update: 
+Tue Dec 12 09:20:26 MST 1995
+
diff --git a/gnu/usr.bin/perl/pod/perlembed.pod b/gnu/usr.bin/perl/pod/perlembed.pod
new file mode 100644
index 00000000000..2f0e9c30fbf
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlembed.pod
@@ -0,0 +1,565 @@
+=head1 NAME
+
+perlembed - how to embed perl in your C program
+
+=head1 DESCRIPTION
+
+=head2 PREAMBLE
+
+Do you want to:
+
+=over 5
+
+=item B<Use C from Perl?>  
+
+Read L<perlcall> and L<perlxs>.
+
+=item B<Use a UNIX program from Perl?>  
+
+Read about backquotes and L<perlfunc/system> and L<perlfunc/exec>.
+
+=item B<Use Perl from Perl?>  
+
+Read about L<perlfunc/do> and L<perlfunc/eval> and L<perlmod/use> 
+and L<perlmod/require>.
+
+=item B<Use C from C?>  
+
+Rethink your design.
+
+=item B<Use Perl from C?>  
+
+Read on...
+
+=back
+
+=head2 ROADMAP
+
+L<Compiling your C program>
+
+There's one example in each of the five sections:
+
+L<Adding a Perl interpreter to your C program>
+
+L<Calling a Perl subroutine from your C program>
+
+L<Evaluating a Perl statement from your C program>
+
+L<Performing Perl pattern matches and substitutions from your C program>
+
+L<Fiddling with the Perl stack from your C program>
+
+This documentation is UNIX specific.
+
+=head2 Compiling your C program
+
+Every C program that uses Perl must link in the I<perl library>.  
+
+What's that, you ask?  Perl is itself written in C; the perl library
+is the collection of compiled C programs that were used to create your
+perl executable (I</usr/bin/perl> or equivalent).  (Corollary: you
+can't use Perl from your C program unless Perl has been compiled on
+your machine, or installed properly--that's why you shouldn't blithely
+copy Perl executables from machine to machine without also copying the
+I<lib> directory.)
+
+Your C program will--usually--allocate, "run", and deallocate a
+I<PerlInterpreter> object, which is defined in the perl library.  
+
+If your copy of Perl is recent enough to contain this documentation
+(5.002 or later), then the perl library (and I<EXTERN.h> and
+I<perl.h>, which you'll also need) will
+reside in a directory resembling this:
+
+    /usr/local/lib/perl5/your_architecture_here/CORE
+
+or perhaps just
+
+    /usr/local/lib/perl5/CORE
+
+or maybe something like
+
+    /usr/opt/perl5/CORE
+
+Execute this statement for a hint about where to find CORE:
+
+    perl -e 'use Config; print $Config{archlib}'
+
+Here's how you might compile the example in the next section,
+L<Adding a Perl interpreter to your C program>,
+on a DEC Alpha running the OSF operating system:
+
+    % cc -o interp interp.c -L/usr/local/lib/perl5/alpha-dec_osf/CORE 
+    -I/usr/local/lib/perl5/alpha-dec_osf/CORE -lperl -lm
+
+You'll have to choose the appropriate compiler (I<cc>, I<gcc>, et al.)  and
+library directory (I</usr/local/lib/...>)  for your machine.  If your
+compiler complains that certain functions are undefined, or that it
+can't locate I<-lperl>, then you need to change the path following the
+-L.  If it complains that it can't find I<EXTERN.h> or I<perl.h>, you need
+to change the path following the -I.  
+
+You may have to add extra libraries as well.  Which ones?
+Perhaps those printed by 
+
+   perl -e 'use Config; print $Config{libs}'
+
+=head2 Adding a Perl interpreter to your C program
+
+In a sense, perl (the C program) is a good example of embedding Perl
+(the language), so I'll demonstrate embedding with I<miniperlmain.c>,
+from the source distribution.  Here's a bastardized, non-portable version of
+I<miniperlmain.c> containing the essentials of embedding:
+
+    #include <stdio.h>
+    #include <EXTERN.h>               /* from the Perl distribution     */
+    #include <perl.h>                 /* from the Perl distribution     */
+    
+    static PerlInterpreter *my_perl;  /***    The Perl interpreter    ***/
+   
+    int main(int argc, char **argv, char **env)
+    {
+        my_perl = perl_alloc();
+        perl_construct(my_perl);
+        perl_parse(my_perl, NULL, argc, argv, env);
+        perl_run(my_perl);
+        perl_destruct(my_perl);
+        perl_free(my_perl);
+    }
+
+Now compile this program (I'll call it I<interp.c>) into an executable:
+
+    % cc -o interp interp.c -L/usr/local/lib/perl5/alpha-dec_osf/CORE 
+    -I/usr/local/lib/perl5/alpha-dec_osf/CORE -lperl -lm
+
+After a successful compilation, you'll be able to use I<interp> just
+like perl itself:
+
+    % interp
+    print "Pretty Good Perl \n";
+    print "10890 - 9801 is ", 10890 - 9801;
+    <CTRL-D>
+    Pretty Good Perl
+    10890 - 9801 is 1089
+
+or
+
+    % interp -e 'printf("%x", 3735928559)'
+    deadbeef
+
+You can also read and execute Perl statements from a file while in the
+midst of your C program, by placing the filename in I<argv[1]> before
+calling I<perl_run()>.  
+
+=head2 Calling a Perl subroutine from your C program
+
+To call individual Perl subroutines, you'll need to remove the call to
+I<perl_run()> and replace it with a call to I<perl_call_argv()>.
+
+That's shown below, in a program I'll call I<showtime.c>.
+
+    #include <stdio.h>
+    #include <EXTERN.h>
+    #include <perl.h>                 
+    
+    static PerlInterpreter *my_perl;  
+    
+    int main(int argc, char **argv, char **env)
+    {
+        my_perl = perl_alloc();
+        perl_construct(my_perl);
+    
+        perl_parse(my_perl, NULL, argc, argv, env);
+    
+                                     /*** This replaces perl_run() ***/
+        perl_call_argv("showtime", G_DISCARD | G_NOARGS, argv);
+        perl_destruct(my_perl);
+        perl_free(my_perl);
+    }
+
+where I<showtime> is a Perl subroutine that takes no arguments (that's the
+I<G_NOARGS>) and for which I'll ignore the return value (that's the 
+I<G_DISCARD>).  Those flags, and others, are discussed in L<perlcall>.
+
+I'll define the I<showtime> subroutine in a file called I<showtime.pl>:
+
+    print "I shan't be printed.";
+    
+    sub showtime {
+        print time;
+    }
+
+Simple enough.  Now compile and run:
+
+    % cc -o showtime showtime.c -L/usr/local/lib/perl5/alpha-dec_osf/CORE 
+    -I/usr/local/lib/perl5/alpha-dec_osf/CORE -lperl -lm
+    
+    % showtime showtime.pl
+    818284590
+
+yielding the number of seconds that elapsed between January 1, 1970
+(the beginning of the UNIX epoch), and the moment I began writing this
+sentence.
+
+If you want to pass some arguments to the Perl subroutine, or
+you want to access the return value, you'll need to manipulate the
+Perl stack, demonstrated in the last section of this document: 
+L<Fiddling with the Perl stack from your C program>
+
+=head2 Evaluating a Perl statement from your C program
+
+NOTE: This section, and the next, employ some very brittle techniques
+for evaluting strings of Perl code.  Perl 5.002 contains some nifty
+features that enable A Better Way (such as with L<perlguts/perl_eval_sv>).
+Look for updates to this document soon.
+
+One way to evaluate a Perl string is to define a function (we'll call 
+ours I<perl_eval()>) that wraps around Perl's L<perlfunc/eval>.
+
+Arguably, this is the only routine you'll ever need to execute
+snippets of Perl code from within your C program.  Your string can be
+as long as you wish; it can contain multiple statements; it can
+use L<perlmod/require> or L<perlfunc/do> to include external Perl
+files.  
+
+Our I<perl_eval()> lets us evaluate individual Perl strings, and then 
+extract variables for coercion into C types.  The following program, 
+I<string.c>, executes three Perl strings, extracting an C<int> from
+the first, a C<float> from the second, and a C<char *> from the third.
+
+   #include <stdio.h>
+   #include <EXTERN.h>
+   #include <perl.h>
+   
+   static PerlInterpreter *my_perl;
+   
+   int perl_eval(char *string)
+   {
+     char *argv[2];
+     argv[0] = string;
+     argv[1] = NULL;
+     perl_call_argv("_eval_", 0, argv);
+   }
+   
+   main (int argc, char **argv, char **env)
+   {
+     char *embedding[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
+     STRLEN length;
+   
+     my_perl = perl_alloc();
+     perl_construct( my_perl );
+   
+     perl_parse(my_perl, NULL, 3, embedding, env);
+   
+                                       /** Treat $a as an integer **/
+     perl_eval("$a = 3; $a **= 2");
+     printf("a = %d\n", SvIV(perl_get_sv("a", FALSE)));
+   
+                                       /** Treat $a as a float **/
+     perl_eval("$a = 3.14; $a **= 2");
+     printf("a = %f\n", SvNV(perl_get_sv("a", FALSE)));
+   
+                                       /** Treat $a as a string **/
+     perl_eval("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a); ");
+     printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), length));
+   
+     perl_destruct(my_perl);
+     perl_free(my_perl);
+   }
+
+All of those strange functions with I<sv> in their names help convert Perl scalars to C types.  They're described in L<perlguts>.
+
+If you compile and run I<string.c>, you'll see the results of using
+I<SvIV()> to create an C<int>, I<SvNV()> to create a C<float>, and
+I<SvPV()> to create a string:
+
+   a = 9
+   a = 9.859600
+   a = Just Another Perl Hacker
+
+
+=head2 Performing Perl pattern matches and substitutions from your C program
+
+Our I<perl_eval()> lets us evaluate strings of Perl code, so we can
+define some functions that use it to "specialize" in matches and
+substitutions: I<match()>, I<substitute()>, and I<matches()>.
+
+   char match(char *string, char *pattern); 
+
+Given a string and a pattern (e.g. "m/clasp/" or "/\b\w*\b/", which in
+your program might be represented as C<"/\\b\\w*\\b/">),
+returns 1 if the string matches the pattern and 0 otherwise.
+
+
+   int substitute(char *string[], char *pattern);
+
+Given a pointer to a string and an "=~" operation (e.g. "s/bob/robert/g" or 
+"tr[A-Z][a-z]"), modifies the string according to the operation,
+returning the number of substitutions made.
+
+   int matches(char *string, char *pattern, char **matches[]);
+
+Given a string, a pattern, and a pointer to an empty array of strings,
+evaluates C<$string =~ $pattern> in an array context, and fills in
+I<matches> with the array elements (allocating memory as it does so), 
+returning the number of matches found.
+
+Here's a sample program, I<match.c>, that uses all three:
+
+   #include <stdio.h>
+   #include <EXTERN.h>
+   #include <perl.h>
+   
+   static PerlInterpreter *my_perl;
+   
+   int eval(char *string)
+   {
+     char *argv[2];
+     argv[0] = string;
+     argv[1] = NULL;
+     perl_call_argv("_eval_", 0, argv);
+   }
+   
+   /** match(string, pattern)
+    ** 
+    ** Used for matches in a scalar context.
+    **
+    ** Returns 1 if the match was successful; 0 otherwise. 
+    **/
+   char match(char *string, char *pattern) 
+   {
+     char *command;
+     command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 37);
+     sprintf(command, "$string = '%s'; $return = $string =~ %s", 
+	string, pattern); 
+     perl_eval(command);
+     free(command);
+     return SvIV(perl_get_sv("return", FALSE));
+   }
+   
+   /** substitute(string, pattern)
+    **
+    ** Used for =~ operations that modify their left-hand side (s/// and tr///)
+    **
+    ** Returns the number of successful matches, and
+    ** modifies the input string if there were any.
+    **/
+   int substitute(char *string[], char *pattern) 
+   {
+     char *command;
+     STRLEN length;
+     command = malloc(sizeof(char) * strlen(*string) + strlen(pattern) + 35);
+     sprintf(command, "$string = '%s'; $ret = ($string =~ %s)", 
+	*string, pattern); 
+     perl_eval(command);
+     free(command);
+     *string = SvPV(perl_get_sv("string", FALSE), length);
+     return SvIV(perl_get_sv("ret", FALSE));
+   }
+   
+   /** matches(string, pattern, matches)
+    ** 
+    ** Used for matches in an array context.
+    **
+    ** Returns the number of matches, 
+    ** and fills in **matches with the matching substrings (allocates memory!)
+    **/
+   int matches(char *string, char *pattern, char **matches[]) 
+   {
+     char *command;
+     SV *current_match;
+     AV *array;
+     I32 num_matches;
+     STRLEN length;
+     int i;
+   
+     command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38);
+     sprintf(command, "$string = '%s'; @array = ($string =~ %s)", 
+	string, pattern); 
+     perl_eval(command);
+     free(command);
+     array = perl_get_av("array", FALSE);
+     num_matches = av_len(array) + 1; /** assume $[ is 0 **/
+     *matches = (char **) malloc(sizeof(char *) * num_matches);
+     for (i = 0; i <= num_matches; i++) {  
+       current_match = av_shift(array);
+       (*matches)[i] = SvPV(current_match, length);
+     }
+     return num_matches;
+   }
+   
+   main (int argc, char **argv, char **env)
+   {
+     char *embedding[] = { "", "-e", "sub _eval_ { eval $_[0] }" };
+     char *text, **matches;
+     int num_matches, i;
+     int j;
+   
+     my_perl = perl_alloc();
+     perl_construct( my_perl );
+   
+     perl_parse(my_perl, NULL, 3, embedding, env);
+   
+     text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/
+     sprintf(text, "%s", "When he is at a convenience store and the bill comes to some amount like 76 cents, Maynard is aware that there is something he *should* do, something that will enable him to get back a quarter, but he has no idea *what*.  He fumbles through his red squeezey changepurse and gives the boy three extra pennies with his dollar, hoping that he might luck into the correct amount.  The boy gives him back two of his own pennies and then the big shiny quarter that is his prize. -RICHH");  
+   
+     if (perl_match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
+       printf("perl_match: Text contains the word 'quarter'.\n\n");
+     else 
+       printf("perl_match: Text doesn't contain the word 'quarter'.\n\n");
+   
+     if (perl_match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
+       printf("perl_match: Text contains the word 'eighth'.\n\n");
+     else 
+       printf("perl_match: Text doesn't contain the word 'eighth'.\n\n");
+   
+	                               /** Match all occurrences of /wi../ **/
+     num_matches = perl_matches(text, "m/(wi..)/g", &matches);
+     
+     printf("perl_matches: m/(wi..)/g found %d matches...\n", num_matches);
+     for (i = 0; i < num_matches; i++) 
+       printf("match: %s\n", matches[i]);
+     printf("\n");
+     for (i = 0; i < num_matches; i++) {
+       free(matches[i]);
+     }
+     free(matches);
+   
+                                       /** Remove all vowels from text **/
+     num_matches = perl_substitute(&text, "s/[aeiou]//gi");
+     if (num_matches) {
+       printf("perl_substitute: s/[aeiou]//gi...%d substitutions made.\n", 
+	num_matches);
+       printf("Now text is: %s\n\n", text);
+     }
+   
+                                       /** Attempt a substitution
+     if (!perl_substitute(&text, "s/Perl/C/")) {
+       printf("perl_substitute: s/Perl/C...No substitution made.\n\n");
+     }
+   
+     free(text);
+   
+     perl_destruct(my_perl);
+     perl_free(my_perl);
+   }
+
+which produces the output
+
+   perl_match: Text contains the word 'quarter'.
+   
+   perl_match: Text doesn't contain the word 'eighth'.
+   
+   perl_matches: m/(wi..)/g found 2 matches...
+   match: will
+   match: with
+   
+   perl_substitute: s/[aeiou]//gi...139 substitutions made.
+   Now text is: Whn h s t  cnvnnc str nd th bll cms t sm mnt lk 76 cnts, Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt bck  qrtr, bt h hs n d *wht*.  H fmbls thrgh hs rd sqzy chngprs nd gvs th by thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct mnt.  Th by gvs hm bck tw f hs wn pnns nd thn th bg shny qrtr tht s hs prz. -RCHH
+   
+   perl_substitute: s/Perl/C...No substitution made.
+      
+=head2 Fiddling with the Perl stack from your C program
+
+When trying to explain stacks, most computer science textbooks mumble
+something about spring-loaded columns of cafeteria plates: the last
+thing you pushed on the stack is the first thing you pop off.  That'll
+do for our purposes: your C program will push some arguments onto "the Perl
+stack", shut its eyes while some magic happens, and then pop the
+results--the return value of your Perl subroutine--off the stack.
+   
+First you'll need to know how to convert between C types and Perl
+types, with newSViv() and sv_setnv() and newAV() and all their
+friends.  They're described in L<perlguts>.
+
+Then you'll need to know how to manipulate the Perl stack.  That's
+described in L<perlcall>.
+
+Once you've understood those, embedding Perl in C is easy.  
+
+Since C has no built-in function for integer exponentiation, let's
+make Perl's ** operator available to it (this is less useful than it
+sounds, since Perl implements ** with C's I<pow()> function).  First
+I'll create a stub exponentiation function in I<power.pl>:
+
+    sub expo {
+        my ($a, $b) = @_;
+        return $a ** $b;
+    }
+
+Now I'll create a C program, I<power.c>, with a function
+I<PerlPower()> that contains all the perlguts necessary to push the
+two arguments into I<expo()> and to pop the return value out.  Take a
+deep breath...
+
+    #include <stdio.h>
+    #include <EXTERN.h>
+    #include <perl.h>
+    
+    static PerlInterpreter *my_perl;
+    
+    static void
+    PerlPower(int a, int b)
+    {
+      dSP;                            /* initialize stack pointer      */
+      ENTER;                          /* everything created after here */
+      SAVETMPS;                       /* ...is a temporary variable.   */
+      PUSHMARK(sp);                   /* remember the stack pointer    */
+      XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack  */
+      XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack  */
+      PUTBACK;                      /* make local stack pointer global */
+      perl_call_pv("expo", G_SCALAR); /* call the function             */
+      SPAGAIN;                        /* refresh stack pointer         */
+                                    /* pop the return value from stack */
+      printf ("%d to the %dth power is %d.\n", a, b, POPi);
+      PUTBACK;                               
+      FREETMPS;                       /* free that return value        */
+      LEAVE;                       /* ...and the XPUSHed "mortal" args.*/
+    }
+    
+    int main (int argc, char **argv, char **env) 
+    {
+      char *my_argv[2];
+    
+      my_perl = perl_alloc();
+      perl_construct( my_perl );
+    
+      my_argv[1] = (char *) malloc(10);
+      sprintf(my_argv[1], "power.pl");
+    
+      perl_parse(my_perl, NULL, argc, my_argv, env);
+      
+      PerlPower(3, 4);                      /*** Compute 3 ** 4 ***/
+    
+      perl_destruct(my_perl);
+      perl_free(my_perl);
+    }
+    
+
+
+Compile and run:
+
+    % cc -o power power.c -L/usr/local/lib/perl5/alpha-dec_osf/CORE 
+    -I/usr/local/lib/perl5/alpha-dec_osf/CORE -lperl -lm
+    
+    % power 
+    3 to the 4th power is 81.
+
+=head1 MORAL
+
+You can sometimes I<write faster code> in C, but
+you can always I<write code faster> in Perl.  Since you can use
+each from the other, combine them as you wish.
+
+
+=head1 AUTHOR
+
+Jon Orwant F<E<lt>orwant@media.mit.eduE<gt>>, with contributions from
+Tim Bunce, Tom Christiansen, Dov Grobgeld, and Ilya Zakharevich.
+
+December 18, 1995
+
+Some of this material is excerpted from my book: I<Perl 5 Interactive>, 
+Waite Group Press, 1996 (ISBN 1-57169-064-6) and appears
+courtesy of Waite Group Press.
+
diff --git a/gnu/usr.bin/perl/pod/perlform.pod b/gnu/usr.bin/perl/pod/perlform.pod
new file mode 100644
index 00000000000..cf0bc068f16
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlform.pod
@@ -0,0 +1,315 @@
+=head1 NAME
+
+perlform - Perl formats
+
+=head1 DESCRIPTION
+
+Perl has a mechanism to help you generate simple reports and charts.  To
+facilitate this, Perl helps you code up your output page 
+close to how it will look when it's printed.  It can keep
+track of things like how many lines on a page, what page you're on, when to
+print page headers, etc.  Keywords are borrowed from FORTRAN:
+format() to declare and write() to execute; see their entries in
+L<perlfunc>.  Fortunately, the layout is much more legible, more like
+BASIC's PRINT USING statement.  Think of it as a poor man's nroff(1).
+
+Formats, like packages and subroutines, are declared rather than executed,
+so they may occur at any point in your program.  (Usually it's best to
+keep them all together though.) They have their own namespace apart from
+all the other "types" in Perl.  This means that if you have a function
+named "Foo", it is not the same thing as having a format named "Foo".
+However, the default name for the format associated with a given
+filehandle is the same as the name of the filehandle.  Thus, the default
+format for STDOUT is name "STDOUT", and the default format for filehandle
+TEMP is name "TEMP".  They just look the same.  They aren't.
+
+Output record formats are declared as follows:
+
+    format NAME =
+    FORMLIST
+    .
+
+If name is omitted, format "STDOUT" is defined.  FORMLIST consists of a
+sequence of lines, each of which may be of one of three types:
+
+=over 4
+
+=item 1.
+
+A comment, indicated by putting a '#' in the first column.
+
+=item 2.
+
+A "picture" line giving the format for one output line.
+
+=item 3.
+
+An argument line supplying values to plug into the previous picture line.
+
+=back
+
+Picture lines are printed exactly as they look, except for certain fields
+that substitute values into the line.  Each field in a picture line starts
+with either "@" (at) or "^" (caret).  These lines do not undergo any kind
+of variable interpolation.  The at field (not to be confused with the array
+marker @) is the normal kind of field; the other kind, caret fields, are used
+to do rudimentary multi-line text block filling.  The length of the field
+is supplied by padding out the field with multiple "<", ">", or "|"
+characters to specify, respectively, left justification, right
+justification, or centering.  If the variable would exceed the width
+specified, it is truncated.
+
+As an alternate form of right justification, you may also use "#"
+characters (with an optional ".") to specify a numeric field.  This way
+you can line up the decimal points.  If any value supplied for these
+fields contains a newline, only the text up to the newline is printed.
+Finally, the special field "@*" can be used for printing multi-line,
+non-truncated values; it should appear by itself on a line.
+
+The values are specified on the following line in the same order as
+the picture fields.  The expressions providing the values should be
+separated by commas.  The expressions are all evaluated in a list context
+before the line is processed, so a single list expression could produce
+multiple list elements.  The expressions may be spread out to more than
+one line if enclosed in braces.  If so, the opening brace must be the first
+token on the first line.
+
+Picture fields that begin with ^ rather than @ are treated specially.
+With a # field, the field is blanked out if the value is undefined.  For
+other field types, the caret enables a kind of fill mode.  Instead of an
+arbitrary expression, the value supplied must be a scalar variable name
+that contains a text string.  Perl puts as much text as it can into the
+field, and then chops off the front of the string so that the next time
+the variable is referenced, more of the text can be printed.  (Yes, this
+means that the variable itself is altered during execution of the write()
+call, and is not returned.)  Normally you would use a sequence of fields
+in a vertical stack to print out a block of text.  You might wish to end
+the final field with the text "...", which will appear in the output if
+the text was too long to appear in its entirety.  You can change which
+characters are legal to break on by changing the variable C<$:> (that's
+$FORMAT_LINE_BREAK_CHARACTERS if you're using the English module) to a
+list of the desired characters.
+
+Using caret fields can produce variable length records.  If the text
+to be formatted is short, you can suppress blank lines by putting a
+"~" (tilde) character anywhere in the line.  The tilde will be translated
+to a space upon output.  If you put a second tilde contiguous to the
+first, the line will be repeated until all the fields on the line are
+exhausted.  (If you use a field of the at variety, the expression you
+supply had better not give the same value every time forever!)
+
+Top-of-form processing is by default handled by a format with the 
+same name as the current filehandle with "_TOP" concatenated to it.
+It's triggered at the top of each page.  See <perlfunc/write()>.
+
+Examples:
+
+ # a report on the /etc/passwd file
+ format STDOUT_TOP =
+                         Passwd File
+ Name                Login    Office   Uid   Gid Home
+ ------------------------------------------------------------------
+ .
+ format STDOUT =
+ @<<<<<<<<<<<<<<<<<< @||||||| @<<<<<<@>>>> @>>>> @<<<<<<<<<<<<<<<<<
+ $name,              $login,  $office,$uid,$gid, $home
+ .
+
+
+ # a report from a bug report form
+ format STDOUT_TOP =
+                         Bug Reports
+ @<<<<<<<<<<<<<<<<<<<<<<<     @|||         @>>>>>>>>>>>>>>>>>>>>>>>
+ $system,                      $%,         $date
+ ------------------------------------------------------------------
+ .
+ format STDOUT =
+ Subject: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+          $subject
+ Index: @<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+        $index,                       $description
+ Priority: @<<<<<<<<<< Date: @<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+           $priority,        $date,   $description
+ From: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+       $from,                         $description
+ Assigned to: @<<<<<<<<<<<<<<<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+              $programmer,            $description
+ ~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                      $description
+ ~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                      $description
+ ~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                      $description
+ ~                                    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                      $description
+ ~                                    ^<<<<<<<<<<<<<<<<<<<<<<<...
+                                      $description
+ .
+
+It is possible to intermix print()s with write()s on the same output
+channel, but you'll have to handle $- ($FORMAT_LINES_LEFT)
+yourself.
+
+=head2 Format Variables
+
+The current format name is stored in the variable C<$~> ($FORMAT_NAME),
+and the current top of form format name is in C<$^> ($FORMAT_TOP_NAME).
+The current output page number is stored in C<$%> ($FORMAT_PAGE_NUMBER),
+and the number of lines on the page is in C<$=> ($FORMAT_LINES_PER_PAGE).
+Whether to autoflush output on this handle is stored in C<$|>
+($OUTPUT_AUTOFLUSH).  The string output before each top of page (except
+the first) is stored in C<$^L> ($FORMAT_FORMFEED).  These variables are
+set on a per-filehandle basis, so you'll need to select() into a different
+one to affect them:
+
+    select((select(OUTF), 
+	    $~ = "My_Other_Format",
+	    $^ = "My_Top_Format"
+	   )[0]);
+
+Pretty ugly, eh?  It's a common idiom though, so don't be too surprised
+when you see it.  You can at least use a temporary variable to hold
+the previous filehandle: (this is a much better approach in general,
+because not only does legibility improve, you now have intermediary
+stage in the expression to single-step the debugger through):
+
+    $ofh = select(OUTF);
+    $~ = "My_Other_Format";
+    $^ = "My_Top_Format";
+    select($ofh);
+
+If you use the English module, you can even read the variable names:
+
+    use English;
+    $ofh = select(OUTF);
+    $FORMAT_NAME     = "My_Other_Format";
+    $FORMAT_TOP_NAME = "My_Top_Format";
+    select($ofh);
+
+But you still have those funny select()s.  So just use the FileHandle
+module.  Now, you can access these special variables using lower-case
+method names instead:
+
+    use FileHandle;
+    format_name     OUTF "My_Other_Format";
+    format_top_name OUTF "My_Top_Format";
+
+Much better!
+
+=head1 NOTES
+
+Since the values line may contain arbitrary expressions (for at fields, 
+not caret fields), you can farm out more sophisticated processing
+to other functions, like sprintf() or one of your own.  For example:
+
+    format Ident = 
+	@<<<<<<<<<<<<<<<
+	&commify($n)
+    .
+
+To get a real at or caret into the field, do this:
+
+    format Ident = 
+    I have an @ here.
+	    "@"
+    .
+
+To center a whole line of text, do something like this:
+
+    format Ident = 
+    @|||||||||||||||||||||||||||||||||||||||||||||||
+	    "Some text line"
+    .
+
+There is no builtin way to say "float this to the right hand side
+of the page, however wide it is."  You have to specify where it goes.
+The truly desperate can generate their own format on the fly, based
+on the current number of columns, and then eval() it:
+
+    $format  = "format STDOUT = \n";
+             . '^' . '<' x $cols . "\n";
+             . '$entry' . "\n";
+             . "\t^" . "<" x ($cols-8) . "~~\n";
+             . '$entry' . "\n";
+             . ".\n";
+    print $format if $Debugging;
+    eval $format; 
+    die $@ if $@;
+
+Which would generate a format looking something like this:
+
+ format STDOUT = 
+ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $entry
+         ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+ $entry
+ .
+
+Here's a little program that's somewhat like fmt(1):
+
+ format = 
+ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
+ $_
+
+ .
+
+ $/ = '';
+ while (<>) {
+     s/\s*\n\s*/ /g;
+     write;
+ } 
+
+=head2 Footers
+
+While $FORMAT_TOP_NAME contains the name of the current header format,
+there is no corresponding mechanism to automatically do the same thing
+for a footer.  Not knowing how big a format is going to be until you
+evaluate it is one of the major problems.  It's on the TODO list.
+
+Here's one strategy:  If you have a fixed-size footer, you can get footers
+by checking $FORMAT_LINES_LEFT before each write() and print the footer
+yourself if necessary.
+
+Here's another strategy; open a pipe to yourself, using C<open(MESELF, "|-")> 
+(see L<perlfunc/open()>) and always write() to MESELF instead of
+STDOUT.  Have your child process postprocesses its STDIN to rearrange
+headers and footers however you like.  Not very convenient, but doable.
+
+=head2 Accessing Formatting Internals
+
+For low-level access to the formatting mechanism.  you may use formline()
+and access C<$^A> (the $ACCUMULATOR variable) directly.
+
+For example:
+
+    $str = formline <<'END', 1,2,3;
+    @<<<  @|||  @>>>
+    END
+
+    print "Wow, I just stored `$^A' in the accumulator!\n";
+
+Or to make an swrite() subroutine which is to write() what sprintf()
+is to printf(), do this:
+
+    use Carp;
+    sub swrite {
+	croak "usage: swrite PICTURE ARGS" unless @_;
+	my $format = shift;
+	$^A = "";
+	formline($format,@_);
+	return $^A;
+    } 
+
+    $string = swrite(<<'END', 1, 2, 3);
+ Check me out
+ @<<<  @|||  @>>>
+ END
+    print $string;
+
+=head1 WARNING
+
+Lexical variables (declared with "my") are not visible within a
+format unless the format is declared within the scope of the lexical
+variable.  (They weren't visible at all before version 5.001.)  Furthermore,
+lexical aliases will not be compiled correctly: see
+L<perlfunc/my> for other issues.
diff --git a/gnu/usr.bin/perl/pod/perlfunc.pod b/gnu/usr.bin/perl/pod/perlfunc.pod
new file mode 100644
index 00000000000..28b5442e909
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlfunc.pod
@@ -0,0 +1,3346 @@
+=head1 NAME
+
+perlfunc - Perl builtin functions
+
+=head1 DESCRIPTION
+
+The functions in this section can serve as terms in an expression.
+They fall into two major categories: list operators and named unary
+operators.  These differ in their precedence relationship with a
+following comma.  (See the precedence table in L<perlop>.)  List
+operators take more than one argument, while unary operators can never
+take more than one argument.  Thus, a comma terminates the argument of
+a unary operator, but merely separates the arguments of a list
+operator.  A unary operator generally provides a scalar context to its
+argument, while a list operator may provide either scalar and list
+contexts for its arguments.  If it does both, the scalar arguments will
+be first, and the list argument will follow.  (Note that there can only
+ever be one list argument.)  For instance, splice() has three scalar
+arguments followed by a list.
+
+In the syntax descriptions that follow, list operators that expect a
+list (and provide list context for the elements of the list) are shown
+with LIST as an argument.  Such a list may consist of any combination
+of scalar arguments or list values; the list values will be included
+in the list as if each individual element were interpolated at that
+point in the list, forming a longer single-dimensional list value.
+Elements of the LIST should be separated by commas.
+
+Any function in the list below may be used either with or without
+parentheses around its arguments.  (The syntax descriptions omit the
+parens.)  If you use the parens, the simple (but occasionally
+surprising) rule is this: It I<LOOKS> like a function, therefore it I<IS> a
+function, and precedence doesn't matter.  Otherwise it's a list
+operator or unary operator, and precedence does matter.  And whitespace
+between the function and left parenthesis doesn't count--so you need to
+be careful sometimes:
+
+    print 1+2+3;	# Prints 6.
+    print(1+2) + 3;	# Prints 3.
+    print (1+2)+3;	# Also prints 3!
+    print +(1+2)+3;	# Prints 6.
+    print ((1+2)+3);	# Prints 6.
+
+If you run Perl with the B<-w> switch it can warn you about this.  For
+example, the third line above produces:
+
+    print (...) interpreted as function at - line 1.
+    Useless use of integer addition in void context at - line 1.
+
+For functions that can be used in either a scalar or list context,
+non-abortive failure is generally indicated in a scalar context by
+returning the undefined value, and in a list context by returning the
+null list.
+
+Remember the following rule:
+
+=over 8
+
+=item  
+
+I<THERE IS NO GENERAL RULE FOR CONVERTING A LIST INTO A SCALAR!>
+
+=back
+
+Each operator and function decides which sort of value it would be most
+appropriate to return in a scalar context.  Some operators return the
+length of the list that would have been returned in a list context.  Some
+operators return the first value in the list.  Some operators return the
+last value in the list.  Some operators return a count of successful
+operations.  In general, they do what you want, unless you want
+consistency.
+
+=head2 Perl Functions by Category
+
+Here are Perl's functions (including things that look like
+functions, like some of the keywords and named operators)
+arranged by category.  Some functions appear in more
+than one place.
+
+=over
+
+=item Functions for SCALARs or strings
+
+chomp, chop, chr, crypt, hex, index, lc, lcfirst, length,
+oct, ord, pack, q/STRING/, qq/STRING/, reverse, rindex,
+sprintf, substr, tr///, uc, ucfirst, y///
+
+=item Regular expressions and pattern matching
+
+m//, pos, quotemeta, s///, split, study
+
+=item Numeric functions
+
+abs, atan2, cos, exp, hex, int, log, oct, rand, sin, sqrt,
+srand
+
+=item Functions for real @ARRAYs
+
+pop, push, shift, splice, unshift
+
+=item Functions for list data
+
+grep, join, map, qw/STRING/, reverse, sort, unpack
+
+=item Functions for real %HASHes
+
+delete, each, exists, keys, values
+
+=item Input and output functions
+
+binmode, close, closedir, dbmclose, dbmopen, die, eof,
+fileno, flock, format, getc, print, printf, read, readdir,
+rewinddir, seek, seekdir, select, syscall, sysread,
+syswrite, tell, telldir, truncate, warn, write
+
+=item Functions for fixed length data or records
+
+pack, read, syscall, sysread, syswrite, unpack, vec
+
+=item Functions for filehandles, files, or directories
+
+-X, chdir, chmod, chown, chroot, fcntl, glob, ioctl, link,
+lstat, mkdir, open, opendir, readlink, rename, rmdir,
+stat, symlink, umask, unlink, utime
+
+=item Keywords related to the control flow of your perl program
+
+caller, continue, die, do, dump, eval, exit, goto, last,
+next, redo, return, sub, wantarray
+
+=item Keywords related to scoping 
+
+caller, import, local, my, package, use
+
+=item Miscellaneous functions
+
+defined, dump, eval, formline, local, my, reset, scalar,
+undef, wantarray
+
+=item Functions for processes and process groups
+
+alarm, exec, fork, getpgrp, getppid, getpriority, kill,
+pipe, qx/STRING/, setpgrp, setpriority, sleep, system,
+times, wait, waitpid
+
+=item Keywords related to perl modules
+
+do, import, no, package, require, use
+
+=item Keywords related to classes and object-orientedness
+
+bless, dbmclose, dbmopen, package, ref, tie, tied, untie, use
+
+=item Low-level socket functions
+
+accept, bind, connect, getpeername, getsockname,
+getsockopt, listen, recv, send, setsockopt, shutdown,
+socket, socketpair
+
+=item System V interprocess communication functions
+
+msgctl, msgget, msgrcv, msgsnd, semctl, semget, semop,
+shmctl, shmget, shmread, shmwrite
+
+=item Fetching user and group info
+
+endgrent, endhostent, endnetent, endpwent, getgrent,
+getgrgid, getgrnam, getlogin, getpwent, getpwnam,
+getpwuid, setgrent, setpwent
+
+=item Fetching network info
+
+endprotoent, endservent, gethostbyaddr, gethostbyname,
+gethostent, getnetbyaddr, getnetbyname, getnetent,
+getprotobyname, getprotobynumber, getprotoent,
+getservbyname, getservbyport, getservent, sethostent,
+setnetent, setprotoent, setservent
+
+=item Time-related functions
+
+gmtime, localtime, time, times
+
+=item Functions new in perl5
+
+abs, bless, chomp, chr, exists, formline, glob, import, lc,
+lcfirst, map, my, no, qx, qw, ref, sub*, sysopen, tie, tied, uc,
+ucfirst, untie, use
+
+* - C<sub> was a keyword in perl4, but in perl5 it is an
+operator which can be used in expressions.
+
+=item Functions obsoleted in perl5
+
+dbmclose, dbmopen
+
+
+=back
+
+=head2 Alphabetical Listing of Perl Functions
+
+
+=over 8
+
+=item -X FILEHANDLE
+
+=item -X EXPR
+
+=item -X
+
+A file test, where X is one of the letters listed below.  This unary
+operator takes one argument, either a filename or a filehandle, and
+tests the associated file to see if something is true about it.  If the
+argument is omitted, tests $_, except for C<-t>, which tests STDIN.
+Unless otherwise documented, it returns C<1> for TRUE and C<''> for FALSE, or
+the undefined value if the file doesn't exist.  Despite the funny
+names, precedence is the same as any other named unary operator, and
+the argument may be parenthesized like any other unary operator.  The
+operator may be any of:
+
+    -r	File is readable by effective uid/gid.
+    -w	File is writable by effective uid/gid.
+    -x	File is executable by effective uid/gid.
+    -o	File is owned by effective uid.
+
+    -R	File is readable by real uid/gid.
+    -W	File is writable by real uid/gid.
+    -X	File is executable by real uid/gid.
+    -O	File is owned by real uid.
+
+    -e	File exists.
+    -z	File has zero size.
+    -s	File has non-zero size (returns size).
+
+    -f	File is a plain file.
+    -d	File is a directory.
+    -l	File is a symbolic link.
+    -p	File is a named pipe (FIFO).
+    -S	File is a socket.
+    -b	File is a block special file.
+    -c	File is a character special file.
+    -t	Filehandle is opened to a tty.
+
+    -u	File has setuid bit set.
+    -g	File has setgid bit set.
+    -k	File has sticky bit set.
+
+    -T	File is a text file.
+    -B	File is a binary file (opposite of -T).
+
+    -M	Age of file in days when script started.
+    -A	Same for access time.
+    -C	Same for inode change time.
+
+The interpretation of the file permission operators C<-r>, C<-R>, C<-w>,
+C<-W>, C<-x> and C<-X> is based solely on the mode of the file and the
+uids and gids of the user.  There may be other reasons you can't actually
+read, write or execute the file.  Also note that, for the superuser,
+C<-r>, C<-R>, C<-w> and C<-W> always return 1, and C<-x> and C<-X> return
+1 if any execute bit is set in the mode.  Scripts run by the superuser may
+thus need to do a stat() in order to determine the actual mode of the
+file, or temporarily set the uid to something else.
+
+Example:
+
+    while (<>) {
+	chop;
+	next unless -f $_;	# ignore specials
+	...
+    }
+
+Note that C<-s/a/b/> does not do a negated substitution.  Saying
+C<-exp($foo)> still works as expected, however--only single letters
+following a minus are interpreted as file tests.
+
+The C<-T> and C<-B> switches work as follows.  The first block or so of the
+file is examined for odd characters such as strange control codes or
+characters with the high bit set.  If too many odd characters (>30%)
+are found, it's a C<-B> file, otherwise it's a C<-T> file.  Also, any file
+containing null in the first block is considered a binary file.  If C<-T>
+or C<-B> is used on a filehandle, the current stdio buffer is examined
+rather than the first block.  Both C<-T> and C<-B> return TRUE on a null
+file, or a file at EOF when testing a filehandle.  Because you have to 
+read a file to do the C<-T> test, on most occasions you want to use a C<-f>
+against the file first, as in C<next unless -f $file && -T $file>.
+
+If any of the file tests (or either the stat() or lstat() operators) are given the
+special filehandle consisting of a solitary underline, then the stat
+structure of the previous file test (or stat operator) is used, saving
+a system call.  (This doesn't work with C<-t>, and you need to remember
+that lstat() and C<-l> will leave values in the stat structure for the
+symbolic link, not the real file.)  Example:
+
+    print "Can do.\n" if -r $a || -w _ || -x _;
+
+    stat($filename);
+    print "Readable\n" if -r _;
+    print "Writable\n" if -w _;
+    print "Executable\n" if -x _;
+    print "Setuid\n" if -u _;
+    print "Setgid\n" if -g _;
+    print "Sticky\n" if -k _;
+    print "Text\n" if -T _;
+    print "Binary\n" if -B _;
+
+=item abs VALUE
+
+Returns the absolute value of its argument.
+
+=item accept NEWSOCKET,GENERICSOCKET
+
+Accepts an incoming socket connect, just as the accept(2) system call
+does.  Returns the packed address if it succeeded, FALSE otherwise.
+See example in L<perlipc/"Sockets: Client/Server Communication">.
+
+=item alarm SECONDS
+
+Arranges to have a SIGALRM delivered to this process after the
+specified number of seconds have elapsed.  (On some machines,
+unfortunately, the elapsed time may be up to one second less than you
+specified because of how seconds are counted.)  Only one timer may be
+counting at once.  Each call disables the previous timer, and an
+argument of 0 may be supplied to cancel the previous timer without
+starting a new one.  The returned value is the amount of time remaining
+on the previous timer.
+
+For delays of finer granularity than one second, you may use Perl's
+syscall() interface to access setitimer(2) if your system supports it, 
+or else see L</select()> below.  It is not advised to intermix alarm() 
+and sleep() calls.
+
+=item atan2 Y,X
+
+Returns the arctangent of Y/X in the range -PI to PI.
+
+=item bind SOCKET,NAME
+
+Binds a network address to a socket, just as the bind system call
+does.  Returns TRUE if it succeeded, FALSE otherwise.  NAME should be a
+packed address of the appropriate type for the socket.  See the examples in
+L<perlipc/"Sockets: Client/Server Communication">.
+
+=item binmode FILEHANDLE
+
+Arranges for the file to be read or written in "binary" mode in operating
+systems that distinguish between binary and text files.  Files that are
+not in binary mode have CR LF sequences translated to LF on input and LF
+translated to CR LF on output.  Binmode has no effect under Unix; in DOS
+and similarly archaic systems, it may be imperative--otherwise your
+DOS-damaged C library may mangle your file.  The key distinction between
+systems that need binmode and those that don't is their text file
+formats.  Systems like Unix and Plan9 that delimit lines with a single
+character, and that encode that character in C as '\n', do not need
+C<binmode>.  The rest need it.  If FILEHANDLE is an expression, the value
+is taken as the name of the filehandle.
+
+=item bless REF,CLASSNAME
+
+=item bless REF
+
+This function tells the referenced object (passed as REF) that it is now
+an object in the CLASSNAME package--or the current package if no CLASSNAME
+is specified, which is often the case.  It returns the reference for
+convenience, since a bless() is often the last thing in a constructor.
+Always use the two-argument version if the function doing the blessing
+might be inherited by a derived class.  See L<perlobj> for more about the
+blessing (and blessings) of objects.
+
+=item caller EXPR
+
+=item caller
+
+Returns the context of the current subroutine call.  In a scalar context,
+returns TRUE if there is a caller, that is, if we're in a subroutine or
+eval() or require(), and FALSE otherwise.  In a list context, returns
+
+    ($package, $filename, $line) = caller;
+
+With EXPR, it returns some extra information that the debugger uses to
+print a stack trace.  The value of EXPR indicates how many call frames
+to go back before the current one.
+
+    ($package, $filename, $line,
+     $subroutine, $hasargs, $wantargs) = caller($i);
+
+Furthermore, when called from within the DB package, caller returns more
+detailed information: it sets the list variable @DB::args to be the
+arguments with which that subroutine was invoked.
+
+=item chdir EXPR
+
+Changes the working directory to EXPR, if possible.  If EXPR is
+omitted, changes to home directory.  Returns TRUE upon success, FALSE
+otherwise.  See example under die().
+
+=item chmod LIST
+
+Changes the permissions of a list of files.  The first element of the
+list must be the numerical mode, which should probably be an octal
+number.  Returns the number of files successfully changed.
+
+    $cnt = chmod 0755, 'foo', 'bar';
+    chmod 0755, @executables;
+
+=item chomp VARIABLE
+
+=item chomp LIST
+
+=item chomp
+
+This is a slightly safer version of chop (see below).  It removes any
+line ending that corresponds to the current value of C<$/> (also known as
+$INPUT_RECORD_SEPARATOR in the C<English> module).  It returns the number
+of characters removed.  It's often used to remove the newline from the
+end of an input record when you're worried that the final record may be
+missing its newline.  When in paragraph mode (C<$/ = "">), it removes all
+trailing newlines from the string.  If VARIABLE is omitted, it chomps
+$_.  Example:
+
+    while (<>) {
+	chomp;	# avoid \n on last field
+	@array = split(/:/);
+	...
+    }
+
+You can actually chomp anything that's an lvalue, including an assignment:
+
+    chomp($cwd = `pwd`);
+    chomp($answer = <STDIN>);
+
+If you chomp a list, each element is chomped, and the total number of
+characters removed is returned.
+
+=item chop VARIABLE
+
+=item chop LIST
+
+=item chop
+
+Chops off the last character of a string and returns the character
+chopped.  It's used primarily to remove the newline from the end of an
+input record, but is much more efficient than C<s/\n//> because it neither
+scans nor copies the string.  If VARIABLE is omitted, chops $_.
+Example:
+
+    while (<>) {
+	chop;	# avoid \n on last field
+	@array = split(/:/);
+	...
+    }
+
+You can actually chop anything that's an lvalue, including an assignment:
+
+    chop($cwd = `pwd`);
+    chop($answer = <STDIN>);
+
+If you chop a list, each element is chopped.  Only the value of the
+last chop is returned.
+
+Note that chop returns the last character.  To return all but the last
+character, use C<substr($string, 0, -1)>.
+
+=item chown LIST
+
+Changes the owner (and group) of a list of files.  The first two
+elements of the list must be the I<NUMERICAL> uid and gid, in that order.
+Returns the number of files successfully changed.
+
+    $cnt = chown $uid, $gid, 'foo', 'bar';
+    chown $uid, $gid, @filenames;
+
+Here's an example that looks up non-numeric uids in the passwd file:
+
+    print "User: ";
+    chop($user = <STDIN>);
+    print "Files: "
+    chop($pattern = <STDIN>);
+
+    ($login,$pass,$uid,$gid) = getpwnam($user)
+	or die "$user not in passwd file";
+
+    @ary = <${pattern}>;	# expand filenames
+    chown $uid, $gid, @ary;
+
+On most systems, you are not allowed to change the ownership of the 
+file unless you're the superuser, although you should be able to change
+the group to any of your secondary groups.  On insecure systems, these
+restrictions may be relaxed, but this is not a portable assumption.
+
+=item chr NUMBER
+
+Returns the character represented by that NUMBER in the character set.
+For example, C<chr(65)> is "A" in ASCII.
+
+=item chroot FILENAME
+
+This function works as the system call by the same name: it makes the
+named directory the new root directory for all further pathnames that
+begin with a "/" by your process and all of its children.  (It doesn't
+change your current working directory is unaffected.)  For security
+reasons, this call is restricted to the superuser.  If FILENAME is
+omitted, does chroot to $_.
+
+=item close FILEHANDLE
+
+Closes the file or pipe associated with the file handle, returning TRUE
+only if stdio successfully flushes buffers and closes the system file
+descriptor.  You don't have to close FILEHANDLE if you are immediately
+going to do another open() on it, since open() will close it for you.  (See
+open().)  However, an explicit close on an input file resets the line
+counter ($.), while the implicit close done by open() does not.  Also,
+closing a pipe will wait for the process executing on the pipe to
+complete, in case you want to look at the output of the pipe
+afterwards.  Closing a pipe explicitly also puts the status value of
+the command into C<$?>.  Example:
+
+    open(OUTPUT, '|sort >foo');	# pipe to sort
+    ...				# print stuff to output
+    close OUTPUT;		# wait for sort to finish
+    open(INPUT, 'foo');		# get sort's results
+
+FILEHANDLE may be an expression whose value gives the real filehandle name.
+
+=item closedir DIRHANDLE
+
+Closes a directory opened by opendir().
+
+=item connect SOCKET,NAME
+
+Attempts to connect to a remote socket, just as the connect system call
+does.  Returns TRUE if it succeeded, FALSE otherwise.  NAME should be a
+packed address of the appropriate type for the socket.  See the examples in
+L<perlipc/"Sockets: Client/Server Communication">.
+
+=item continue BLOCK
+
+Actually a flow control statement rather than a function.  If there is a
+C<continue> BLOCK attached to a BLOCK (typically in a C<while> or
+C<foreach>), it is always executed just before the conditional is about to
+be evaluated again, just like the third part of a C<for> loop in C.  Thus
+it can be used to increment a loop variable, even when the loop has been
+continued via the C<next> statement (which is similar to the C C<continue>
+statement).
+
+=item cos EXPR
+
+Returns the cosine of EXPR (expressed in radians).  If EXPR is omitted
+takes cosine of $_.
+
+=item crypt PLAINTEXT,SALT
+
+Encrypts a string exactly like the crypt(3) function in the C library
+(assuming that you actually have a version there that has not been
+extirpated as a potential munition).  This can prove useful for checking
+the password file for lousy passwords, amongst other things.  Only the
+guys wearing white hats should do this.
+
+Here's an example that makes sure that whoever runs this program knows
+their own password:
+
+    $pwd = (getpwuid($<))[1];
+    $salt = substr($pwd, 0, 2);
+
+    system "stty -echo";
+    print "Password: ";
+    chop($word = <STDIN>);
+    print "\n";
+    system "stty echo";
+
+    if (crypt($word, $salt) ne $pwd) {
+	die "Sorry...\n";
+    } else {
+	print "ok\n";
+    } 
+
+Of course, typing in your own password to whoever asks you 
+for it is unwise.
+
+=item dbmclose ASSOC_ARRAY
+
+[This function has been superseded by the untie() function.]
+
+Breaks the binding between a DBM file and an associative array.
+
+=item dbmopen ASSOC,DBNAME,MODE
+
+[This function has been superseded by the tie() function.]
+
+This binds a dbm(3), ndbm(3), sdbm(3), gdbm(), or Berkeley DB file to an
+associative array.  ASSOC is the name of the associative array.  (Unlike
+normal open, the first argument is I<NOT> a filehandle, even though it
+looks like one).  DBNAME is the name of the database (without the F<.dir>
+or F<.pag> extension if any).  If the database does not exist, it is
+created with protection specified by MODE (as modified by the umask()).
+If your system only supports the older DBM functions, you may perform only
+one dbmopen() in your program.  In older versions of Perl, if your system
+had neither DBM nor ndbm, calling dbmopen() produced a fatal error; it now
+falls back to sdbm(3).
+
+If you don't have write access to the DBM file, you can only read
+associative array variables, not set them.  If you want to test whether
+you can write, either use file tests or try setting a dummy array entry
+inside an eval(), which will trap the error.
+
+Note that functions such as keys() and values() may return huge array
+values when used on large DBM files.  You may prefer to use the each()
+function to iterate over large DBM files.  Example:
+
+    # print out history file offsets
+    dbmopen(%HIST,'/usr/lib/news/history',0666);
+    while (($key,$val) = each %HIST) {
+	print $key, ' = ', unpack('L',$val), "\n";
+    }
+    dbmclose(%HIST);
+
+See also L<AnyDBM_File> for a more general description of the pros and
+cons of the various dbm apparoches, as well as L<DB_File> for a particularly
+rich implementation.
+
+=item defined EXPR
+
+Returns a boolean value saying whether EXPR has a real value
+or not.  Many operations return the undefined value under exceptional
+conditions, such as end of file, uninitialized variable, system error
+and such.  This function allows you to distinguish between an undefined
+null scalar and a defined null scalar with operations that might return
+a real null string, such as referencing elements of an array.  You may
+also check to see if arrays or subroutines exist.  Use of defined on
+predefined variables is not guaranteed to produce intuitive results.
+
+When used on a hash array element, it tells you whether the value
+is defined, not whether the key exists in the hash.  Use exists() for that.
+
+Examples:
+
+    print if defined $switch{'D'};
+    print "$val\n" while defined($val = pop(@ary));
+    die "Can't readlink $sym: $!"
+	unless defined($value = readlink $sym);
+    eval '@foo = ()' if defined(@foo);
+    die "No XYZ package defined" unless defined %_XYZ;
+    sub foo { defined &$bar ? &$bar(@_) : die "No bar"; }
+
+See also undef().
+
+Note: many folks tend to overuse defined(), and then are surprised to
+discover that the number 0 and the null string are, in fact, defined
+concepts.  For example, if you say
+
+    "ab" =~ /a(.*)b/;
+
+the pattern match succeeds, and $1 is defined, despite the fact that it
+matched "nothing".  But it didn't really match nothing--rather, it
+matched something that happened to be 0 characters long.  This is all
+very above-board and honest.  When a function returns an undefined value,
+it's an admission that it couldn't give you an honest answer.  So
+you should only use defined() when you're questioning the integrity
+of what you're trying to do.  At other times, a simple comparison to
+0 or "" is what you want.
+
+=item delete EXPR
+
+Deletes the specified value from its hash array.  Returns the deleted
+value, or the undefined value if nothing was deleted.  Deleting from
+C<$ENV{}> modifies the environment.  Deleting from an array tied to a DBM
+file deletes the entry from the DBM file.  (But deleting from a tie()d
+hash doesn't necessarily return anything.)
+
+The following deletes all the values of an associative array:
+
+    foreach $key (keys %ARRAY) {
+	delete $ARRAY{$key};
+    }
+
+(But it would be faster to use the undef() command.)  Note that the
+EXPR can be arbitrarily complicated as long as the final operation is
+a hash key lookup:
+
+    delete $ref->[$x][$y]{$key};
+
+=item die LIST
+
+Outside of an eval(), prints the value of LIST to C<STDERR> and exits with
+the current value of $! (errno).  If $! is 0, exits with the value of
+C<($? E<gt>E<gt> 8)> (backtick `command` status).  If C<($? E<gt>E<gt> 8)> is 0,
+exits with 255.  Inside an eval(), the error message is stuffed into C<$@>,
+and the eval() is terminated with the undefined value; this makes die()
+the way to raise an exception.
+
+Equivalent examples:
+
+    die "Can't cd to spool: $!\n" unless chdir '/usr/spool/news';
+    chdir '/usr/spool/news' or die "Can't cd to spool: $!\n" 
+
+If the value of EXPR does not end in a newline, the current script line
+number and input line number (if any) are also printed, and a newline
+is supplied.  Hint: sometimes appending ", stopped" to your message
+will cause it to make better sense when the string "at foo line 123" is
+appended.  Suppose you are running script "canasta".
+
+    die "/etc/games is no good";
+    die "/etc/games is no good, stopped";
+
+produce, respectively
+
+    /etc/games is no good at canasta line 123.
+    /etc/games is no good, stopped at canasta line 123.
+
+See also exit() and warn().
+
+=item do BLOCK
+
+Not really a function.  Returns the value of the last command in the
+sequence of commands indicated by BLOCK.  When modified by a loop
+modifier, executes the BLOCK once before testing the loop condition.
+(On other statements the loop modifiers test the conditional first.)
+
+=item do SUBROUTINE(LIST)
+
+A deprecated form of subroutine call.  See L<perlsub>.
+
+=item do EXPR
+
+Uses the value of EXPR as a filename and executes the contents of the
+file as a Perl script.  Its primary use is to include subroutines
+from a Perl subroutine library.
+
+    do 'stat.pl';
+
+is just like
+
+    eval `cat stat.pl`;
+
+except that it's more efficient, more concise, keeps track of the
+current filename for error messages, and searches all the B<-I>
+libraries if the file isn't in the current directory (see also the @INC
+array in L<perlvar/Predefined Names>).  It's the same, however, in that it does
+reparse the file every time you call it, so you probably don't want to
+do this inside a loop.
+
+Note that inclusion of library modules is better done with the
+use() and require() operators, which also do error checking
+and raise an exception if there's a problem.
+
+=item dump LABEL
+
+This causes an immediate core dump.  Primarily this is so that you can
+use the B<undump> program to turn your core dump into an executable binary
+after having initialized all your variables at the beginning of the
+program.  When the new binary is executed it will begin by executing a
+C<goto LABEL> (with all the restrictions that C<goto> suffers).  Think of
+it as a goto with an intervening core dump and reincarnation.  If LABEL
+is omitted, restarts the program from the top.  WARNING: any files
+opened at the time of the dump will NOT be open any more when the
+program is reincarnated, with possible resulting confusion on the part
+of Perl.  See also B<-u> option in L<perlrun>.
+
+Example:
+
+    #!/usr/bin/perl
+    require 'getopt.pl';
+    require 'stat.pl';
+    %days = (
+	'Sun' => 1,
+	'Mon' => 2,
+	'Tue' => 3,
+	'Wed' => 4,
+	'Thu' => 5,
+	'Fri' => 6,
+	'Sat' => 7,
+    );
+
+    dump QUICKSTART if $ARGV[0] eq '-d';
+
+    QUICKSTART:
+    Getopt('f');
+
+=item each ASSOC_ARRAY
+
+Returns a 2-element array consisting of the key and value for the next
+value of an associative array, so that you can iterate over it.
+Entries are returned in an apparently random order.  When the array is
+entirely read, a null array is returned (which when assigned produces a
+FALSE (0) value).  The next call to each() after that will start
+iterating again.  The iterator can be reset only by reading all the
+elements from the array.  You should not add elements to an array while
+you're iterating over it.  There is a single iterator for each
+associative array, shared by all each(), keys() and values() function
+calls in the program.  The following prints out your environment like
+the printenv(1) program, only in a different order:
+
+    while (($key,$value) = each %ENV) {
+	print "$key=$value\n";
+    }
+
+See also keys() and values().
+
+=item eof FILEHANDLE
+
+=item eof ()
+
+=item eof
+
+Returns 1 if the next read on FILEHANDLE will return end of file, or if
+FILEHANDLE is not open.  FILEHANDLE may be an expression whose value
+gives the real filehandle name.  (Note that this function actually
+reads a character and then ungetc()s it, so it is not very useful in an
+interactive context.)  Do not read from a terminal file (or call
+C<eof(FILEHANDLE)> on it) after end-of-file is reached.  Filetypes such
+as terminals may lose the end-of-file condition if you do.
+
+An C<eof> without an argument uses the last file read as argument.
+Empty parentheses () may be used to indicate
+the pseudofile formed of the files listed on the command line, i.e.
+C<eof()> is reasonable to use inside a while (E<lt>E<gt>) loop to detect the end
+of only the last file.  Use C<eof(ARGV)> or eof without the parentheses to
+test I<EACH> file in a while (E<lt>E<gt>) loop.  Examples:
+
+    # reset line numbering on each input file
+    while (<>) {
+	print "$.\t$_";
+	close(ARGV) if (eof);	# Not eof().
+    }
+
+    # insert dashes just before last line of last file
+    while (<>) {
+	if (eof()) {
+	    print "--------------\n";
+	    close(ARGV);	# close or break; is needed if we
+				# are reading from the terminal
+	}
+	print;
+    }
+
+Practical hint: you almost never need to use C<eof> in Perl, because the
+input operators return undef when they run out of data.  
+
+=item eval EXPR
+
+=item eval BLOCK
+
+EXPR is parsed and executed as if it were a little Perl program.  It
+is executed in the context of the current Perl program, so that any
+variable settings, subroutine or format definitions remain afterwards.
+The value returned is the value of the last expression evaluated, or a
+return statement may be used, just as with subroutines.
+
+If there is a syntax error or runtime error, or a die() statement is
+executed, an undefined value is returned by eval(), and C<$@> is set to the
+error message.  If there was no error, C<$@> is guaranteed to be a null
+string.  If EXPR is omitted, evaluates $_.  The final semicolon, if
+any, may be omitted from the expression.
+
+Note that, since eval() traps otherwise-fatal errors, it is useful for
+determining whether a particular feature (such as socket() or symlink())
+is implemented.  It is also Perl's exception trapping mechanism, where
+the die operator is used to raise exceptions.
+
+If the code to be executed doesn't vary, you may use the eval-BLOCK
+form to trap run-time errors without incurring the penalty of
+recompiling each time.  The error, if any, is still returned in C<$@>.
+Examples:
+
+    # make divide-by-zero non-fatal
+    eval { $answer = $a / $b; }; warn $@ if $@;
+
+    # same thing, but less efficient
+    eval '$answer = $a / $b'; warn $@ if $@;
+
+    # a compile-time error
+    eval { $answer = };
+
+    # a run-time error
+    eval '$answer =';	# sets $@
+
+With an eval(), you should be especially careful to remember what's 
+being looked at when:
+
+    eval $x;		# CASE 1
+    eval "$x";		# CASE 2
+
+    eval '$x';		# CASE 3
+    eval { $x };	# CASE 4
+
+    eval "\$$x++"	# CASE 5
+    $$x++;		# CASE 6
+
+Cases 1 and 2 above behave identically: they run the code contained in the
+variable $x.  (Although case 2 has misleading double quotes making the
+reader wonder what else might be happening (nothing is).) Cases 3 and 4
+likewise behave in the same way: they run the code <$x>, which does
+nothing at all.  (Case 4 is preferred for purely visual reasons.) Case 5
+is a place where normally you I<WOULD> like to use double quotes, except
+that in that particular situation, you can just use symbolic references
+instead, as in case 6.
+
+=item exec LIST
+
+The exec() function executes a system command I<AND NEVER RETURNS>.  Use
+the system() function if you want it to return.
+
+If there is more than one argument in LIST, or if LIST is an array with
+more than one value, calls execvp(3) with the arguments in LIST.  If
+there is only one scalar argument, the argument is checked for shell
+metacharacters.  If there are any, the entire argument is passed to
+C</bin/sh -c> for parsing.  If there are none, the argument is split
+into words and passed directly to execvp(), which is more efficient.
+Note: exec() and system() do not flush your output buffer, so you may
+need to set C<$|> to avoid lost output.  Examples:
+
+    exec '/bin/echo', 'Your arguments are: ', @ARGV;
+    exec "sort $outfile | uniq";
+
+If you don't really want to execute the first argument, but want to lie
+to the program you are executing about its own name, you can specify
+the program you actually want to run as an "indirect object" (without a
+comma) in front of the LIST.  (This always forces interpretation of the
+LIST as a multi-valued list, even if there is only a single scalar in
+the list.)  Example:
+
+    $shell = '/bin/csh';
+    exec $shell '-sh';		# pretend it's a login shell
+
+or, more directly,
+
+    exec {'/bin/csh'} '-sh';	# pretend it's a login shell
+
+=item exists EXPR
+
+Returns TRUE if the specified hash key exists in its hash array, even
+if the corresponding value is undefined.
+
+    print "Exists\n" if exists $array{$key};
+    print "Defined\n" if defined $array{$key};
+    print "True\n" if $array{$key};
+
+A hash element can only be TRUE if it's defined, and defined if
+it exists, but the reverse doesn't necessarily hold true.
+
+Note that the EXPR can be arbitrarily complicated as long as the final
+operation is a hash key lookup:
+
+    if (exists $ref->[$x][$y]{$key}) { ... }
+
+=item exit EXPR
+
+Evaluates EXPR and exits immediately with that value.  (Actually, it
+calls any defined C<END> routines first, but the C<END> routines may not
+abort the exit.  Likewise any object destructors that need to be called
+are called before exit.)  Example:
+
+    $ans = <STDIN>;
+    exit 0 if $ans =~ /^[Xx]/;
+
+See also die().  If EXPR is omitted, exits with 0 status.
+
+=item exp EXPR
+
+Returns I<e> (the natural logarithm base) to the power of EXPR.  
+If EXPR is omitted, gives C<exp($_)>.
+
+=item fcntl FILEHANDLE,FUNCTION,SCALAR
+
+Implements the fcntl(2) function.  You'll probably have to say
+
+    use Fcntl;
+
+first to get the correct function definitions.  Argument processing and
+value return works just like ioctl() below.  Note that fcntl() will produce
+a fatal error if used on a machine that doesn't implement fcntl(2).
+For example:
+
+    use Fcntl;
+    fcntl($filehandle, F_GETLK, $packed_return_buffer);
+
+=item fileno FILEHANDLE
+
+Returns the file descriptor for a filehandle.  This is useful for
+constructing bitmaps for select().  If FILEHANDLE is an expression, the
+value is taken as the name of the filehandle.
+
+=item flock FILEHANDLE,OPERATION
+
+Calls flock(2) on FILEHANDLE.  See L<flock(2)> for definition of
+OPERATION.  Returns TRUE for success, FALSE on failure.  Will produce a
+fatal error if used on a machine that doesn't implement either flock(2) or
+fcntl(2). The fcntl(2) system call will be automatically used if flock(2)
+is missing from your system.  This makes flock() the portable file locking
+strategy, although it will only lock entire files, not records.  Note also
+that some versions of flock() cannot lock things over the network; you
+would need to use the more system-specific fcntl() for that.
+
+Here's a mailbox appender for BSD systems.
+
+    $LOCK_SH = 1;
+    $LOCK_EX = 2;
+    $LOCK_NB = 4;
+    $LOCK_UN = 8;
+
+    sub lock {
+	flock(MBOX,$LOCK_EX);
+	# and, in case someone appended
+	# while we were waiting...
+	seek(MBOX, 0, 2);
+    }
+
+    sub unlock {
+	flock(MBOX,$LOCK_UN);
+    }
+
+    open(MBOX, ">>/usr/spool/mail/$ENV{'USER'}")
+	    or die "Can't open mailbox: $!";
+
+    lock();
+    print MBOX $msg,"\n\n";
+    unlock();
+
+See also L<DB_File> for other flock() examples.
+
+=item fork
+
+Does a fork(2) system call.  Returns the child pid to the parent process
+and 0 to the child process, or C<undef> if the fork is unsuccessful.
+Note: unflushed buffers remain unflushed in both processes, which means
+you may need to set C<$|> ($AUTOFLUSH in English) or call the 
+autoflush() FileHandle method to avoid duplicate output.
+
+If you fork() without ever waiting on your children, you will accumulate
+zombies:
+
+    $SIG{CHLD} = sub { wait };
+
+There's also the double-fork trick (error checking on 
+fork() returns omitted);
+
+    unless ($pid = fork) {
+	unless (fork) {
+	    exec "what you really wanna do";
+	    die "no exec";
+	    # ... or ...
+	    ## (some_perl_code_here)
+	    exit 0;
+	}
+	exit 0;
+    }
+    waitpid($pid,0);
+
+See also L<perlipc> for more examples of forking and reaping
+moribund children.
+
+=item format
+
+Declare a picture format with use by the write() function.  For
+example:
+
+    format Something = 
+	Test: @<<<<<<<< @||||| @>>>>>
+	      $str,     $%,    '$' . int($num)
+    .
+
+    $str = "widget";
+    $num = $cost/$quantiy;
+    $~ = 'Something';
+    write;
+
+See L<perlform> for many details and examples.
+
+
+=item formline PICTURE, LIST
+
+This is an internal function used by C<format>s, though you may call it
+too.  It formats (see L<perlform>) a list of values according to the
+contents of PICTURE, placing the output into the format output
+accumulator, C<$^A> (or $ACCUMULATOR in English).
+Eventually, when a write() is done, the contents of
+C<$^A> are written to some filehandle, but you could also read C<$^A>
+yourself and then set C<$^A> back to "".  Note that a format typically
+does one formline() per line of form, but the formline() function itself
+doesn't care how many newlines are embedded in the PICTURE.  This means
+that the C<~> and C<~~> tokens will treat the entire PICTURE as a single line.
+You may therefore need to use multiple formlines to implement a single
+record format, just like the format compiler.
+
+Be careful if you put double quotes around the picture, since an "C<@>"
+character may be taken to mean the beginning of an array name.
+formline() always returns TRUE.  See L<perlform> for other examples.
+
+=item getc FILEHANDLE
+
+=item getc
+
+Returns the next character from the input file attached to FILEHANDLE,
+or a null string at end of file.  If FILEHANDLE is omitted, reads from STDIN.
+This is not particularly efficient.  It cannot be used to get unbuffered
+single-characters, however.  For that, try something more like:
+
+    if ($BSD_STYLE) {
+	system "stty cbreak </dev/tty >/dev/tty 2>&1";
+    }
+    else {
+	system "stty", '-icanon', 'eol', "\001"; 
+    }
+
+    $key = getc(STDIN);
+
+    if ($BSD_STYLE) {
+	system "stty -cbreak </dev/tty >/dev/tty 2>&1";
+    }
+    else {
+	system "stty", 'icanon', 'eol', '^@'; # ascii null
+    }
+    print "\n";
+
+Determination of whether to whether $BSD_STYLE should be set 
+is left as an exercise to the reader.  
+
+See also the C<Term::ReadKey> module from your nearest CPAN site;
+details on CPAN can be found on L<perlmod/CPAN> 
+
+=item getlogin
+
+Returns the current login from F</etc/utmp>, if any.  If null, use
+getpwuid().  
+
+    $login = getlogin || (getpwuid($<))[0] || "Kilroy";
+
+Do not consider getlogin() for authorentication: it is not as
+secure as getpwuid().
+
+=item getpeername SOCKET
+
+Returns the packed sockaddr address of other end of the SOCKET connection.
+
+    use Socket;
+    $hersockaddr    = getpeername(SOCK);
+    ($port, $iaddr) = unpack_sockaddr_in($hersockaddr);
+    $herhostname    = gethostbyaddr($iaddr, AF_INET);
+    $herstraddr     = inet_ntoa($iaddr);
+
+=item getpgrp PID
+
+Returns the current process group for the specified PID, 0 for the
+current process.  Will raise an exception if used on a machine that
+doesn't implement getpgrp(2).  If PID is omitted, returns process
+group of current process.
+
+=item getppid
+
+Returns the process id of the parent process.
+
+=item getpriority WHICH,WHO
+
+Returns the current priority for a process, a process group, or a user.
+(See L<getpriority(2)>.)  Will raise a fatal exception if used on a
+machine that doesn't implement getpriority(2).
+
+=item getpwnam NAME
+
+=item getgrnam NAME
+
+=item gethostbyname NAME
+
+=item getnetbyname NAME
+
+=item getprotobyname NAME
+
+=item getpwuid UID
+
+=item getgrgid GID
+
+=item getservbyname NAME,PROTO
+
+=item gethostbyaddr ADDR,ADDRTYPE
+
+=item getnetbyaddr ADDR,ADDRTYPE
+
+=item getprotobynumber NUMBER
+
+=item getservbyport PORT,PROTO
+
+=item getpwent
+
+=item getgrent
+
+=item gethostent
+
+=item getnetent
+
+=item getprotoent
+
+=item getservent
+
+=item setpwent
+
+=item setgrent
+
+=item sethostent STAYOPEN
+
+=item setnetent STAYOPEN
+
+=item setprotoent STAYOPEN
+
+=item setservent STAYOPEN
+
+=item endpwent
+
+=item endgrent
+
+=item endhostent
+
+=item endnetent
+
+=item endprotoent
+
+=item endservent
+
+These routines perform the same functions as their counterparts in the
+system library.  Within a list context, the return values from the
+various get routines are as follows:
+
+    ($name,$passwd,$uid,$gid,
+       $quota,$comment,$gcos,$dir,$shell) = getpw*
+    ($name,$passwd,$gid,$members) = getgr*
+    ($name,$aliases,$addrtype,$length,@addrs) = gethost*
+    ($name,$aliases,$addrtype,$net) = getnet*
+    ($name,$aliases,$proto) = getproto*
+    ($name,$aliases,$port,$proto) = getserv*
+
+(If the entry doesn't exist you get a null list.)
+
+Within a scalar context, you get the name, unless the function was a
+lookup by name, in which case you get the other thing, whatever it is.
+(If the entry doesn't exist you get the undefined value.)  For example:
+
+    $uid = getpwnam
+    $name = getpwuid
+    $name = getpwent
+    $gid = getgrnam
+    $name = getgrgid
+    $name = getgrent
+    etc.
+
+The $members value returned by I<getgr*()> is a space separated list of
+the login names of the members of the group.
+
+For the I<gethost*()> functions, if the C<h_errno> variable is supported in
+C, it will be returned to you via C<$?> if the function call fails.  The
+@addrs value returned by a successful call is a list of the raw
+addresses returned by the corresponding system library call.  In the
+Internet domain, each address is four bytes long and you can unpack it
+by saying something like:
+
+    ($a,$b,$c,$d) = unpack('C4',$addr[0]);
+
+=item getsockname SOCKET
+
+Returns the packed sockaddr address of this end of the SOCKET connection.
+
+    use Socket;
+    $mysockaddr = getsockname(SOCK);
+    ($port, $myaddr) = unpack_sockaddr_in($mysockaddr);
+
+=item getsockopt SOCKET,LEVEL,OPTNAME
+
+Returns the socket option requested, or undefined if there is an error.
+
+=item glob EXPR
+
+Returns the value of EXPR with filename expansions such as a shell
+would do.  This is the internal function implementing the <*.*>
+operator, except it's easier to use.
+
+=item gmtime EXPR
+
+Converts a time as returned by the time function to a 9-element array
+with the time localized for the standard Greenwich timezone.  
+Typically used as follows:
+
+
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+					    gmtime(time);
+
+All array elements are numeric, and come straight out of a struct tm.
+In particular this means that $mon has the range 0..11 and $wday has
+the range 0..6.  If EXPR is omitted, does C<gmtime(time())>.
+
+=item goto LABEL
+
+=item goto EXPR
+
+=item goto &NAME
+
+The goto-LABEL form finds the statement labeled with LABEL and resumes
+execution there.  It may not be used to go into any construct that
+requires initialization, such as a subroutine or a foreach loop.  It
+also can't be used to go into a construct that is optimized away.  It
+can be used to go almost anywhere else within the dynamic scope,
+including out of subroutines, but it's usually better to use some other
+construct such as last or die.  The author of Perl has never felt the
+need to use this form of goto (in Perl, that is--C is another matter).
+
+The goto-EXPR form expects a label name, whose scope will be resolved
+dynamically.  This allows for computed gotos per FORTRAN, but isn't
+necessarily recommended if you're optimizing for maintainability:
+
+    goto ("FOO", "BAR", "GLARCH")[$i];
+
+The goto-&NAME form is highly magical, and substitutes a call to the
+named subroutine for the currently running subroutine.  This is used by
+AUTOLOAD subroutines that wish to load another subroutine and then
+pretend that the other subroutine had been called in the first place
+(except that any modifications to @_ in the current subroutine are
+propagated to the other subroutine.)  After the goto, not even caller()
+will be able to tell that this routine was called first.
+
+=item grep BLOCK LIST
+
+=item grep EXPR,LIST
+
+Evaluates the BLOCK or EXPR for each element of LIST (locally setting
+$_ to each element) and returns the list value consisting of those
+elements for which the expression evaluated to TRUE.  In a scalar
+context, returns the number of times the expression was TRUE.
+
+    @foo = grep(!/^#/, @bar);    # weed out comments
+
+or equivalently,
+
+    @foo = grep {!/^#/} @bar;    # weed out comments
+
+Note that, since $_ is a reference into the list value, it can be used
+to modify the elements of the array.  While this is useful and
+supported, it can cause bizarre results if the LIST is not a named
+array.
+
+=item hex EXPR
+
+Interprets EXPR as a hex string and returns the corresponding decimal
+value.  (To convert strings that might start with 0 or 0x see
+oct().)  If EXPR is omitted, uses $_.
+
+=item import
+
+There is no built-in import() function.  It is merely an ordinary
+method (subroutine) defined (or inherited) by modules that wish to export
+names to another module.  The use() function calls the import() method
+for the package used.  See also L</use>, L<perlmod>, and L<Exporter>.
+
+=item index STR,SUBSTR,POSITION
+
+=item index STR,SUBSTR
+
+Returns the position of the first occurrence of SUBSTR in STR at or after
+POSITION.  If POSITION is omitted, starts searching from the beginning of
+the string.  The return value is based at 0 (or whatever you've set the $[
+variable to--but don't do that).  If the substring is not found, returns
+one less than the base, ordinarily -1.
+
+=item int EXPR
+
+Returns the integer portion of EXPR.  If EXPR is omitted, uses $_.
+
+=item ioctl FILEHANDLE,FUNCTION,SCALAR
+
+Implements the ioctl(2) function.  You'll probably have to say
+
+    require "ioctl.ph";	# probably in /usr/local/lib/perl/ioctl.ph
+
+first to get the correct function definitions.  If F<ioctl.ph> doesn't
+exist or doesn't have the correct definitions you'll have to roll your
+own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>.
+(There is a Perl script called B<h2ph> that comes with the Perl kit which
+may help you in this, but it's non-trivial.)  SCALAR will be read and/or
+written depending on the FUNCTION--a pointer to the string value of SCALAR
+will be passed as the third argument of the actual ioctl call.  (If SCALAR
+has no string value but does have a numeric value, that value will be
+passed rather than a pointer to the string value.  To guarantee this to be
+TRUE, add a 0 to the scalar before using it.)  The pack() and unpack()
+functions are useful for manipulating the values of structures used by
+ioctl().  The following example sets the erase character to DEL.
+
+    require 'ioctl.ph';
+    $getp = &TIOCGETP;
+    die "NO TIOCGETP" if $@ || !$getp;
+    $sgttyb_t = "ccccs";		# 4 chars and a short
+    if (ioctl(STDIN,$getp,$sgttyb)) {
+	@ary = unpack($sgttyb_t,$sgttyb);
+	$ary[2] = 127;
+	$sgttyb = pack($sgttyb_t,@ary);
+	ioctl(STDIN,&TIOCSETP,$sgttyb)
+	    || die "Can't ioctl: $!";
+    }
+
+The return value of ioctl (and fcntl) is as follows:
+
+	if OS returns:		then Perl returns:
+	    -1	  		  undefined value
+	     0	 		string "0 but true"
+	anything else		    that number
+
+Thus Perl returns TRUE on success and FALSE on failure, yet you can
+still easily determine the actual value returned by the operating
+system:
+
+    ($retval = ioctl(...)) || ($retval = -1);
+    printf "System returned %d\n", $retval;
+
+=item join EXPR,LIST
+
+Joins the separate strings of LIST or ARRAY into a single string with
+fields separated by the value of EXPR, and returns the string.
+Example:
+
+    $_ = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
+
+See L<perlfunc/split>.
+
+=item keys ASSOC_ARRAY
+
+Returns a normal array consisting of all the keys of the named
+associative array.  (In a scalar context, returns the number of keys.)
+The keys are returned in an apparently random order, but it is the same
+order as either the values() or each() function produces (given that
+the associative array has not been modified).  Here is yet another way
+to print your environment:
+
+    @keys = keys %ENV;
+    @values = values %ENV;
+    while ($#keys >= 0) {
+	print pop(@keys), '=', pop(@values), "\n";
+    }
+
+or how about sorted by key:
+
+    foreach $key (sort(keys %ENV)) {
+	print $key, '=', $ENV{$key}, "\n";
+    }
+
+To sort an array by value, you'll need to use a C<sort{}>
+function.  Here's a descending numeric sort of a hash by its values:
+
+    foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash)) {
+	printf "%4d %s\n", $hash{$key}, $key;
+    }
+
+=item kill LIST
+
+Sends a signal to a list of processes.  The first element of 
+the list must be the signal to send.  Returns the number of 
+processes successfully signaled.
+
+    $cnt = kill 1, $child1, $child2;
+    kill 9, @goners;
+
+Unlike in the shell, in Perl if the I<SIGNAL> is negative, it kills
+process groups instead of processes.  (On System V, a negative I<PROCESS>
+number will also kill process groups, but that's not portable.)  That
+means you usually want to use positive not negative signals.  You may also
+use a signal name in quotes.  See the L<perlipc/"Signals"> man page for details.
+
+=item last LABEL
+
+=item last
+
+The C<last> command is like the C<break> statement in C (as used in
+loops); it immediately exits the loop in question.  If the LABEL is
+omitted, the command refers to the innermost enclosing loop.  The
+C<continue> block, if any, is not executed:
+
+    LINE: while (<STDIN>) {
+	last LINE if /^$/;	# exit when done with header
+	...
+    }
+
+=item lc EXPR
+
+Returns an lowercased version of EXPR.  This is the internal function
+implementing the \L escape in double-quoted strings.  
+Should respect any POSIX setlocale() settings.
+
+=item lcfirst EXPR
+
+Returns the value of EXPR with the first character lowercased.  This is
+the internal function implementing the \l escape in double-quoted strings.
+Should respect any POSIX setlocale() settings.
+
+=item length EXPR
+
+Returns the length in characters of the value of EXPR.  If EXPR is
+omitted, returns length of $_.
+
+=item link OLDFILE,NEWFILE
+
+Creates a new filename linked to the old filename.  Returns 1 for
+success, 0 otherwise.
+
+=item listen SOCKET,QUEUESIZE
+
+Does the same thing that the listen system call does.  Returns TRUE if
+it succeeded, FALSE otherwise.  See example in L<perlipc/"Sockets: Client/Server Communication">.
+
+=item local EXPR
+
+A local modifies the listed variables to be local to the enclosing block,
+subroutine, C<eval{}> or C<do>.  If more than one value is listed, the
+list must be placed in parens.  See L<perlsub/"Temporary Values via
+local()"> for details.
+
+But you really probably want to be using my() instead, because local() isn't
+what most people think of as "local").  See L<perlsub/"Private Variables
+via my()"> for details.
+
+=item localtime EXPR
+
+Converts a time as returned by the time function to a 9-element array
+with the time analyzed for the local timezone.  Typically used as
+follows:
+
+    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+						localtime(time);
+
+All array elements are numeric, and come straight out of a struct tm.
+In particular this means that $mon has the range 0..11 and $wday has
+the range 0..6.  If EXPR is omitted, does localtime(time).
+
+In a scalar context, prints out the ctime(3) value:
+
+    $now_string = localtime;  # e.g. "Thu Oct 13 04:54:34 1994"
+
+Also see the F<timelocal.pl> library, and the strftime(3) function available
+via the POSIX modulie.
+
+=item log EXPR
+
+Returns logarithm (base I<e>) of EXPR.  If EXPR is omitted, returns log
+of $_.
+
+=item lstat FILEHANDLE
+
+=item lstat EXPR
+
+Does the same thing as the stat() function, but stats a symbolic link
+instead of the file the symbolic link points to.  If symbolic links are
+unimplemented on your system, a normal stat() is done.
+
+=item m//
+
+The match operator.  See L<perlop>.
+
+=item map BLOCK LIST
+
+=item map EXPR,LIST
+
+Evaluates the BLOCK or EXPR for each element of LIST (locally setting $_ to each
+element) and returns the list value composed of the results of each such
+evaluation.  Evaluates BLOCK or EXPR in a list context, so each element of LIST
+may produce zero, one, or more elements in the returned value.
+
+    @chars = map(chr, @nums);
+
+translates a list of numbers to the corresponding characters.  And
+
+    %hash = map { getkey($_) => $_ } @array;
+
+is just a funny way to write
+
+    %hash = ();
+    foreach $_ (@array) {
+	$hash{getkey($_)} = $_;
+    }
+
+=item mkdir FILENAME,MODE
+
+Creates the directory specified by FILENAME, with permissions specified
+by MODE (as modified by umask).  If it succeeds it returns 1, otherwise
+it returns 0 and sets $! (errno).
+
+=item msgctl ID,CMD,ARG
+
+Calls the System V IPC function msgctl(2).  If CMD is &IPC_STAT, then ARG
+must be a variable which will hold the returned msqid_ds structure.
+Returns like ioctl: the undefined value for error, "0 but true" for
+zero, or the actual return value otherwise.
+
+=item msgget KEY,FLAGS
+
+Calls the System V IPC function msgget(2).  Returns the message queue id,
+or the undefined value if there is an error.
+
+=item msgsnd ID,MSG,FLAGS
+
+Calls the System V IPC function msgsnd to send the message MSG to the
+message queue ID.  MSG must begin with the long integer message type,
+which may be created with C<pack("l", $type)>.  Returns TRUE if
+successful, or FALSE if there is an error.
+
+=item msgrcv ID,VAR,SIZE,TYPE,FLAGS
+
+Calls the System V IPC function msgrcv to receive a message from
+message queue ID into variable VAR with a maximum message size of
+SIZE.  Note that if a message is received, the message type will be the
+first thing in VAR, and the maximum length of VAR is SIZE plus the size
+of the message type.  Returns TRUE if successful, or FALSE if there is
+an error.
+
+=item my EXPR
+
+A "my" declares the listed variables to be local (lexically) to the
+enclosing block, subroutine, C<eval>, or C<do/require/use>'d file.  If
+more than one value is listed, the list must be placed in parens.  See
+L<perlsub/"Private Variables via my()"> for details.
+
+=item next LABEL
+
+=item next
+
+The C<next> command is like the C<continue> statement in C; it starts
+the next iteration of the loop:
+
+    LINE: while (<STDIN>) {
+	next LINE if /^#/;	# discard comments
+	...
+    }
+
+Note that if there were a C<continue> block on the above, it would get
+executed even on discarded lines.  If the LABEL is omitted, the command
+refers to the innermost enclosing loop.
+
+=item no Module LIST
+
+See the "use" function, which "no" is the opposite of.
+
+=item oct EXPR
+
+Interprets EXPR as an octal string and returns the corresponding
+decimal value.  (If EXPR happens to start off with 0x, interprets it as
+a hex string instead.)  The following will handle decimal, octal, and
+hex in the standard Perl or C notation:
+
+    $val = oct($val) if $val =~ /^0/;
+
+If EXPR is omitted, uses $_.
+
+=item open FILEHANDLE,EXPR
+
+=item open FILEHANDLE
+
+Opens the file whose filename is given by EXPR, and associates it with
+FILEHANDLE.  If FILEHANDLE is an expression, its value is used as the name
+of the real filehandle wanted.  If EXPR is omitted, the scalar variable of
+the same name as the FILEHANDLE contains the filename.  If the filename
+begins with "<" or nothing, the file is opened for input.  If the filename
+begins with ">", the file is opened for output.  If the filename begins
+with ">>", the file is opened for appending.  You can put a '+' in front
+of the '>' or '<' to indicate that you want both read and write access to
+the file; thus '+<' is usually preferred for read/write updates--the '+>'
+mode would clobber the file first.  These correspond to the fopen(3) modes
+of 'r', 'r+', 'w', 'w+', 'a', and 'a+'.
+
+If the filename begins with "|", the filename is interpreted
+as a command to which output is to be piped, and if the filename ends with
+a "|", the filename is interpreted See L<perlipc/"Using open() for IPC">
+for more examples of this.  as command which pipes input to us.  (You may
+not have a raw open() to a command that pipes both in I<and> out, but see See L<open2>,
+L<open3>, and L<perlipc/"Bidirectional Communication"> for alternatives.)
+
+Opening '-' opens STDIN and opening '>-' opens STDOUT.  Open returns
+non-zero upon success, the undefined value otherwise.  If the open
+involved a pipe, the return value happens to be the pid of the
+subprocess.  
+
+If you're unfortunate enough to be running Perl on a system that
+distinguishes between text files and binary files (modern operating
+systems don't care), then you should check out L</binmode> for tips for
+dealing with this.  The key distinction between systems that need binmode
+and those that don't is their text file formats.  Systems like Unix and
+Plan9 that delimit lines with a single character, and that encode that
+character in C as '\n', do not need C<binmode>.  The rest need it.
+
+Examples:
+
+    $ARTICLE = 100;
+    open ARTICLE or die "Can't find article $ARTICLE: $!\n";
+    while (<ARTICLE>) {...
+
+    open(LOG, '>>/usr/spool/news/twitlog'); # (log is reserved)
+
+    open(DBASE, '+<dbase.mine');	    # open for update
+
+    open(ARTICLE, "caesar <$article |");    # decrypt article
+
+    open(EXTRACT, "|sort >/tmp/Tmp$$");     # $$ is our process id
+
+    # process argument list of files along with any includes
+
+    foreach $file (@ARGV) {
+	process($file, 'fh00');
+    }
+
+    sub process {
+	local($filename, $input) = @_;
+	$input++;		# this is a string increment
+	unless (open($input, $filename)) {
+	    print STDERR "Can't open $filename: $!\n";
+	    return;
+	}
+
+	while (<$input>) {		# note use of indirection
+	    if (/^#include "(.*)"/) {
+		process($1, $input);
+		next;
+	    }
+	    ...		# whatever
+	}
+    }
+
+You may also, in the Bourne shell tradition, specify an EXPR beginning
+with ">&", in which case the rest of the string is interpreted as the
+name of a filehandle (or file descriptor, if numeric) which is to be
+duped and opened.  You may use & after >, >>, <, +>, +>> and +<.  The
+mode you specify should match the mode of the original filehandle.
+(Duping a filehandle does not take into acount any existing contents of
+stdio buffers.)
+Here is a script that saves, redirects, and restores STDOUT and
+STDERR:
+
+    #!/usr/bin/perl
+    open(SAVEOUT, ">&STDOUT");
+    open(SAVEERR, ">&STDERR");
+
+    open(STDOUT, ">foo.out") || die "Can't redirect stdout";
+    open(STDERR, ">&STDOUT") || die "Can't dup stdout";
+
+    select(STDERR); $| = 1;	# make unbuffered
+    select(STDOUT); $| = 1;	# make unbuffered
+
+    print STDOUT "stdout 1\n";	# this works for
+    print STDERR "stderr 1\n"; 	# subprocesses too
+
+    close(STDOUT);
+    close(STDERR);
+
+    open(STDOUT, ">&SAVEOUT");
+    open(STDERR, ">&SAVEERR");
+
+    print STDOUT "stdout 2\n";
+    print STDERR "stderr 2\n";
+
+
+If you specify "<&=N", where N is a number, then Perl will do an
+equivalent of C's fdopen() of that file descriptor; this is more
+parsimonious of file descriptors.  For example:
+
+    open(FILEHANDLE, "<&=$fd")
+
+If you open a pipe on the command "-", i.e. either "|-" or "-|", then
+there is an implicit fork done, and the return value of open is the pid
+of the child within the parent process, and 0 within the child
+process.  (Use defined($pid) to determine whether the open was successful.)
+The filehandle behaves normally for the parent, but i/o to that
+filehandle is piped from/to the STDOUT/STDIN of the child process.
+In the child process the filehandle isn't opened--i/o happens from/to
+the new STDOUT or STDIN.  Typically this is used like the normal
+piped open when you want to exercise more control over just how the
+pipe command gets executed, such as when you are running setuid, and
+don't want to have to scan shell commands for metacharacters.  
+The following pairs are more or less equivalent:
+
+    open(FOO, "|tr '[a-z]' '[A-Z]'");
+    open(FOO, "|-") || exec 'tr', '[a-z]', '[A-Z]';
+
+    open(FOO, "cat -n '$file'|");
+    open(FOO, "-|") || exec 'cat', '-n', $file;
+
+See L<perlipc/"Safe Pipe Opens"> for more examples of this.
+
+Explicitly closing any piped filehandle causes the parent process to
+wait for the child to finish, and returns the status value in $?.
+Note: on any operation which may do a fork, unflushed buffers remain
+unflushed in both processes, which means you may need to set $| to
+avoid duplicate output.
+
+Using the FileHandle constructor from the FileHandle package,
+you can generate anonymous filehandles which have the scope of whatever
+variables hold references to them, and automatically close whenever
+and however you leave that scope:
+
+    use FileHandle;
+    ...
+    sub read_myfile_munged {
+	my $ALL = shift;
+	my $handle = new FileHandle;
+	open($handle, "myfile") or die "myfile: $!";
+	$first = <$handle>
+	    or return ();     # Automatically closed here.
+	mung $first or die "mung failed";	# Or here.
+	return $first, <$handle> if $ALL;	# Or here.
+	$first;					# Or here.
+    }
+
+The filename that is passed to open will have leading and trailing
+whitespace deleted.  In order to open a file with arbitrary weird
+characters in it, it's necessary to protect any leading and trailing
+whitespace thusly:
+
+    $file =~ s#^(\s)#./$1#;
+    open(FOO, "< $file\0");
+
+If you want a "real" C open() (see L<open(2)> on your system), then
+you should use the sysopen() function.  This is another way to
+protect your filenames from interpretation.  For example:
+
+    use FileHandle;
+    sysopen(HANDLE, $path, O_RDWR|O_CREAT|O_EXCL, 0700)
+	or die "sysopen $path: $!";
+    HANDLE->autoflush(1);
+    HANDLE->print("stuff $$\n");
+    seek(HANDLE, 0, 0);
+    print "File contains: ", <HANDLE>;
+
+See L</seek()> for some details about mixing reading and writing.
+
+=item opendir DIRHANDLE,EXPR
+
+Opens a directory named EXPR for processing by readdir(), telldir(),
+seekdir(), rewinddir() and closedir().  Returns TRUE if successful.
+DIRHANDLEs have their own namespace separate from FILEHANDLEs.
+
+=item ord EXPR
+
+Returns the numeric ascii value of the first character of EXPR.  If
+EXPR is omitted, uses $_.
+
+=item pack TEMPLATE,LIST
+
+Takes an array or list of values and packs it into a binary structure,
+returning the string containing the structure.  The TEMPLATE is a
+sequence of characters that give the order and type of values, as
+follows:
+
+    A	An ascii string, will be space padded.
+    a	An ascii string, will be null padded.
+    b	A bit string (ascending bit order, like vec()).
+    B	A bit string (descending bit order).
+    h	A hex string (low nybble first).
+    H	A hex string (high nybble first).
+
+    c	A signed char value.
+    C	An unsigned char value.
+    s	A signed short value.
+    S	An unsigned short value.
+    i	A signed integer value.
+    I	An unsigned integer value.
+    l	A signed long value.
+    L	An unsigned long value.
+
+    n	A short in "network" order.
+    N	A long in "network" order.
+    v	A short in "VAX" (little-endian) order.
+    V	A long in "VAX" (little-endian) order.
+
+    f	A single-precision float in the native format.
+    d	A double-precision float in the native format.
+
+    p	A pointer to a null-terminated string.
+    P	A pointer to a structure (fixed-length string).
+
+    u	A uuencoded string.
+
+    x	A null byte.
+    X	Back up a byte.
+    @	Null fill to absolute position.
+
+Each letter may optionally be followed by a number which gives a repeat
+count.  With all types except "a", "A", "b", "B", "h" and "H", and "P" the
+pack function will gobble up that many values from the LIST.  A * for the
+repeat count means to use however many items are left.  The "a" and "A"
+types gobble just one value, but pack it as a string of length count,
+padding with nulls or spaces as necessary.  (When unpacking, "A" strips
+trailing spaces and nulls, but "a" does not.)  Likewise, the "b" and "B"
+fields pack a string that many bits long.  The "h" and "H" fields pack a
+string that many nybbles long.  The "P" packs a pointer to a structure of
+the size indicated by the length.  Real numbers (floats and doubles) are
+in the native machine format only; due to the multiplicity of floating
+formats around, and the lack of a standard "network" representation, no
+facility for interchange has been made.  This means that packed floating
+point data written on one machine may not be readable on another - even if
+both use IEEE floating point arithmetic (as the endian-ness of the memory
+representation is not part of the IEEE spec).  Note that Perl uses doubles
+internally for all numeric calculation, and converting from double into
+float and thence back to double again will lose precision (i.e.
+C<unpack("f", pack("f", $foo)>) will not in general equal $foo).
+
+Examples:
+
+    $foo = pack("cccc",65,66,67,68);
+    # foo eq "ABCD"
+    $foo = pack("c4",65,66,67,68);
+    # same thing
+
+    $foo = pack("ccxxcc",65,66,67,68);
+    # foo eq "AB\0\0CD"
+
+    $foo = pack("s2",1,2);
+    # "\1\0\2\0" on little-endian
+    # "\0\1\0\2" on big-endian
+
+    $foo = pack("a4","abcd","x","y","z");
+    # "abcd"
+
+    $foo = pack("aaaa","abcd","x","y","z");
+    # "axyz"
+
+    $foo = pack("a14","abcdefg");
+    # "abcdefg\0\0\0\0\0\0\0"
+
+    $foo = pack("i9pl", gmtime);
+    # a real struct tm (on my system anyway)
+
+    sub bintodec {
+	unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
+    }
+
+The same template may generally also be used in the unpack function.
+
+=item package NAMESPACE
+
+Declares the compilation unit as being in the given namespace.  The scope
+of the package declaration is from the declaration itself through the end of
+the enclosing block (the same scope as the local() operator).  All further
+unqualified dynamic identifiers will be in this namespace.  A package
+statement only affects dynamic variables--including those you've used
+local() on--but I<not> lexical variables created with my().  Typically it
+would be the first declaration in a file to be included by the C<require>
+or C<use> operator.  You can switch into a package in more than one place;
+it merely influences which symbol table is used by the compiler for the
+rest of that block.  You can refer to variables and filehandles in other
+packages by prefixing the identifier with the package name and a double
+colon:  C<$Package::Variable>.  If the package name is null, the C<main>
+package as assumed.  That is, C<$::sail> is equivalent to C<$main::sail>.
+
+See L<perlmod/"Packages"> for more information about packages, modules,
+and classes.  See L<perlsub> for other scoping issues.
+
+=item pipe READHANDLE,WRITEHANDLE
+
+Opens a pair of connected pipes like the corresponding system call.
+Note that if you set up a loop of piped processes, deadlock can occur
+unless you are very careful.  In addition, note that Perl's pipes use
+stdio buffering, so you may need to set $| to flush your WRITEHANDLE
+after each command, depending on the application.
+
+See L<open2>, L<open3>, and L<perlipc/"Bidirectional Communication">
+for examples of such things.
+
+=item pop ARRAY
+
+Pops and returns the last value of the array, shortening the array by
+1.  Has a similar effect to
+
+    $tmp = $ARRAY[$#ARRAY--];
+
+If there are no elements in the array, returns the undefined value.
+If ARRAY is omitted, pops the
+@ARGV array in the main program, and the @_ array in subroutines, just
+like shift().
+
+=item pos SCALAR
+
+Returns the offset of where the last C<m//g> search left off for the variable
+in question.  May be modified to change that offset.
+
+=item print FILEHANDLE LIST
+
+=item print LIST
+
+=item print
+
+Prints a string or a comma-separated list of strings.  Returns TRUE
+if successful.  FILEHANDLE may be a scalar variable name, in which case
+the variable contains the name of or a reference to the filehandle, thus introducing one
+level of indirection.  (NOTE: If FILEHANDLE is a variable and the next
+token is a term, it may be misinterpreted as an operator unless you
+interpose a + or put parens around the arguments.)  If FILEHANDLE is
+omitted, prints by default to standard output (or to the last selected
+output channel--see select()).  If LIST is also omitted, prints $_ to
+STDOUT.  To set the default output channel to something other than
+STDOUT use the select operation.  Note that, because print takes a
+LIST, anything in the LIST is evaluated in a list context, and any
+subroutine that you call will have one or more of its expressions
+evaluated in a list context.  Also be careful not to follow the print
+keyword with a left parenthesis unless you want the corresponding right
+parenthesis to terminate the arguments to the print--interpose a + or
+put parens around all the arguments.
+
+Note that if you're storing FILEHANDLES in an array or other expression,
+you will have to use a block returning its value instead
+
+    print { $files[$i] } "stuff\n";
+    print { $OK ? STDOUT : STDERR } "stuff\n";
+
+=item printf FILEHANDLE LIST
+
+=item printf LIST
+
+Equivalent to a "print FILEHANDLE sprintf(LIST)".  The first argument
+of the list will be interpreted as the printf format.
+
+=item push ARRAY,LIST
+
+Treats ARRAY as a stack, and pushes the values of LIST
+onto the end of ARRAY.  The length of ARRAY increases by the length of
+LIST.  Has the same effect as
+
+    for $value (LIST) {
+	$ARRAY[++$#ARRAY] = $value;
+    }
+
+but is more efficient.  Returns the new number of elements in the array.
+
+=item q/STRING/
+
+=item qq/STRING/
+
+=item qx/STRING/
+
+=item qw/STRING/
+
+Generalized quotes.  See L<perlop>.
+
+=item quotemeta EXPR
+
+Returns the value of EXPR with with all regular expression
+metacharacters backslashed.  This is the internal function implementing
+the \Q escape in double-quoted strings.
+
+=item rand EXPR
+
+=item rand
+
+Returns a random fractional number between 0 and the value of EXPR.
+(EXPR should be positive.)  If EXPR is omitted, returns a value between 
+0 and 1.  This function produces repeatable sequences unless srand() 
+is invoked.  See also srand().
+
+(Note: if your rand function consistently returns numbers that are too
+large or too small, then your version of Perl was probably compiled
+with the wrong number of RANDBITS.  As a workaround, you can usually
+multiply EXPR by the correct power of 2 to get the range you want.
+This will make your script unportable, however.  It's better to recompile
+if you can.)
+
+=item read FILEHANDLE,SCALAR,LENGTH,OFFSET
+
+=item read FILEHANDLE,SCALAR,LENGTH
+
+Attempts to read LENGTH bytes of data into variable SCALAR from the
+specified FILEHANDLE.  Returns the number of bytes actually read, or
+undef if there was an error.  SCALAR will be grown or shrunk to the
+length actually read.  An OFFSET may be specified to place the read
+data at some other place than the beginning of the string.  This call
+is actually implemented in terms of stdio's fread call.  To get a true
+read system call, see sysread().
+
+=item readdir DIRHANDLE
+
+Returns the next directory entry for a directory opened by opendir().
+If used in a list context, returns all the rest of the entries in the
+directory.  If there are no more entries, returns an undefined value in
+a scalar context or a null list in a list context.
+
+If you're planning to filetest the return values out of a readdir(), you'd
+better prepend the directory in question.  Otherwise, since we didn't
+chdir() there, it would have been testing the wrong file.
+
+    opendir(DIR, $some_dir) || die "can't opendir $some_dir: $!";
+    @dots = grep { /^\./ && -f "$some_dir/$_" } readdir(DIR);
+    closedir DIR;
+
+=item readlink EXPR
+
+Returns the value of a symbolic link, if symbolic links are
+implemented.  If not, gives a fatal error.  If there is some system
+error, returns the undefined value and sets $! (errno).  If EXPR is
+omitted, uses $_.
+
+=item recv SOCKET,SCALAR,LEN,FLAGS
+
+Receives a message on a socket.  Attempts to receive LENGTH bytes of
+data into variable SCALAR from the specified SOCKET filehandle.
+Actually does a C recvfrom(), so that it can returns the address of the
+sender.  Returns the undefined value if there's an error.  SCALAR will
+be grown or shrunk to the length actually read.  Takes the same flags
+as the system call of the same name.  
+See L<perlipc/"UDP: Message Passing"> for examples.
+
+=item redo LABEL
+
+=item redo
+
+The C<redo> command restarts the loop block without evaluating the
+conditional again.  The C<continue> block, if any, is not executed.  If
+the LABEL is omitted, the command refers to the innermost enclosing
+loop.  This command is normally used by programs that want to lie to
+themselves about what was just input:
+
+    # a simpleminded Pascal comment stripper
+    # (warning: assumes no { or } in strings)
+    LINE: while (<STDIN>) {
+	while (s|({.*}.*){.*}|$1 |) {}
+	s|{.*}| |;
+	if (s|{.*| |) {
+	    $front = $_;
+	    while (<STDIN>) {
+		if (/}/) {	# end of comment?
+		    s|^|$front{|;
+		    redo LINE;
+		}
+	    }
+	}
+	print;
+    }
+
+=item ref EXPR
+
+Returns a TRUE value if EXPR is a reference, FALSE otherwise.  The value
+returned depends on the type of thing the reference is a reference to.
+Builtin types include:
+
+    REF
+    SCALAR
+    ARRAY
+    HASH
+    CODE
+    GLOB
+
+If the referenced object has been blessed into a package, then that package 
+name is returned instead.  You can think of ref() as a typeof() operator.
+
+    if (ref($r) eq "HASH") {
+	print "r is a reference to an associative array.\n";
+    } 
+    if (!ref ($r) {
+	print "r is not a reference at all.\n";
+    } 
+
+See also L<perlref>.
+
+=item rename OLDNAME,NEWNAME
+
+Changes the name of a file.  Returns 1 for success, 0 otherwise.  Will
+not work across filesystem boundaries.
+
+=item require EXPR
+
+=item require
+
+Demands some semantics specified by EXPR, or by $_ if EXPR is not
+supplied.  If EXPR is numeric, demands that the current version of Perl
+($] or $PERL_VERSION) be equal or greater than EXPR.
+
+Otherwise, demands that a library file be included if it hasn't already
+been included.  The file is included via the do-FILE mechanism, which is
+essentially just a variety of eval().  Has semantics similar to the following
+subroutine:
+
+    sub require {
+	local($filename) = @_;
+	return 1 if $INC{$filename};
+	local($realfilename,$result);
+	ITER: {
+	    foreach $prefix (@INC) {
+		$realfilename = "$prefix/$filename";
+		if (-f $realfilename) {
+		    $result = do $realfilename;
+		    last ITER;
+		}
+	    }
+	    die "Can't find $filename in \@INC";
+	}
+	die $@ if $@;
+	die "$filename did not return true value" unless $result;
+	$INC{$filename} = $realfilename;
+	$result;
+    }
+
+Note that the file will not be included twice under the same specified
+name.  The file must return TRUE as the last statement to indicate
+successful execution of any initialization code, so it's customary to
+end such a file with "1;" unless you're sure it'll return TRUE
+otherwise.  But it's better just to put the "C<1;>", in case you add more
+statements.
+
+If EXPR is a bare word, the require assumes a "F<.pm>" extension for you,
+to make it easy to load standard modules.  This form of loading of 
+modules does not risk altering your namespace.
+
+For a yet-more-powerful import facility, see the L</use()> and 
+L<perlmod>.
+
+=item reset EXPR
+
+=item reset
+
+Generally used in a C<continue> block at the end of a loop to clear
+variables and reset ?? searches so that they work again.  The
+expression is interpreted as a list of single characters (hyphens
+allowed for ranges).  All variables and arrays beginning with one of
+those letters are reset to their pristine state.  If the expression is
+omitted, one-match searches (?pattern?) are reset to match again.  Only
+resets variables or searches in the current package.  Always returns
+1.  Examples:
+
+    reset 'X';		# reset all X variables
+    reset 'a-z';	# reset lower case variables
+    reset;		# just reset ?? searches
+
+Resetting "A-Z" is not recommended since you'll wipe out your
+ARGV and ENV arrays.  Only resets package variables--lexical variables
+are unaffected, but they clean themselves up on scope exit anyway,
+so anymore you probably want to use them instead.  See L</my>.
+
+=item return LIST
+
+Returns from a subroutine or eval with the value specified.  (Note that
+in the absence of a return a subroutine or eval() will automatically
+return the value of the last expression evaluated.)
+
+=item reverse LIST
+
+In a list context, returns a list value consisting of the elements
+of LIST in the opposite order.  In a scalar context, returns a string
+value consisting of the bytes of the first element of LIST in the
+opposite order.   
+
+    print reverse <>;			# line tac 
+
+    undef $/;
+    print scalar reverse scalar <>;	# byte tac
+
+=item rewinddir DIRHANDLE
+
+Sets the current position to the beginning of the directory for the
+readdir() routine on DIRHANDLE.
+
+=item rindex STR,SUBSTR,POSITION
+
+=item rindex STR,SUBSTR
+
+Works just like index except that it returns the position of the LAST
+occurrence of SUBSTR in STR.  If POSITION is specified, returns the
+last occurrence at or before that position.
+
+=item rmdir FILENAME
+
+Deletes the directory specified by FILENAME if it is empty.  If it
+succeeds it returns 1, otherwise it returns 0 and sets $! (errno).  If
+FILENAME is omitted, uses $_.
+
+=item s///
+
+The substitution operator.  See L<perlop>.
+
+=item scalar EXPR
+
+Forces EXPR to be interpreted in a scalar context and returns the value
+of EXPR.  
+
+    @counts = ( scalar @a, scalar @b, scalar @c );
+
+There is no equivalent operator to force an expression to 
+be interpolated in a list context because it's in practice never
+needed.  If you really wanted to do so, however, you could use
+the construction C<@{[ (some expression) ]}>, but usually a simple
+C<(some expression)> suffices.
+
+=item seek FILEHANDLE,POSITION,WHENCE
+
+Randomly positions the file pointer for FILEHANDLE, just like the fseek()
+call of stdio.  FILEHANDLE may be an expression whose value gives the name
+of the filehandle.  The values for WHENCE are 0 to set the file pointer to
+POSITION, 1 to set the it to current plus POSITION, and 2 to set it to EOF
+plus offset.  You may use the values SEEK_SET, SEEK_CUR, and SEEK_END for
+this from POSIX module.  Returns 1 upon success, 0 otherwise.
+
+On some systems you have to do a seek whenever you switch between reading
+and writing.  Amongst other things, this may have the effect of calling
+stdio's clearerr(3).  A "whence" of 1 (SEEK_CUR) is useful for not moving
+the file pointer:
+
+    seek(TEST,0,1);
+
+This is also useful for applications emulating C<tail -f>.  Once you hit
+EOF on your read, and then sleep for a while, you might have to stick in a
+seek() to reset things.  First the simple trick listed above to clear the
+filepointer.  The seek() doesn't change the current position, but it
+I<does> clear the end-of-file condition on the handle, so that the next
+C<E<lt>FILEE<gt>> makes Perl try again to read something.  Hopefully.
+
+If that doesn't work (some stdios are particularly cantankerous), then
+you may need something more like this:
+
+    for (;;) {
+	for ($curpos = tell(FILE); $_ = <FILE>; $curpos = tell(FILE)) {
+	    # search for some stuff and put it into files
+	}
+	sleep($for_a_while);
+	seek(FILE, $curpos, 0);
+    }
+
+=item seekdir DIRHANDLE,POS
+
+Sets the current position for the readdir() routine on DIRHANDLE.  POS
+must be a value returned by telldir().  Has the same caveats about
+possible directory compaction as the corresponding system library
+routine.
+
+=item select FILEHANDLE
+
+=item select
+
+Returns the currently selected filehandle.  Sets the current default
+filehandle for output, if FILEHANDLE is supplied.  This has two
+effects: first, a C<write> or a C<print> without a filehandle will
+default to this FILEHANDLE.  Second, references to variables related to
+output will refer to this output channel.  For example, if you have to
+set the top of form format for more than one output channel, you might
+do the following:
+
+    select(REPORT1);
+    $^ = 'report1_top';
+    select(REPORT2);
+    $^ = 'report2_top';
+
+FILEHANDLE may be an expression whose value gives the name of the
+actual filehandle.  Thus:
+
+    $oldfh = select(STDERR); $| = 1; select($oldfh);
+
+Some programmers may prefer to think of filehandles as objects with
+methods, preferring to write the last example as:
+
+    use FileHandle;
+    STDERR->autoflush(1);
+
+=item select RBITS,WBITS,EBITS,TIMEOUT
+
+This calls the select(2) system call with the bitmasks specified, which
+can be constructed using fileno() and vec(), along these lines:
+
+    $rin = $win = $ein = '';
+    vec($rin,fileno(STDIN),1) = 1;
+    vec($win,fileno(STDOUT),1) = 1;
+    $ein = $rin | $win;
+
+If you want to select on many filehandles you might wish to write a
+subroutine:
+
+    sub fhbits {
+	local(@fhlist) = split(' ',$_[0]);
+	local($bits);
+	for (@fhlist) {
+	    vec($bits,fileno($_),1) = 1;
+	}
+	$bits;
+    }
+    $rin = fhbits('STDIN TTY SOCK');
+
+The usual idiom is:
+
+    ($nfound,$timeleft) =
+      select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
+
+or to block until something becomes ready just do this 
+
+    $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
+
+Most systems do not both to return anything useful in $timeleft, so
+calling select() in a scalar context just returns $nfound.
+
+Any of the bitmasks can also be undef.  The timeout, if specified, is
+in seconds, which may be fractional.  Note: not all implementations are
+capable of returning the $timeleft.  If not, they always return
+$timeleft equal to the supplied $timeout.
+
+You can effect a 250-microsecond sleep this way:
+
+    select(undef, undef, undef, 0.25);
+
+B<WARNING>: Do not attempt to mix buffered I/O (like read() or <FH>)
+with select().  You have to use sysread() instead.
+
+=item semctl ID,SEMNUM,CMD,ARG
+
+Calls the System V IPC function semctl.  If CMD is &IPC_STAT or
+&GETALL, then ARG must be a variable which will hold the returned
+semid_ds structure or semaphore value array.  Returns like ioctl: the
+undefined value for error, "0 but true" for zero, or the actual return
+value otherwise.
+
+=item semget KEY,NSEMS,FLAGS
+
+Calls the System V IPC function semget.  Returns the semaphore id, or
+the undefined value if there is an error.
+
+=item semop KEY,OPSTRING
+
+Calls the System V IPC function semop to perform semaphore operations
+such as signaling and waiting.  OPSTRING must be a packed array of
+semop structures.  Each semop structure can be generated with
+C<pack("sss", $semnum, $semop, $semflag)>.  The number of semaphore
+operations is implied by the length of OPSTRING.  Returns TRUE if
+successful, or FALSE if there is an error.  As an example, the
+following code waits on semaphore $semnum of semaphore id $semid:
+
+    $semop = pack("sss", $semnum, -1, 0);
+    die "Semaphore trouble: $!\n" unless semop($semid, $semop);
+
+To signal the semaphore, replace "-1" with "1".
+
+=item send SOCKET,MSG,FLAGS,TO
+
+=item send SOCKET,MSG,FLAGS
+
+Sends a message on a socket.  Takes the same flags as the system call
+of the same name.  On unconnected sockets you must specify a
+destination to send TO, in which case it does a C sendto().  Returns
+the number of characters sent, or the undefined value if there is an
+error.
+See L<perlipc/"UDP: Message Passing"> for examples.
+
+=item setpgrp PID,PGRP
+
+Sets the current process group for the specified PID, 0 for the current
+process.  Will produce a fatal error if used on a machine that doesn't
+implement setpgrp(2).
+
+=item setpriority WHICH,WHO,PRIORITY
+
+Sets the current priority for a process, a process group, or a user.
+(See setpriority(2).)  Will produce a fatal error if used on a machine
+that doesn't implement setpriority(2).
+
+=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
+
+Sets the socket option requested.  Returns undefined if there is an
+error.  OPTVAL may be specified as undef if you don't want to pass an
+argument.
+
+=item shift ARRAY
+
+=item shift
+
+Shifts the first value of the array off and returns it, shortening the
+array by 1 and moving everything down.  If there are no elements in the
+array, returns the undefined value.  If ARRAY is omitted, shifts the
+@ARGV array in the main program, and the @_ array in subroutines.
+(This is determined lexically.)  See also unshift(), push(), and pop().
+Shift() and unshift() do the same thing to the left end of an array
+that push() and pop() do to the right end.
+
+=item shmctl ID,CMD,ARG
+
+Calls the System V IPC function shmctl.  If CMD is &IPC_STAT, then ARG
+must be a variable which will hold the returned shmid_ds structure.
+Returns like ioctl: the undefined value for error, "0 but true" for
+zero, or the actual return value otherwise.
+
+=item shmget KEY,SIZE,FLAGS
+
+Calls the System V IPC function shmget.  Returns the shared memory
+segment id, or the undefined value if there is an error.
+
+=item shmread ID,VAR,POS,SIZE
+
+=item shmwrite ID,STRING,POS,SIZE
+
+Reads or writes the System V shared memory segment ID starting at
+position POS for size SIZE by attaching to it, copying in/out, and
+detaching from it.  When reading, VAR must be a variable which will
+hold the data read.  When writing, if STRING is too long, only SIZE
+bytes are used; if STRING is too short, nulls are written to fill out
+SIZE bytes.  Return TRUE if successful, or FALSE if there is an error.
+
+=item shutdown SOCKET,HOW
+
+Shuts down a socket connection in the manner indicated by HOW, which
+has the same interpretation as in the system call of the same name.
+
+=item sin EXPR
+
+Returns the sine of EXPR (expressed in radians).  If EXPR is omitted,
+returns sine of $_.
+
+=item sleep EXPR
+
+=item sleep
+
+Causes the script to sleep for EXPR seconds, or forever if no EXPR.
+May be interrupted by sending the process a SIGALRM.  Returns the
+number of seconds actually slept.  You probably cannot mix alarm() and
+sleep() calls, since sleep() is often implemented using alarm().
+
+On some older systems, it may sleep up to a full second less than what
+you requested, depending on how it counts seconds.  Most modern systems
+always sleep the full amount.
+
+For delays of finer granularity than one second, you may use Perl's
+syscall() interface to access setitimer(2) if your system supports it, 
+or else see L</select()> below.  
+
+=item socket SOCKET,DOMAIN,TYPE,PROTOCOL
+
+Opens a socket of the specified kind and attaches it to filehandle
+SOCKET.  DOMAIN, TYPE and PROTOCOL are specified the same as for the
+system call of the same name.  You should "use Socket;" first to get
+the proper definitions imported.  See the example in L<perlipc/"Sockets: Client/Server Communication">.
+
+=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
+
+Creates an unnamed pair of sockets in the specified domain, of the
+specified type.  DOMAIN, TYPE and PROTOCOL are specified the same as
+for the system call of the same name.  If unimplemented, yields a fatal
+error.  Returns TRUE if successful.
+
+=item sort SUBNAME LIST
+
+=item sort BLOCK LIST
+
+=item sort LIST
+
+Sorts the LIST and returns the sorted list value.  Nonexistent values
+of arrays are stripped out.  If SUBNAME or BLOCK is omitted, sorts
+in standard string comparison order.  If SUBNAME is specified, it
+gives the name of a subroutine that returns an integer less than, equal
+to, or greater than 0, depending on how the elements of the array are
+to be ordered.  (The <=> and cmp operators are extremely useful in such
+routines.)  SUBNAME may be a scalar variable name, in which case the
+value provides the name of the subroutine to use.  In place of a
+SUBNAME, you can provide a BLOCK as an anonymous, in-line sort
+subroutine.
+
+In the interests of efficiency the normal calling code for subroutines is
+bypassed, with the following effects: the subroutine may not be a
+recursive subroutine, and the two elements to be compared are passed into
+the subroutine not via @_ but as the package global variables $a and
+$b (see example below).  They are passed by reference, so don't
+modify $a and $b.  And don't try to declare them as lexicals either.
+
+Examples:
+
+    # sort lexically
+    @articles = sort @files;
+
+    # same thing, but with explicit sort routine
+    @articles = sort {$a cmp $b} @files;
+
+    # now case-insensitively
+    @articles = sort { uc($a) cmp uc($b)} @files;
+
+    # same thing in reversed order
+    @articles = sort {$b cmp $a} @files;
+
+    # sort numerically ascending
+    @articles = sort {$a <=> $b} @files;
+
+    # sort numerically descending
+    @articles = sort {$b <=> $a} @files;
+
+    # sort using explicit subroutine name
+    sub byage {
+	$age{$a} <=> $age{$b};	# presuming integers
+    }
+    @sortedclass = sort byage @class;
+
+    # this sorts the %age associative arrays by value 
+    # instead of key using an inline function
+    @eldest = sort { $age{$b} <=> $age{$a} } keys %age;
+
+    sub backwards { $b cmp $a; }
+    @harry = ('dog','cat','x','Cain','Abel');
+    @george = ('gone','chased','yz','Punished','Axed');
+    print sort @harry;
+	    # prints AbelCaincatdogx
+    print sort backwards @harry;
+	    # prints xdogcatCainAbel
+    print sort @george, 'to', @harry;
+	    # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
+
+    # inefficiently sort by descending numeric compare using 
+    # the first integer after the first = sign, or the 
+    # whole record case-insensitively otherwise
+
+    @new = sort {
+	($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0]
+			    ||
+	            uc($a)  cmp  uc($b)
+    } @old;
+
+    # same thing, but much more efficiently;
+    # we'll build auxiliary indices instead
+    # for speed
+    @nums = @caps = ();
+    for (@old) { 
+	push @nums, /=(\d+)/;
+	push @caps, uc($_);
+    } 
+
+    @new = @old[ sort {
+			$nums[$b] <=> $nums[$a]
+				 ||
+			$caps[$a] cmp $caps[$b]
+		       } 0..$#old
+	       ];
+
+    # same thing using a Schwartzian Transform (no temps)
+    @new = map { $_->[0] }
+        sort { $b->[1] <=> $a->[1]
+                        ||
+               $a->[2] cmp $b->[2]
+        } map { [$_, /=(\d+)/, uc($_)] } @old;
+
+If you're and using strict, you I<MUST NOT> declare $a
+and $b as lexicals.  They are package globals.  That means
+if you're in the C<main> package, it's
+
+    @articles = sort {$main::b <=> $main::a} @files;
+
+or just
+
+    @articles = sort {$::b <=> $::a} @files;
+
+but if you're in the C<FooPack> package, it's
+
+    @articles = sort {$FooPack::b <=> $FooPack::a} @files;
+
+=item splice ARRAY,OFFSET,LENGTH,LIST
+
+=item splice ARRAY,OFFSET,LENGTH
+
+=item splice ARRAY,OFFSET
+
+Removes the elements designated by OFFSET and LENGTH from an array, and
+replaces them with the elements of LIST, if any.  Returns the elements
+removed from the array.  The array grows or shrinks as necessary.  If
+LENGTH is omitted, removes everything from OFFSET onward.  The
+following equivalencies hold (assuming $[ == 0):
+
+    push(@a,$x,$y)	splice(@a,$#a+1,0,$x,$y)
+    pop(@a)		splice(@a,-1)
+    shift(@a)		splice(@a,0,1)
+    unshift(@a,$x,$y)	splice(@a,0,0,$x,$y)
+    $a[$x] = $y		splice(@a,$x,1,$y);
+
+Example, assuming array lengths are passed before arrays:
+
+    sub aeq {	# compare two list values
+	local(@a) = splice(@_,0,shift);
+	local(@b) = splice(@_,0,shift);
+	return 0 unless @a == @b;	# same len?
+	while (@a) {
+	    return 0 if pop(@a) ne pop(@b);
+	}
+	return 1;
+    }
+    if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... }
+
+=item split /PATTERN/,EXPR,LIMIT
+
+=item split /PATTERN/,EXPR
+
+=item split /PATTERN/
+
+=item split
+
+Splits a string into an array of strings, and returns it.
+
+If not in a list context, returns the number of fields found and splits into
+the @_ array.  (In a list context, you can force the split into @_ by
+using C<??> as the pattern delimiters, but it still returns the array
+value.)  The use of implicit split to @_ is deprecated, however.
+
+If EXPR is omitted, splits the $_ string.  If PATTERN is also omitted,
+splits on whitespace (after skipping any leading whitespace).  Anything
+matching PATTERN is taken to be a delimiter separating the fields.  (Note
+that the delimiter may be longer than one character.)  If LIMIT is
+specified and is not negative, splits into no more than that many fields
+(though it may split into fewer).  If LIMIT is unspecified, trailing null
+fields are stripped (which potential users of pop() would do well to
+remember).  If LIMIT is negative, it is treated as if an arbitrarily large
+LIMIT had been specified.
+
+A pattern matching the null string (not to be confused with
+a null pattern C<//>, which is just one member of the set of patterns
+matching a null string) will split the value of EXPR into separate
+characters at each point it matches that way.  For example:
+
+    print join(':', split(/ */, 'hi there'));
+
+produces the output 'h:i:t:h:e:r:e'.
+
+The LIMIT parameter can be used to partially split a line
+
+    ($login, $passwd, $remainder) = split(/:/, $_, 3);
+
+When assigning to a list, if LIMIT is omitted, Perl supplies a LIMIT
+one larger than the number of variables in the list, to avoid
+unnecessary work.  For the list above LIMIT would have been 4 by
+default.  In time critical applications it behooves you not to split
+into more fields than you really need.
+
+If the PATTERN contains parentheses, additional array elements are
+created from each matching substring in the delimiter.
+
+    split(/([,-])/, "1-10,20");
+
+produces the list value
+
+    (1, '-', 10, ',', 20)
+
+If you had the entire header of a normal Unix email message in $header, 
+you could split it up into fields and their values this way:
+
+    $header =~ s/\n\s+/ /g;  # fix continuation lines
+    %hdrs   =  (UNIX_FROM => split /^(.*?):\s*/m, $header);
+
+The pattern C</PATTERN/> may be replaced with an expression to specify
+patterns that vary at runtime.  (To do runtime compilation only once,
+use C</$variable/o>.)
+
+As a special case, specifying a PATTERN of space (C<' '>) will split on
+white space just as split with no arguments does.  Thus, split(' ') can
+be used to emulate B<awk>'s default behavior, whereas C<split(/ /)>
+will give you as many null initial fields as there are leading spaces.
+A split on /\s+/ is like a split(' ') except that any leading
+whitespace produces a null first field.  A split with no arguments
+really does a C<split(' ', $_)> internally.
+
+Example:
+
+    open(passwd, '/etc/passwd');
+    while (<passwd>) {
+	($login, $passwd, $uid, $gid, $gcos, 
+	    $home, $shell) = split(/:/);
+	...
+    }
+
+(Note that $shell above will still have a newline on it.  See L</chop>, 
+L</chomp>, and L</join>.)
+
+=item sprintf FORMAT,LIST
+
+Returns a string formatted by the usual printf conventions of the C
+language.  See L<sprintf(3)> or L<printf(3)> on your system for details.
+(The * character for an indirectly specified length is not
+supported, but you can get the same effect by interpolating a variable
+into the pattern.)  Some C libraries' implementations of sprintf() can
+dump core when fed ludicrous arguments.
+
+=item sqrt EXPR
+
+Return the square root of EXPR.  If EXPR is omitted, returns square
+root of $_.
+
+=item srand EXPR
+
+Sets the random number seed for the C<rand> operator.  If EXPR is omitted,
+does C<srand(time)>.  Many folks use an explicit C<srand(time ^ $$)>
+instead.  Of course, you'd need something much more random than that for
+cryptographic purposes, since it's easy to guess the current time.
+Checksumming the compressed output of rapidly changing operating system
+status programs is the usual method.  Examples are posted regularly to
+the comp.security.unix newsgroup.
+
+=item stat FILEHANDLE
+
+=item stat EXPR
+
+Returns a 13-element array giving the status info for a file, either the
+file opened via FILEHANDLE, or named by EXPR.  Returns a null list if
+the stat fails.  Typically used as follows:
+
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+       $atime,$mtime,$ctime,$blksize,$blocks)
+           = stat($filename);
+
+Not all fields are supported on all filesystem types.  Here are the 
+meaning of the fields:
+
+  dev	    device number of filesystem 
+  ino	    inode number 
+  mode	    file mode  (type and permissions)
+  nlink	    number of (hard) links to the file 
+  uid	    numeric user ID of file's owner 
+  gid	    numer group ID of file's owner 
+  rdev	    the device identifier (special files only)
+  size	    total size of file, in bytes 
+  atime	    last access time since the epoch
+  mtime	    last modify time since the epoch
+  ctime	    inode change time (NOT creation type!) since the epoch
+  blksize   preferred blocksize for file system I/O
+  blocks    actual number of blocks allocated
+
+(The epoch was at 00:00 January 1, 1970 GMT.)
+
+If stat is passed the special filehandle consisting of an underline, no
+stat is done, but the current contents of the stat structure from the
+last stat or filetest are returned.  Example:
+
+    if (-x $file && (($d) = stat(_)) && $d < 0) {
+	print "$file is executable NFS file\n";
+    }
+
+(This only works on machines for which the device number is negative under NFS.)
+
+=item study SCALAR
+
+=item study
+
+Takes extra time to study SCALAR ($_ if unspecified) in anticipation of
+doing many pattern matches on the string before it is next modified.
+This may or may not save time, depending on the nature and number of
+patterns you are searching on, and on the distribution of character
+frequencies in the string to be searched--you probably want to compare
+runtimes with and without it to see which runs faster.  Those loops
+which scan for many short constant strings (including the constant
+parts of more complex patterns) will benefit most.  You may have only
+one study active at a time--if you study a different scalar the first
+is "unstudied".  (The way study works is this: a linked list of every
+character in the string to be searched is made, so we know, for
+example, where all the 'k' characters are.  From each search string,
+the rarest character is selected, based on some static frequency tables
+constructed from some C programs and English text.  Only those places
+that contain this "rarest" character are examined.)
+
+For example, here is a loop which inserts index producing entries
+before any line containing a certain pattern:
+
+    while (<>) {
+	study;
+	print ".IX foo\n" if /\bfoo\b/;
+	print ".IX bar\n" if /\bbar\b/;
+	print ".IX blurfl\n" if /\bblurfl\b/;
+	...
+	print;
+    }
+
+In searching for /\bfoo\b/, only those locations in $_ that contain "f"
+will be looked at, because "f" is rarer than "o".  In general, this is
+a big win except in pathological cases.  The only question is whether
+it saves you more time than it took to build the linked list in the
+first place.
+
+Note that if you have to look for strings that you don't know till
+runtime, you can build an entire loop as a string and eval that to
+avoid recompiling all your patterns all the time.  Together with
+undefining $/ to input entire files as one record, this can be very
+fast, often faster than specialized programs like fgrep(1).  The following
+scans a list of files (@files) for a list of words (@words), and prints
+out the names of those files that contain a match:
+
+    $search = 'while (<>) { study;';
+    foreach $word (@words) {
+	$search .= "++\$seen{\$ARGV} if /\\b$word\\b/;\n";
+    }
+    $search .= "}";
+    @ARGV = @files;
+    undef $/;
+    eval $search;		# this screams
+    $/ = "\n";		# put back to normal input delim
+    foreach $file (sort keys(%seen)) {
+	print $file, "\n";
+    }
+
+=item sub BLOCK
+
+=item sub NAME
+
+=item sub NAME BLOCK
+
+This is subroutine definition, not a real function I<per se>.  With just a
+NAME (and possibly prototypes), it's just a forward declaration.  Without
+a NAME, it's an anonymous function declaration, and does actually return a
+value: the CODE ref of the closure you just created. See L<perlsub> and
+L<perlref> for details.
+
+=item substr EXPR,OFFSET,LEN
+
+=item substr EXPR,OFFSET
+
+Extracts a substring out of EXPR and returns it.  First character is at
+offset 0, or whatever you've set $[ to.  If OFFSET is negative, starts
+that far from the end of the string.  If LEN is omitted, returns
+everything to the end of the string.  If LEN is negative, leaves that
+many characters off the end of the string.
+
+You can use the substr() function
+as an lvalue, in which case EXPR must be an lvalue.  If you assign
+something shorter than LEN, the string will shrink, and if you assign
+something longer than LEN, the string will grow to accommodate it.  To
+keep the string the same length you may need to pad or chop your value
+using sprintf().
+
+=item symlink OLDFILE,NEWFILE
+
+Creates a new filename symbolically linked to the old filename.
+Returns 1 for success, 0 otherwise.  On systems that don't support
+symbolic links, produces a fatal error at run time.  To check for that,
+use eval:
+
+    $symlink_exists = (eval 'symlink("","");', $@ eq '');
+
+=item syscall LIST
+
+Calls the system call specified as the first element of the list,
+passing the remaining elements as arguments to the system call.  If
+unimplemented, produces a fatal error.  The arguments are interpreted
+as follows: if a given argument is numeric, the argument is passed as
+an int.  If not, the pointer to the string value is passed.  You are
+responsible to make sure a string is pre-extended long enough to
+receive any result that might be written into a string.  If your
+integer arguments are not literals and have never been interpreted in a
+numeric context, you may need to add 0 to them to force them to look
+like numbers.
+
+    require 'syscall.ph';		# may need to run h2ph
+    syscall(&SYS_write, fileno(STDOUT), "hi there\n", 9);
+
+Note that Perl only supports passing of up to 14 arguments to your system call,
+which in practice should usually suffice.
+
+=item sysopen FILEHANDLE,FILENAME,MODE
+
+=item sysopen FILEHANDLE,FILENAME,MODE,PERMS
+
+Opens the file whose filename is given by FILENAME, and associates it
+with FILEHANDLE.  If FILEHANDLE is an expression, its value is used as
+the name of the real filehandle wanted.  This function calls the
+underlying operating system's C<open> function with the parameters
+FILENAME, MODE, PERMS.
+
+The possible values and flag bits of the MODE parameter are
+system-dependent; they are available via the standard module C<Fcntl>.
+However, for historical reasons, some values are universal: zero means
+read-only, one means write-only, and two means read/write.
+
+If the file named by FILENAME does not exist and the C<open> call
+creates it (typically because MODE includes the O_CREAT flag), then
+the value of PERMS specifies the permissions of the newly created
+file.  If PERMS is omitted, the default value is 0666, which allows
+read and write for all.  This default is reasonable: see C<umask>.
+
+=item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
+
+=item sysread FILEHANDLE,SCALAR,LENGTH
+
+Attempts to read LENGTH bytes of data into variable SCALAR from the
+specified FILEHANDLE, using the system call read(2).  It bypasses
+stdio, so mixing this with other kinds of reads may cause confusion.
+Returns the number of bytes actually read, or undef if there was an
+error.  SCALAR will be grown or shrunk to the length actually read.  An
+OFFSET may be specified to place the read data at some other place than
+the beginning of the string.
+
+=item system LIST
+
+Does exactly the same thing as "exec LIST" except that a fork is done
+first, and the parent process waits for the child process to complete.
+Note that argument processing varies depending on the number of
+arguments.  The return value is the exit status of the program as
+returned by the wait() call.  To get the actual exit value divide by
+256.  See also L</exec>.  This is I<NOT> what you want to use to capture 
+the output from a command, for that you should merely use backticks, as
+described in L<perlop/"`STRING`">.
+
+=item syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET
+
+=item syswrite FILEHANDLE,SCALAR,LENGTH
+
+Attempts to write LENGTH bytes of data from variable SCALAR to the
+specified FILEHANDLE, using the system call write(2).  It bypasses
+stdio, so mixing this with prints may cause confusion.  Returns the
+number of bytes actually written, or undef if there was an error.  An
+OFFSET may be specified to get the write data from some other place than
+the beginning of the string.
+
+=item tell FILEHANDLE
+
+=item tell
+
+Returns the current file position for FILEHANDLE.  FILEHANDLE may be an
+expression whose value gives the name of the actual filehandle.  If
+FILEHANDLE is omitted, assumes the file last read.
+
+=item telldir DIRHANDLE
+
+Returns the current position of the readdir() routines on DIRHANDLE.
+Value may be given to seekdir() to access a particular location in a
+directory.  Has the same caveats about possible directory compaction as
+the corresponding system library routine.
+
+=item tie VARIABLE,CLASSNAME,LIST
+
+This function binds a variable to a package class that will provide the
+implementation for the variable.  VARIABLE is the name of the variable
+to be enchanted.  CLASSNAME is the name of a class implementing objects
+of correct type.  Any additional arguments are passed to the "new"
+method of the class (meaning TIESCALAR, TIEARRAY, or TIEHASH).
+Typically these are arguments such as might be passed to the dbm_open()
+function of C.  The object returned by the "new" method is also
+returned by the tie() function, which would be useful if you want to
+access other methods in CLASSNAME.
+
+Note that functions such as keys() and values() may return huge array
+values when used on large objects, like DBM files.  You may prefer to
+use the each() function to iterate over such.  Example:
+
+    # print out history file offsets
+    use NDBM_File;
+    tie(%HIST, NDBM_File, '/usr/lib/news/history', 1, 0);
+    while (($key,$val) = each %HIST) {
+	print $key, ' = ', unpack('L',$val), "\n";
+    }
+    untie(%HIST);
+
+A class implementing an associative array should have the following
+methods:
+
+    TIEHASH classname, LIST
+    DESTROY this
+    FETCH this, key
+    STORE this, key, value
+    DELETE this, key
+    EXISTS this, key
+    FIRSTKEY this
+    NEXTKEY this, lastkey
+
+A class implementing an ordinary array should have the following methods:
+
+    TIEARRAY classname, LIST
+    DESTROY this
+    FETCH this, key
+    STORE this, key, value
+    [others TBD]
+
+A class implementing a scalar should have the following methods:
+
+    TIESCALAR classname, LIST
+    DESTROY this
+    FETCH this, 
+    STORE this, value
+
+Unlike dbmopen(), the tie() function will not use or require a module
+for you--you need to do that explicitly yourself.  See L<DB_File>
+or the F<Config> module for interesting tie() implementations.
+
+=item tied VARIABLE
+
+Returns a reference to the object underlying VARIABLE (the same value
+that was originally returned by the tie() call which bound the variable
+to a package.)  Returns the undefined value if VARIABLE isn't tied to a
+package.
+
+=item time
+
+Returns the number of non-leap seconds since 00:00:00 UTC, January 1,
+1970.  Suitable for feeding to gmtime() and localtime().
+
+=item times
+
+Returns a four-element array giving the user and system times, in
+seconds, for this process and the children of this process.
+
+    ($user,$system,$cuser,$csystem) = times;
+
+=item tr///
+
+The translation operator.  See L<perlop>.
+
+=item truncate FILEHANDLE,LENGTH
+
+=item truncate EXPR,LENGTH
+
+Truncates the file opened on FILEHANDLE, or named by EXPR, to the
+specified length.  Produces a fatal error if truncate isn't implemented
+on your system.
+
+=item uc EXPR
+
+Returns an uppercased version of EXPR.  This is the internal function
+implementing the \U escape in double-quoted strings.
+Should respect any POSIX setlocale() settings.
+
+=item ucfirst EXPR
+
+Returns the value of EXPR with the first character uppercased.  This is
+the internal function implementing the \u escape in double-quoted strings.
+Should respect any POSIX setlocale() settings.
+
+=item umask EXPR
+
+=item umask
+
+Sets the umask for the process and returns the old one.  If EXPR is
+omitted, merely returns current umask.
+
+=item undef EXPR
+
+=item undef
+
+Undefines the value of EXPR, which must be an lvalue.  Use only on a
+scalar value, an entire array, or a subroutine name (using "&").  (Using undef()
+will probably not do what you expect on most predefined variables or
+DBM list values, so don't do that.)  Always returns the undefined value.  You can omit
+the EXPR, in which case nothing is undefined, but you still get an
+undefined value that you could, for instance, return from a
+subroutine.  Examples:
+
+    undef $foo;
+    undef $bar{'blurfl'};
+    undef @ary;
+    undef %assoc;
+    undef &mysub;
+    return (wantarray ? () : undef) if $they_blew_it;
+
+=item unlink LIST
+
+Deletes a list of files.  Returns the number of files successfully
+deleted.
+
+    $cnt = unlink 'a', 'b', 'c';
+    unlink @goners;
+    unlink <*.bak>;
+
+Note: unlink will not delete directories unless you are superuser and
+the B<-U> flag is supplied to Perl.  Even if these conditions are
+met, be warned that unlinking a directory can inflict damage on your
+filesystem.  Use rmdir instead.
+
+=item unpack TEMPLATE,EXPR
+
+Unpack does the reverse of pack: it takes a string representing a
+structure and expands it out into a list value, returning the array
+value.  (In a scalar context, it merely returns the first value
+produced.)  The TEMPLATE has the same format as in the pack function.
+Here's a subroutine that does substring:
+
+    sub substr {
+	local($what,$where,$howmuch) = @_;
+	unpack("x$where a$howmuch", $what);
+    }
+
+and then there's
+
+    sub ordinal { unpack("c",$_[0]); } # same as ord()
+
+In addition, you may prefix a field with a %<number> to indicate that
+you want a <number>-bit checksum of the items instead of the items
+themselves.  Default is a 16-bit checksum.  For example, the following
+computes the same number as the System V sum program:
+
+    while (<>) {
+	$checksum += unpack("%16C*", $_);
+    }
+    $checksum %= 65536;
+
+The following efficiently counts the number of set bits in a bit vector:
+
+    $setbits = unpack("%32b*", $selectmask);
+
+=item untie VARIABLE
+
+Breaks the binding between a variable and a package.  (See tie().)
+
+=item unshift ARRAY,LIST
+
+Does the opposite of a C<shift>.  Or the opposite of a C<push>,
+depending on how you look at it.  Prepends list to the front of the
+array, and returns the new number of elements in the array.
+
+    unshift(ARGV, '-e') unless $ARGV[0] =~ /^-/;
+
+Note the LIST is prepended whole, not one element at a time, so the
+prepended elements stay in the same order.  Use reverse to do the
+reverse.
+
+=item use Module LIST
+
+=item use Module
+
+Imports some semantics into the current package from the named module,
+generally by aliasing certain subroutine or variable names into your
+package.  It is exactly equivalent to
+
+    BEGIN { require Module; import Module LIST; }
+
+The BEGIN forces the require and import to happen at compile time.  The
+require makes sure the module is loaded into memory if it hasn't been
+yet.  The import is not a builtin--it's just an ordinary static method
+call into the "Module" package to tell the module to import the list of
+features back into the current package.  The module can implement its
+import method any way it likes, though most modules just choose to
+derive their import method via inheritance from the Exporter class that
+is defined in the Exporter module. See L<Exporter>.
+
+If you don't want your namespace altered, explicitly supply an empty list:
+
+    use Module ();
+
+That is exactly equivalent to
+
+    BEGIN { require Module; }
+
+Because this is a wide-open interface, pragmas (compiler directives)
+are also implemented this way.  Currently implemented pragmas are:
+
+    use integer;
+    use diagnostics;
+    use sigtrap qw(SEGV BUS);
+    use strict  qw(subs vars refs);
+    use subs    qw(afunc blurfl);
+
+These pseudomodules import semantics into the current block scope, unlike
+ordinary modules, which import symbols into the current package (which are
+effective through the end of the file).
+
+There's a corresponding "no" command that unimports meanings imported
+by use.
+
+    no integer;
+    no strict 'refs';
+
+See L<perlmod> for a list of standard modules and pragmas.
+
+=item utime LIST
+
+Changes the access and modification times on each file of a list of
+files.  The first two elements of the list must be the NUMERICAL access
+and modification times, in that order.  Returns the number of files
+successfully changed.  The inode modification time of each file is set
+to the current time.  Example of a "touch" command:
+
+    #!/usr/bin/perl
+    $now = time;
+    utime $now, $now, @ARGV;
+
+=item values ASSOC_ARRAY
+
+Returns a normal array consisting of all the values of the named
+associative array.  (In a scalar context, returns the number of
+values.)  The values are returned in an apparently random order, but it
+is the same order as either the keys() or each() function would produce
+on the same array.  See also keys(), each(), and sort().
+
+=item vec EXPR,OFFSET,BITS
+
+Treats the string in EXPR as a vector of unsigned integers, and
+returns the value of the bitfield specified by OFFSET.  BITS specifies
+the number of bits that are reserved for each entry in the bit
+vector. This must be a power of two from 1 to 32. vec() may also be
+assigned to, in which case parens are needed to give the expression
+the correct precedence as in
+
+    vec($image, $max_x * $x + $y, 8) = 3;
+
+Vectors created with vec() can also be manipulated with the logical
+operators |, & and ^, which will assume a bit vector operation is
+desired when both operands are strings.
+
+To transform a bit vector into a string or array of 0's and 1's, use these:
+
+    $bits = unpack("b*", $vector);
+    @bits = split(//, unpack("b*", $vector));
+
+If you know the exact length in bits, it can be used in place of the *.
+
+=item wait
+
+Waits for a child process to terminate and returns the pid of the
+deceased process, or -1 if there are no child processes.  The status is
+returned in $?.
+
+=item waitpid PID,FLAGS
+
+Waits for a particular child process to terminate and returns the pid
+of the deceased process, or -1 if there is no such child process.  The
+status is returned in $?.  If you say
+
+    use POSIX "wait_h";
+    ...
+    waitpid(-1,&WNOHANG);
+
+then you can do a non-blocking wait for any process.  Non-blocking wait
+is only available on machines supporting either the waitpid(2) or
+wait4(2) system calls.  However, waiting for a particular pid with
+FLAGS of 0 is implemented everywhere.  (Perl emulates the system call
+by remembering the status values of processes that have exited but have
+not been harvested by the Perl script yet.)
+
+=item wantarray
+
+Returns TRUE if the context of the currently executing subroutine is
+looking for a list value.  Returns FALSE if the context is looking
+for a scalar.
+
+    return wantarray ? () : undef;
+
+=item warn LIST
+
+Produces a message on STDERR just like die(), but doesn't exit or
+on an exception.
+
+=item write FILEHANDLE
+
+=item write EXPR
+
+=item write
+
+Writes a formatted record (possibly multi-line) to the specified file,
+using the format associated with that file.  By default the format for
+a file is the one having the same name is the filehandle, but the
+format for the current output channel (see the select() function) may be set
+explicitly by assigning the name of the format to the $~ variable.
+
+Top of form processing is handled automatically:  if there is
+insufficient room on the current page for the formatted record, the
+page is advanced by writing a form feed, a special top-of-page format
+is used to format the new page header, and then the record is written.
+By default the top-of-page format is the name of the filehandle with
+"_TOP" appended, but it may be dynamically set to the format of your
+choice by assigning the name to the $^ variable while the filehandle is
+selected.  The number of lines remaining on the current page is in
+variable $-, which can be set to 0 to force a new page.
+
+If FILEHANDLE is unspecified, output goes to the current default output
+channel, which starts out as STDOUT but may be changed by the
+C<select> operator.  If the FILEHANDLE is an EXPR, then the expression
+is evaluated and the resulting string is used to look up the name of
+the FILEHANDLE at run time.  For more on formats, see L<perlform>.
+
+Note that write is I<NOT> the opposite of read.  Unfortunately.
+
+=item y///
+
+The translation operator.  See L<perlop>.
+
+=back
diff --git a/gnu/usr.bin/perl/pod/perlguts.pod b/gnu/usr.bin/perl/pod/perlguts.pod
new file mode 100644
index 00000000000..07509bcc046
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlguts.pod
@@ -0,0 +1,2194 @@
+=head1 NAME
+
+perlguts - Perl's Internal Functions
+
+=head1 DESCRIPTION
+
+This document attempts to describe some of the internal functions of the
+Perl executable.  It is far from complete and probably contains many errors.
+Please refer any questions or comments to the author below.
+
+=head1 Datatypes
+
+Perl has three typedefs that handle Perl's three main data types:
+
+    SV  Scalar Value
+    AV  Array Value
+    HV  Hash Value
+
+Each typedef has specific routines that manipulate the various data types.
+
+=head2 What is an "IV"?
+
+Perl uses a special typedef IV which is large enough to hold either an
+integer or a pointer.
+
+Perl also uses two special typedefs, I32 and I16, which will always be at
+least 32-bits and 16-bits long, respectively.
+
+=head2 Working with SV's
+
+An SV can be created and loaded with one command.  There are four types of
+values that can be loaded: an integer value (IV), a double (NV), a string,
+(PV), and another scalar (SV).
+
+The four routines are:
+
+    SV*  newSViv(IV);
+    SV*  newSVnv(double);
+    SV*  newSVpv(char*, int);
+    SV*  newSVsv(SV*);
+
+To change the value of an *already-existing* SV, there are five routines:
+
+    void  sv_setiv(SV*, IV);
+    void  sv_setnv(SV*, double);
+    void  sv_setpvn(SV*, char*, int)
+    void  sv_setpv(SV*, char*);
+    void  sv_setsv(SV*, SV*);
+
+Notice that you can choose to specify the length of the string to be
+assigned by using C<sv_setpvn> or C<newSVpv>, or you may allow Perl to
+calculate the length by using C<sv_setpv> or by specifying 0 as the second
+argument to C<newSVpv>.  Be warned, though, that Perl will determine the
+string's length by using C<strlen>, which depends on the string terminating
+with a NUL character.
+
+To access the actual value that an SV points to, you can use the macros:
+
+    SvIV(SV*)
+    SvNV(SV*)
+    SvPV(SV*, STRLEN len)
+
+which will automatically coerce the actual scalar type into an IV, double,
+or string.
+
+In the C<SvPV> macro, the length of the string returned is placed into the
+variable C<len> (this is a macro, so you do I<not> use C<&len>).  If you do not
+care what the length of the data is, use the global variable C<na>.  Remember,
+however, that Perl allows arbitrary strings of data that may both contain
+NUL's and not be terminated by a NUL.
+
+If you simply want to know if the scalar value is TRUE, you can use:
+
+    SvTRUE(SV*)
+
+Although Perl will automatically grow strings for you, if you need to force
+Perl to allocate more memory for your SV, you can use the macro
+
+    SvGROW(SV*, STRLEN newlen)
+
+which will determine if more memory needs to be allocated.  If so, it will
+call the function C<sv_grow>.  Note that C<SvGROW> can only increase, not
+decrease, the allocated memory of an SV.
+
+If you have an SV and want to know what kind of data Perl thinks is stored
+in it, you can use the following macros to check the type of SV you have.
+
+    SvIOK(SV*)
+    SvNOK(SV*)
+    SvPOK(SV*)
+
+You can get and set the current length of the string stored in an SV with
+the following macros:
+
+    SvCUR(SV*)
+    SvCUR_set(SV*, I32 val)
+
+You can also get a pointer to the end of the string stored in the SV
+with the macro:
+
+    SvEND(SV*)
+
+But note that these last three macros are valid only if C<SvPOK()> is true.
+
+If you want to append something to the end of string stored in an C<SV*>,
+you can use the following functions:
+
+    void  sv_catpv(SV*, char*);
+    void  sv_catpvn(SV*, char*, int);
+    void  sv_catsv(SV*, SV*);
+
+The first function calculates the length of the string to be appended by
+using C<strlen>.  In the second, you specify the length of the string
+yourself.  The third function extends the string stored in the first SV
+with the string stored in the second SV.  It also forces the second SV to
+be interpreted as a string.
+
+If you know the name of a scalar variable, you can get a pointer to its SV
+by using the following:
+
+    SV*  perl_get_sv("varname", FALSE);
+
+This returns NULL if the variable does not exist.
+
+If you want to know if this variable (or any other SV) is actually C<defined>,
+you can call:
+
+    SvOK(SV*)
+
+The scalar C<undef> value is stored in an SV instance called C<sv_undef>.  Its
+address can be used whenever an C<SV*> is needed.
+
+There are also the two values C<sv_yes> and C<sv_no>, which contain Boolean
+TRUE and FALSE values, respectively.  Like C<sv_undef>, their addresses can
+be used whenever an C<SV*> is needed.
+
+Do not be fooled into thinking that C<(SV *) 0> is the same as C<&sv_undef>.
+Take this code:
+
+    SV* sv = (SV*) 0;
+    if (I-am-to-return-a-real-value) {
+            sv = sv_2mortal(newSViv(42));
+    }
+    sv_setsv(ST(0), sv);
+
+This code tries to return a new SV (which contains the value 42) if it should
+return a real value, or undef otherwise.  Instead it has returned a null
+pointer which, somewhere down the line, will cause a segmentation violation,
+or just weird results.  Change the zero to C<&sv_undef> in the first line and
+all will be well.
+
+To free an SV that you've created, call C<SvREFCNT_dec(SV*)>.  Normally this
+call is not necessary.  See the section on B<MORTALITY>.
+
+=head2 What's Really Stored in an SV?
+
+Recall that the usual method of determining the type of scalar you have is
+to use C<Sv*OK> macros.  Since a scalar can be both a number and a string,
+usually these macros will always return TRUE and calling the C<Sv*V>
+macros will do the appropriate conversion of string to integer/double or
+integer/double to string.
+
+If you I<really> need to know if you have an integer, double, or string
+pointer in an SV, you can use the following three macros instead:
+
+    SvIOKp(SV*)
+    SvNOKp(SV*)
+    SvPOKp(SV*)
+
+These will tell you if you truly have an integer, double, or string pointer
+stored in your SV.  The "p" stands for private.
+
+In general, though, it's best to just use the C<Sv*V> macros.
+
+=head2 Working with AV's
+
+There are two ways to create and load an AV.  The first method just creates
+an empty AV:
+
+    AV*  newAV();
+
+The second method both creates the AV and initially populates it with SV's:
+
+    AV*  av_make(I32 num, SV **ptr);
+
+The second argument points to an array containing C<num> C<SV*>'s.  Once the
+AV has been created, the SV's can be destroyed, if so desired.
+
+Once the AV has been created, the following operations are possible on AV's:
+
+    void  av_push(AV*, SV*);
+    SV*   av_pop(AV*);
+    SV*   av_shift(AV*);
+    void  av_unshift(AV*, I32 num);
+
+These should be familiar operations, with the exception of C<av_unshift>.
+This routine adds C<num> elements at the front of the array with the C<undef>
+value.  You must then use C<av_store> (described below) to assign values
+to these new elements.
+
+Here are some other functions:
+
+    I32   av_len(AV*); /* Returns highest index value in array */
+
+    SV**  av_fetch(AV*, I32 key, I32 lval);
+            /* Fetches value at key offset, but it stores an undef value
+               at the offset if lval is non-zero */
+    SV**  av_store(AV*, I32 key, SV* val);
+            /* Stores val at offset key */
+
+Take note that C<av_fetch> and C<av_store> return C<SV**>'s, not C<SV*>'s.
+
+    void  av_clear(AV*);
+            /* Clear out all elements, but leave the array */
+    void  av_undef(AV*);
+            /* Undefines the array, removing all elements */
+    void  av_extend(AV*, I32 key);
+            /* Extend the array to a total of key elements */
+
+If you know the name of an array variable, you can get a pointer to its AV
+by using the following:
+
+    AV*  perl_get_av("varname", FALSE);
+
+This returns NULL if the variable does not exist.
+
+=head2 Working with HV's
+
+To create an HV, you use the following routine:
+
+    HV*  newHV();
+
+Once the HV has been created, the following operations are possible on HV's:
+
+    SV**  hv_store(HV*, char* key, U32 klen, SV* val, U32 hash);
+    SV**  hv_fetch(HV*, char* key, U32 klen, I32 lval);
+
+The C<klen> parameter is the length of the key being passed in.  The C<val>
+argument contains the SV pointer to the scalar being stored, and C<hash> is
+the pre-computed hash value (zero if you want C<hv_store> to calculate it
+for you).  The C<lval> parameter indicates whether this fetch is actually a
+part of a store operation.
+
+Remember that C<hv_store> and C<hv_fetch> return C<SV**>'s and not just
+C<SV*>.  In order to access the scalar value, you must first dereference
+the return value.  However, you should check to make sure that the return
+value is not NULL before dereferencing it.
+
+These two functions check if a hash table entry exists, and deletes it.
+
+    bool  hv_exists(HV*, char* key, U32 klen);
+    SV*   hv_delete(HV*, char* key, U32 klen, I32 flags);
+
+And more miscellaneous functions:
+
+    void   hv_clear(HV*);
+            /* Clears all entries in hash table */
+    void   hv_undef(HV*);
+            /* Undefines the hash table */
+
+Perl keeps the actual data in linked list of structures with a typedef of HE.
+These contain the actual key and value pointers (plus extra administrative
+overhead).  The key is a string pointer; the value is an C<SV*>.  However,
+once you have an C<HE*>, to get the actual key and value, use the routines
+specified below.
+
+    I32    hv_iterinit(HV*);
+            /* Prepares starting point to traverse hash table */
+    HE*    hv_iternext(HV*);
+            /* Get the next entry, and return a pointer to a
+               structure that has both the key and value */
+    char*  hv_iterkey(HE* entry, I32* retlen);
+            /* Get the key from an HE structure and also return
+               the length of the key string */
+    SV*    hv_iterval(HV*, HE* entry);
+            /* Return a SV pointer to the value of the HE
+               structure */
+    SV*    hv_iternextsv(HV*, char** key, I32* retlen);
+            /* This convenience routine combines hv_iternext,
+	       hv_iterkey, and hv_iterval.  The key and retlen
+	       arguments are return values for the key and its
+	       length.  The value is returned in the SV* argument */
+
+If you know the name of a hash variable, you can get a pointer to its HV
+by using the following:
+
+    HV*  perl_get_hv("varname", FALSE);
+
+This returns NULL if the variable does not exist.
+
+The hash algorithm, for those who are interested, is:
+
+    i = klen;
+    hash = 0;
+    s = key;
+    while (i--)
+	hash = hash * 33 + *s++;
+
+=head2 References
+
+References are a special type of scalar that point to other data types
+(including references).
+
+To create a reference, use the following command:
+
+    SV* newRV((SV*) thing);
+
+The C<thing> argument can be any of an C<SV*>, C<AV*>, or C<HV*>.  Once
+you have a reference, you can use the following macro to dereference the
+reference:
+
+    SvRV(SV*)
+
+then call the appropriate routines, casting the returned C<SV*> to either an
+C<AV*> or C<HV*>, if required.
+
+To determine if an SV is a reference, you can use the following macro:
+
+    SvROK(SV*)
+
+To actually discover what the reference refers to, you must use the following
+macro and then check the value returned.
+
+    SvTYPE(SvRV(SV*))
+
+The most useful types that will be returned are:
+
+    SVt_IV    Scalar
+    SVt_NV    Scalar
+    SVt_PV    Scalar
+    SVt_PVAV  Array
+    SVt_PVHV  Hash
+    SVt_PVCV  Code
+    SVt_PVMG  Blessed Scalar
+
+=head2 Blessed References and Class Objects
+
+References are also used to support object-oriented programming.  In the
+OO lexicon, an object is simply a reference that has been blessed into a
+package (or class).  Once blessed, the programmer may now use the reference
+to access the various methods in the class.
+
+A reference can be blessed into a package with the following function:
+
+    SV* sv_bless(SV* sv, HV* stash);
+
+The C<sv> argument must be a reference.  The C<stash> argument specifies
+which class the reference will belong to.  See the section on L<Stashes>
+for information on converting class names into stashes.
+
+/* Still under construction */
+
+Upgrades rv to reference if not already one.  Creates new SV for rv to
+point to.
+If classname is non-null, the SV is blessed into the specified class.
+SV is returned.
+
+	SV* newSVrv(SV* rv, char* classname);
+
+Copies integer or double into an SV whose reference is rv.  SV is blessed
+if classname is non-null.
+
+	SV* sv_setref_iv(SV* rv, char* classname, IV iv);
+	SV* sv_setref_nv(SV* rv, char* classname, NV iv);
+
+Copies pointer (I<not a string!>) into an SV whose reference is rv.
+SV is blessed if classname is non-null.
+
+	SV* sv_setref_pv(SV* rv, char* classname, PV iv);
+
+Copies string into an SV whose reference is rv.
+Set length to 0 to let Perl calculate the string length.
+SV is blessed if classname is non-null.
+
+	SV* sv_setref_pvn(SV* rv, char* classname, PV iv, int length);
+
+	int sv_isa(SV* sv, char* name);
+	int sv_isobject(SV* sv);
+
+=head1 Creating New Variables
+
+To create a new Perl variable, which can be accessed from your Perl script,
+use the following routines, depending on the variable type.
+
+    SV*  perl_get_sv("varname", TRUE);
+    AV*  perl_get_av("varname", TRUE);
+    HV*  perl_get_hv("varname", TRUE);
+
+Notice the use of TRUE as the second parameter.  The new variable can now
+be set, using the routines appropriate to the data type.
+
+There are additional bits that may be OR'ed with the TRUE argument to enable
+certain extra features.  Those bits are:
+
+    0x02  Marks the variable as multiply defined, thus preventing the
+	  "Indentifier <varname> used only once: possible typo" warning.
+    0x04  Issues a "Had to create <varname> unexpectedly" warning if
+	  the variable didn't actually exist.  This is useful if
+	  you expected the variable to already exist and want to propagate
+	  this warning back to the user.
+
+If the C<varname> argument does not contain a package specifier, it is
+created in the current package.
+
+=head1 XSUB's and the Argument Stack
+
+The XSUB mechanism is a simple way for Perl programs to access C subroutines.
+An XSUB routine will have a stack that contains the arguments from the Perl
+program, and a way to map from the Perl data structures to a C equivalent.
+
+The stack arguments are accessible through the C<ST(n)> macro, which returns
+the C<n>'th stack argument.  Argument 0 is the first argument passed in the
+Perl subroutine call.  These arguments are C<SV*>, and can be used anywhere
+an C<SV*> is used.
+
+Most of the time, output from the C routine can be handled through use of
+the RETVAL and OUTPUT directives.  However, there are some cases where the
+argument stack is not already long enough to handle all the return values.
+An example is the POSIX tzname() call, which takes no arguments, but returns
+two, the local timezone's standard and summer time abbreviations.
+
+To handle this situation, the PPCODE directive is used and the stack is
+extended using the macro:
+
+    EXTEND(sp, num);
+
+where C<sp> is the stack pointer, and C<num> is the number of elements the
+stack should be extended by.
+
+Now that there is room on the stack, values can be pushed on it using the
+macros to push IV's, doubles, strings, and SV pointers respectively:
+
+    PUSHi(IV)
+    PUSHn(double)
+    PUSHp(char*, I32)
+    PUSHs(SV*)
+
+And now the Perl program calling C<tzname>, the two values will be assigned
+as in:
+
+    ($standard_abbrev, $summer_abbrev) = POSIX::tzname;
+
+An alternate (and possibly simpler) method to pushing values on the stack is
+to use the macros:
+
+    XPUSHi(IV)
+    XPUSHn(double)
+    XPUSHp(char*, I32)
+    XPUSHs(SV*)
+
+These macros automatically adjust the stack for you, if needed.
+
+For more information, consult L<perlxs>.
+
+=head1 Mortality
+
+In Perl, values are normally "immortal" -- that is, they are not freed unless
+explicitly done so (via the Perl C<undef> call or other routines in Perl
+itself).
+
+Add cruft about reference counts.
+	int SvREFCNT(SV* sv);
+	void SvREFCNT_inc(SV* sv);
+	void SvREFCNT_dec(SV* sv);
+
+In the above example with C<tzname>, we needed to create two new SV's to push
+onto the argument stack, that being the two strings.  However, we don't want
+these new SV's to stick around forever because they will eventually be
+copied into the SV's that hold the two scalar variables.
+
+An SV (or AV or HV) that is "mortal" acts in all ways as a normal "immortal"
+SV, AV, or HV, but is only valid in the "current context".  When the Perl
+interpreter leaves the current context, the mortal SV, AV, or HV is
+automatically freed.  Generally the "current context" means a single
+Perl statement.
+
+To create a mortal variable, use the functions:
+
+    SV*  sv_newmortal()
+    SV*  sv_2mortal(SV*)
+    SV*  sv_mortalcopy(SV*)
+
+The first call creates a mortal SV, the second converts an existing SV to
+a mortal SV, the third creates a mortal copy of an existing SV.
+
+The mortal routines are not just for SV's -- AV's and HV's can be made mortal
+by passing their address (and casting them to C<SV*>) to the C<sv_2mortal> or
+C<sv_mortalcopy> routines.
+
+>From Ilya:
+Beware that the sv_2mortal() call is eventually equivalent to
+svREFCNT_dec(). A value can happily be mortal in two different contexts,
+and it will be svREFCNT_dec()ed twice, once on exit from these
+contexts. It can also be mortal twice in the same context. This means
+that you should be very careful to make a value mortal exactly as many
+times as it is needed. The value that go to the Perl stack I<should>
+be mortal.
+
+You should be careful about creating mortal variables.  It is possible for
+strange things to happen should you make the same value mortal within
+multiple contexts.
+
+=head1 Stashes
+
+A stash is a hash table (associative array) that contains all of the
+different objects that are contained within a package.  Each key of the
+stash is a symbol name (shared by all the different types of objects
+that have the same name), and each value in the hash table is called a
+GV (for Glob Value).  This GV in turn contains references to the various
+objects of that name, including (but not limited to) the following:
+
+    Scalar Value
+    Array Value
+    Hash Value
+    File Handle
+    Directory Handle
+    Format
+    Subroutine
+
+Perl stores various stashes in a separate GV structure (for global
+variable) but represents them with an HV structure.  The keys in this
+larger GV are the various package names; the values are the C<GV*>'s
+which are stashes.  It may help to think of a stash purely as an HV,
+and that the term "GV" means the global variable hash.
+
+To get the stash pointer for a particular package, use the function:
+
+    HV*  gv_stashpv(char* name, I32 create)
+    HV*  gv_stashsv(SV*, I32 create)
+
+The first function takes a literal string, the second uses the string stored
+in the SV.  Remember that a stash is just a hash table, so you get back an
+C<HV*>.  The C<create> flag will create a new package if it is set.
+
+The name that C<gv_stash*v> wants is the name of the package whose symbol table
+you want.  The default package is called C<main>.  If you have multiply nested
+packages, pass their names to C<gv_stash*v>, separated by C<::> as in the Perl
+language itself.
+
+Alternately, if you have an SV that is a blessed reference, you can find
+out the stash pointer by using:
+
+    HV*  SvSTASH(SvRV(SV*));
+
+then use the following to get the package name itself:
+
+    char*  HvNAME(HV* stash);
+
+If you need to return a blessed value to your Perl script, you can use the
+following function:
+
+    SV*  sv_bless(SV*, HV* stash)
+
+where the first argument, an C<SV*>, must be a reference, and the second
+argument is a stash.  The returned C<SV*> can now be used in the same way
+as any other SV.
+
+For more information on references and blessings, consult L<perlref>.
+
+=head1 Magic
+
+[This section still under construction.  Ignore everything here.  Post no
+bills.  Everything not permitted is forbidden.]
+
+# Version 6, 1995/1/27
+
+Any SV may be magical, that is, it has special features that a normal
+SV does not have.  These features are stored in the SV structure in a
+linked list of C<struct magic>'s, typedef'ed to C<MAGIC>.
+
+    struct magic {
+        MAGIC*      mg_moremagic;
+        MGVTBL*     mg_virtual;
+        U16         mg_private;
+        char        mg_type;
+        U8          mg_flags;
+        SV*         mg_obj;
+        char*       mg_ptr;
+        I32         mg_len;
+    };
+
+Note this is current as of patchlevel 0, and could change at any time.
+
+=head2 Assigning Magic
+
+Perl adds magic to an SV using the sv_magic function:
+
+    void sv_magic(SV* sv, SV* obj, int how, char* name, I32 namlen);
+
+The C<sv> argument is a pointer to the SV that is to acquire a new magical
+feature.
+
+If C<sv> is not already magical, Perl uses the C<SvUPGRADE> macro to
+set the C<SVt_PVMG> flag for the C<sv>.  Perl then continues by adding
+it to the beginning of the linked list of magical features.  Any prior
+entry of the same type of magic is deleted.  Note that this can be
+overriden, and multiple instances of the same type of magic can be
+associated with an SV.
+
+The C<name> and C<namlem> arguments are used to associate a string with
+the magic, typically the name of a variable. C<namlem> is stored in the
+C<mg_len> field and if C<name> is non-null and C<namlem> >= 0 a malloc'd
+copy of the name is stored in C<mg_ptr> field.
+
+The sv_magic function uses C<how> to determine which, if any, predefined
+"Magic Virtual Table" should be assigned to the C<mg_virtual> field.
+See the "Magic Virtual Table" section below.  The C<how> argument is also
+stored in the C<mg_type> field.
+
+The C<obj> argument is stored in the C<mg_obj> field of the C<MAGIC>
+structure.  If it is not the same as the C<sv> argument, the reference
+count of the C<obj> object is incremented.  If it is the same, or if
+the C<how> argument is "#", or if it is a null pointer, then C<obj> is
+merely stored, without the reference count being incremented.
+
+There is also a function to add magic to an C<HV>:
+
+    void hv_magic(HV *hv, GV *gv, int how);
+
+This simply calls C<sv_magic> and coerces the C<gv> argument into an C<SV>.
+
+To remove the magic from an SV, call the function sv_unmagic:
+
+    void sv_unmagic(SV *sv, int type);
+
+The C<type> argument should be equal to the C<how> value when the C<SV>
+was initially made magical.
+
+=head2 Magic Virtual Tables
+
+The C<mg_virtual> field in the C<MAGIC> structure is a pointer to a
+C<MGVTBL>, which is a structure of function pointers and stands for
+"Magic Virtual Table" to handle the various operations that might be
+applied to that variable.
+
+The C<MGVTBL> has five pointers to the following routine types:
+
+    int  (*svt_get)(SV* sv, MAGIC* mg);
+    int  (*svt_set)(SV* sv, MAGIC* mg);
+    U32  (*svt_len)(SV* sv, MAGIC* mg);
+    int  (*svt_clear)(SV* sv, MAGIC* mg);
+    int  (*svt_free)(SV* sv, MAGIC* mg);
+
+This MGVTBL structure is set at compile-time in C<perl.h> and there are
+currently 19 types (or 21 with overloading turned on).  These different
+structures contain pointers to various routines that perform additional
+actions depending on which function is being called.
+
+    Function pointer    Action taken
+    ----------------    ------------
+    svt_get             Do something after the value of the SV is retrieved.
+    svt_set             Do something after the SV is assigned a value.
+    svt_len             Report on the SV's length.
+    svt_clear		Clear something the SV represents.
+    svt_free            Free any extra storage associated with the SV.
+
+For instance, the MGVTBL structure called C<vtbl_sv> (which corresponds
+to an C<mg_type> of '\0') contains:
+
+    { magic_get, magic_set, magic_len, 0, 0 }
+
+Thus, when an SV is determined to be magical and of type '\0', if a get
+operation is being performed, the routine C<magic_get> is called.  All
+the various routines for the various magical types begin with C<magic_>.
+
+The current kinds of Magic Virtual Tables are:
+
+    mg_type  MGVTBL              Type of magicalness
+    -------  ------              -------------------
+    \0       vtbl_sv             Regexp???
+    A        vtbl_amagic         Operator Overloading
+    a        vtbl_amagicelem     Operator Overloading
+    c        0                   Used in Operator Overloading
+    B        vtbl_bm             Boyer-Moore???
+    E        vtbl_env            %ENV hash
+    e        vtbl_envelem        %ENV hash element
+    g        vtbl_mglob          Regexp /g flag???
+    I        vtbl_isa            @ISA array
+    i        vtbl_isaelem        @ISA array element
+    L        0 (but sets RMAGICAL)     Perl Module/Debugger???
+    l        vtbl_dbline         Debugger?
+    P        vtbl_pack           Tied Array or Hash
+    p        vtbl_packelem       Tied Array or Hash element
+    q        vtbl_packelem       Tied Scalar or Handle
+    S        vtbl_sig            Signal Hash
+    s        vtbl_sigelem        Signal Hash element
+    t        vtbl_taint          Taintedness
+    U        vtbl_uvar	         ???
+    v        vtbl_vec	         Vector
+    x        vtbl_substr         Substring???
+    *        vtbl_glob           GV???
+    #        vtbl_arylen         Array Length
+    .        vtbl_pos	         $. scalar variable
+    ~        Reserved for extensions, but multiple extensions may clash
+
+When an upper-case and lower-case letter both exist in the table, then the
+upper-case letter is used to represent some kind of composite type (a list
+or a hash), and the lower-case letter is used to represent an element of
+that composite type.
+
+=head2 Finding Magic
+
+    MAGIC* mg_find(SV*, int type); /* Finds the magic pointer of that type */
+
+This routine returns a pointer to the C<MAGIC> structure stored in the SV.
+If the SV does not have that magical feature, C<NULL> is returned.  Also,
+if the SV is not of type SVt_PVMG, Perl may core-dump.
+
+    int mg_copy(SV* sv, SV* nsv, char* key, STRLEN klen);
+
+This routine checks to see what types of magic C<sv> has.  If the mg_type
+field is an upper-case letter, then the mg_obj is copied to C<nsv>, but
+the mg_type field is changed to be the lower-case letter.
+
+=head1 Double-Typed SV's
+
+Scalar variables normally contain only one type of value, an integer,
+double, pointer, or reference.  Perl will automatically convert the
+actual scalar data from the stored type into the requested type.
+
+Some scalar variables contain more than one type of scalar data.  For
+example, the variable C<$!> contains either the numeric value of C<errno>
+or its string equivalent from either C<strerror> or C<sys_errlist[]>.
+
+To force multiple data values into an SV, you must do two things: use the
+C<sv_set*v> routines to add the additional scalar type, then set a flag
+so that Perl will believe it contains more than one type of data.  The
+four macros to set the flags are:
+
+	SvIOK_on
+	SvNOK_on
+	SvPOK_on
+	SvROK_on
+
+The particular macro you must use depends on which C<sv_set*v> routine
+you called first.  This is because every C<sv_set*v> routine turns on
+only the bit for the particular type of data being set, and turns off
+all the rest.
+
+For example, to create a new Perl variable called "dberror" that contains
+both the numeric and descriptive string error values, you could use the
+following code:
+
+    extern int  dberror;
+    extern char *dberror_list;
+
+    SV* sv = perl_get_sv("dberror", TRUE);
+    sv_setiv(sv, (IV) dberror);
+    sv_setpv(sv, dberror_list[dberror]);
+    SvIOK_on(sv);
+
+If the order of C<sv_setiv> and C<sv_setpv> had been reversed, then the
+macro C<SvPOK_on> would need to be called instead of C<SvIOK_on>.
+
+=head1 Calling Perl Routines from within C Programs
+
+There are four routines that can be used to call a Perl subroutine from
+within a C program.  These four are:
+
+    I32  perl_call_sv(SV*, I32);
+    I32  perl_call_pv(char*, I32);
+    I32  perl_call_method(char*, I32);
+    I32  perl_call_argv(char*, I32, register char**);
+
+The routine most often used is C<perl_call_sv>.  The C<SV*> argument
+contains either the name of the Perl subroutine to be called, or a
+reference to the subroutine.  The second argument consists of flags
+that control the context in which the subroutine is called, whether
+or not the subroutine is being passed arguments, how errors should be
+trapped, and how to treat return values.
+
+All four routines return the number of arguments that the subroutine returned
+on the Perl stack.
+
+When using any of these routines (except C<perl_call_argv>), the programmer
+must manipulate the Perl stack.  These include the following macros and
+functions:
+
+    dSP
+    PUSHMARK()
+    PUTBACK
+    SPAGAIN
+    ENTER
+    SAVETMPS
+    FREETMPS
+    LEAVE
+    XPUSH*()
+    POP*()
+
+For more information, consult L<perlcall>.
+
+=head1 Memory Allocation
+
+It is strongly suggested that you use the version of malloc that is distributed
+with Perl.  It keeps pools of various sizes of unallocated memory in order to
+more quickly satisfy allocation requests.
+However, on some platforms, it may cause spurious malloc or free errors.
+
+    New(x, pointer, number, type);
+    Newc(x, pointer, number, type, cast);
+    Newz(x, pointer, number, type);
+
+These three macros are used to initially allocate memory.  The first argument
+C<x> was a "magic cookie" that was used to keep track of who called the macro,
+to help when debugging memory problems.  However, the current code makes no
+use of this feature (Larry has switched to using a run-time memory checker),
+so this argument can be any number.
+
+The second argument C<pointer> will point to the newly allocated memory.
+The third and fourth arguments C<number> and C<type> specify how many of
+the specified type of data structure should be allocated.  The argument
+C<type> is passed to C<sizeof>.  The final argument to C<Newc>, C<cast>,
+should be used if the C<pointer> argument is different from the C<type>
+argument.
+
+Unlike the C<New> and C<Newc> macros, the C<Newz> macro calls C<memzero>
+to zero out all the newly allocated memory.
+
+    Renew(pointer, number, type);
+    Renewc(pointer, number, type, cast);
+    Safefree(pointer)
+
+These three macros are used to change a memory buffer size or to free a
+piece of memory no longer needed.  The arguments to C<Renew> and C<Renewc>
+match those of C<New> and C<Newc> with the exception of not needing the
+"magic cookie" argument.
+
+    Move(source, dest, number, type);
+    Copy(source, dest, number, type);
+    Zero(dest, number, type);
+
+These three macros are used to move, copy, or zero out previously allocated
+memory.  The C<source> and C<dest> arguments point to the source and
+destination starting points.  Perl will move, copy, or zero out C<number>
+instances of the size of the C<type> data structure (using the C<sizeof>
+function).
+
+=head1 API LISTING
+
+This is a listing of functions, macros, flags, and variables that may be
+useful to extension writers or that may be found while reading other
+extensions.
+
+=over 8
+
+=item AvFILL
+
+See C<av_len>.
+
+=item av_clear
+
+Clears an array, making it empty.
+
+	void	av_clear _((AV* ar));
+
+=item av_extend
+
+Pre-extend an array.  The C<key> is the index to which the array should be
+extended.
+
+	void	av_extend _((AV* ar, I32 key));
+
+=item av_fetch
+
+Returns the SV at the specified index in the array.  The C<key> is the
+index.  If C<lval> is set then the fetch will be part of a store.  Check
+that the return value is non-null before dereferencing it to a C<SV*>.
+
+	SV**	av_fetch _((AV* ar, I32 key, I32 lval));
+
+=item av_len
+
+Returns the highest index in the array.  Returns -1 if the array is empty.
+
+	I32	av_len _((AV* ar));
+
+=item av_make
+
+Creats a new AV and populates it with a list of SVs.  The SVs are copied
+into the array, so they may be freed after the call to av_make.
+
+	AV*	av_make _((I32 size, SV** svp));
+
+=item av_pop
+
+Pops an SV off the end of the array.  Returns C<&sv_undef> if the array is
+empty.
+
+	SV*	av_pop _((AV* ar));
+
+=item av_push
+
+Pushes an SV onto the end of the array.
+
+	void	av_push _((AV* ar, SV* val));
+
+=item av_shift
+
+Shifts an SV off the beginning of the array.
+
+	SV*	av_shift _((AV* ar));
+
+=item av_store
+
+Stores an SV in an array.  The array index is specified as C<key>.  The
+return value will be null if the operation failed, otherwise it can be
+dereferenced to get the original C<SV*>.
+
+	SV**	av_store _((AV* ar, I32 key, SV* val));
+
+=item av_undef
+
+Undefines the array.
+
+	void	av_undef _((AV* ar));
+
+=item av_unshift
+
+Unshift an SV onto the beginning of the array.
+
+	void	av_unshift _((AV* ar, I32 num));
+
+=item CLASS
+
+Variable which is setup by C<xsubpp> to indicate the class name for a C++ XS
+constructor.  This is always a C<char*>.  See C<THIS> and L<perlxs>.
+
+=item Copy
+
+The XSUB-writer's interface to the C C<memcpy> function.  The C<s> is the
+source, C<d> is the destination, C<n> is the number of items, and C<t> is
+the type.
+
+	(void) Copy( s, d, n, t );
+
+=item croak
+
+This is the XSUB-writer's interface to Perl's C<die> function.  Use this
+function the same way you use the C C<printf> function.  See C<warn>.
+
+=item CvSTASH
+
+Returns the stash of the CV.
+
+	HV * CvSTASH( SV* sv )
+
+=item DBsingle
+
+When Perl is run in debugging mode, with the B<-d> switch, this SV is a
+boolean which indicates whether subs are being single-stepped.
+Single-stepping is automatically turned on after every step.  See C<DBsub>.
+
+=item DBsub
+
+When Perl is run in debugging mode, with the B<-d> switch, this GV contains
+the SV which holds the name of the sub being debugged.  See C<DBsingle>.
+The sub name can be found by
+
+	SvPV( GvSV( DBsub ), na )
+
+=item dMARK
+
+Declare a stack marker for the XSUB.  See C<MARK> and C<dORIGMARK>.
+
+=item dORIGMARK
+
+Saves the original stack mark for the XSUB.  See C<ORIGMARK>.
+
+=item dSP
+
+Declares a stack pointer for the XSUB.  See C<SP>.
+
+=item dXSARGS
+
+Sets up stack and mark pointers for an XSUB, calling dSP and dMARK.  This is
+usually handled automatically by C<xsubpp>.  Declares the C<items> variable
+to indicate the number of items on the stack.
+
+=item ENTER
+
+Opening bracket on a callback.  See C<LEAVE> and L<perlcall>.
+
+	ENTER;
+
+=item EXTEND
+
+Used to extend the argument stack for an XSUB's return values.
+
+	EXTEND( sp, int x );
+
+=item FREETMPS
+
+Closing bracket for temporaries on a callback.  See C<SAVETMPS> and
+L<perlcall>.
+
+	FREETMPS;
+
+=item G_ARRAY
+
+Used to indicate array context.  See C<GIMME> and L<perlcall>.
+
+=item G_DISCARD
+
+Indicates that arguments returned from a callback should be discarded.  See
+L<perlcall>.
+
+=item G_EVAL
+
+Used to force a Perl C<eval> wrapper around a callback.  See L<perlcall>.
+
+=item GIMME
+
+The XSUB-writer's equivalent to Perl's C<wantarray>.  Returns C<G_SCALAR> or
+C<G_ARRAY> for scalar or array context.
+
+=item G_NOARGS
+
+Indicates that no arguments are being sent to a callback.  See L<perlcall>.
+
+=item G_SCALAR
+
+Used to indicate scalar context.  See C<GIMME> and L<perlcall>.
+
+=item gv_stashpv
+
+Returns a pointer to the stash for a specified package.  If C<create> is set
+then the package will be created if it does not already exist.  If C<create>
+is not set and the package does not exist then NULL is returned.
+
+	HV*	gv_stashpv _((char* name, I32 create));
+
+=item gv_stashsv
+
+Returns a pointer to the stash for a specified package.  See C<gv_stashpv>.
+
+	HV*	gv_stashsv _((SV* sv, I32 create));
+
+=item GvSV
+
+Return the SV from the GV.
+
+=item he_free
+
+Releases a hash entry from an iterator.  See C<hv_iternext>.
+
+=item hv_clear
+
+Clears a hash, making it empty.
+
+	void	hv_clear _((HV* tb));
+
+=item hv_delete
+
+Deletes a key/value pair in the hash.  The value SV is removed from the hash
+and returned to the caller.  The C<lken> is the length of the key.  The
+C<flags> value will normally be zero; if set to G_DISCARD then null will be
+returned.
+
+	SV*	hv_delete _((HV* tb, char* key, U32 klen, I32 flags));
+
+=item hv_exists
+
+Returns a boolean indicating whether the specified hash key exists.  The
+C<lken> is the length of the key.
+
+	bool	hv_exists _((HV* tb, char* key, U32 klen));
+
+=item hv_fetch
+
+Returns the SV which corresponds to the specified key in the hash.  The
+C<lken> is the length of the key.  If C<lval> is set then the fetch will be
+part of a store.  Check that the return value is non-null before
+dereferencing it to a C<SV*>.
+
+	SV**	hv_fetch _((HV* tb, char* key, U32 klen, I32 lval));
+
+=item hv_iterinit
+
+Prepares a starting point to traverse a hash table.
+
+	I32	hv_iterinit _((HV* tb));
+
+=item hv_iterkey
+
+Returns the key from the current position of the hash iterator.  See
+C<hv_iterinit>.
+
+	char*	hv_iterkey _((HE* entry, I32* retlen));
+
+=item hv_iternext
+
+Returns entries from a hash iterator.  See C<hv_iterinit>.
+
+	HE*	hv_iternext _((HV* tb));
+
+=item hv_iternextsv
+
+Performs an C<hv_iternext>, C<hv_iterkey>, and C<hv_iterval> in one
+operation.
+
+	SV *	hv_iternextsv _((HV* hv, char** key, I32* retlen));
+
+=item hv_iterval
+
+Returns the value from the current position of the hash iterator.  See
+C<hv_iterkey>.
+
+	SV*	hv_iterval _((HV* tb, HE* entry));
+
+=item hv_magic
+
+Adds magic to a hash.  See C<sv_magic>.
+
+	void	hv_magic _((HV* hv, GV* gv, int how));
+
+=item HvNAME
+
+Returns the package name of a stash.  See C<SvSTASH>, C<CvSTASH>.
+
+	char *HvNAME (HV* stash)
+
+=item hv_store
+
+Stores an SV in a hash.  The hash key is specified as C<key> and C<klen> is
+the length of the key.  The C<hash> parameter is the pre-computed hash
+value; if it is zero then Perl will compute it.  The return value will be
+null if the operation failed, otherwise it can be dereferenced to get the
+original C<SV*>.
+
+	SV**	hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
+
+=item hv_undef
+
+Undefines the hash.
+
+	void	hv_undef _((HV* tb));
+
+=item isALNUM
+
+Returns a boolean indicating whether the C C<char> is an ascii alphanumeric
+character or digit.
+
+	int isALNUM (char c)
+
+=item isALPHA
+
+Returns a boolean indicating whether the C C<char> is an ascii alphanumeric
+character.
+
+	int isALPHA (char c)
+
+=item isDIGIT
+
+Returns a boolean indicating whether the C C<char> is an ascii digit.
+
+	int isDIGIT (char c)
+
+=item isLOWER
+
+Returns a boolean indicating whether the C C<char> is a lowercase character.
+
+	int isLOWER (char c)
+
+=item isSPACE
+
+Returns a boolean indicating whether the C C<char> is whitespace.
+
+	int isSPACE (char c)
+
+=item isUPPER
+
+Returns a boolean indicating whether the C C<char> is an uppercase character.
+
+	int isUPPER (char c)
+
+=item items
+
+Variable which is setup by C<xsubpp> to indicate the number of items on the
+stack.  See L<perlxs>.
+
+=item LEAVE
+
+Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
+
+	LEAVE;
+
+=item MARK
+
+Stack marker for the XSUB.  See C<dMARK>.
+
+=item mg_clear
+
+Clear something magical that the SV represents.  See C<sv_magic>.
+
+	int	mg_clear _((SV* sv));
+
+=item mg_copy
+
+Copies the magic from one SV to another.  See C<sv_magic>.
+
+	int	mg_copy _((SV *, SV *, char *, STRLEN));
+
+=item mg_find
+
+Finds the magic pointer for type matching the SV.  See C<sv_magic>.
+
+	MAGIC*	mg_find _((SV* sv, int type));
+
+=item mg_free
+
+Free any magic storage used by the SV.  See C<sv_magic>.
+
+	int	mg_free _((SV* sv));
+
+=item mg_get
+
+Do magic after a value is retrieved from the SV.  See C<sv_magic>.
+
+	int	mg_get _((SV* sv));
+
+=item mg_len
+
+Report on the SV's length.  See C<sv_magic>.
+
+	U32	mg_len _((SV* sv));
+
+=item mg_magical
+
+Turns on the magical status of an SV.  See C<sv_magic>.
+
+	void	mg_magical _((SV* sv));
+
+=item mg_set
+
+Do magic after a value is assigned to the SV.  See C<sv_magic>.
+
+	int	mg_set _((SV* sv));
+
+=item Move
+
+The XSUB-writer's interface to the C C<memmove> function.  The C<s> is the
+source, C<d> is the destination, C<n> is the number of items, and C<t> is
+the type.
+
+	(void) Move( s, d, n, t );
+
+=item na
+
+A variable which may be used with C<SvPV> to tell Perl to calculate the
+string length.
+
+=item New
+
+The XSUB-writer's interface to the C C<malloc> function.
+
+	void * New( x, void *ptr, int size, type )
+
+=item Newc
+
+The XSUB-writer's interface to the C C<malloc> function, with cast.
+
+	void * Newc( x, void *ptr, int size, type, cast )
+
+=item Newz
+
+The XSUB-writer's interface to the C C<malloc> function.  The allocated
+memory is zeroed with C<memzero>.
+
+	void * Newz( x, void *ptr, int size, type )
+
+=item newAV
+
+Creates a new AV.  The refcount is set to 1.
+
+	AV*	newAV _((void));
+
+=item newHV
+
+Creates a new HV.  The refcount is set to 1.
+
+	HV*	newHV _((void));
+
+=item newRV
+
+Creates an RV wrapper for an SV.  The refcount for the original SV is
+incremented.
+
+	SV*	newRV _((SV* ref));
+
+=item newSV
+
+Creates a new SV.  The C<len> parameter indicates the number of bytes of
+pre-allocated string space the SV should have.  The refcount for the new SV
+is set to 1.
+
+	SV*	newSV _((STRLEN len));
+
+=item newSViv
+
+Creates a new SV and copies an integer into it.  The refcount for the SV is
+set to 1.
+
+	SV*	newSViv _((IV i));
+
+=item newSVnv
+
+Creates a new SV and copies a double into it.  The refcount for the SV is
+set to 1.
+
+	SV*	newSVnv _((NV i));
+
+=item newSVpv
+
+Creates a new SV and copies a string into it.  The refcount for the SV is
+set to 1.  If C<len> is zero then Perl will compute the length.
+
+	SV*	newSVpv _((char* s, STRLEN len));
+
+=item newSVrv
+
+Creates a new SV for the RV, C<rv>, to point to.  If C<rv> is not an RV then
+it will be upgraded one.  If C<classname> is non-null then the new SV will
+be blessed in the specified package.  The new SV is returned and its
+refcount is 1.
+
+	SV*	newSVrv _((SV* rv, char* classname));
+
+=item newSVsv
+
+Creates a new SV which is an exact duplicate of the orignal SV.
+
+	SV*	newSVsv _((SV* old));
+
+=item newXS
+
+Used by C<xsubpp> to hook up XSUBs as Perl subs.
+
+=item newXSproto
+
+Used by C<xsubpp> to hook up XSUBs as Perl subs.  Adds Perl prototypes to
+the subs.
+
+=item Nullav
+
+Null AV pointer.
+
+=item Nullch
+
+Null character pointer.
+
+=item Nullcv
+
+Null CV pointer.
+
+=item Nullhv
+
+Null HV pointer.
+
+=item Nullsv
+
+Null SV pointer.
+
+=item ORIGMARK
+
+The original stack mark for the XSUB.  See C<dORIGMARK>.
+
+=item perl_alloc
+
+Allocates a new Perl interpreter.  See L<perlembed>.
+
+=item perl_call_argv
+
+Performs a callback to the specified Perl sub.  See L<perlcall>.
+
+	I32	perl_call_argv _((char* subname, I32 flags, char** argv));
+
+=item perl_call_method
+
+Performs a callback to the specified Perl method.  The blessed object must
+be on the stack.  See L<perlcall>.
+
+	I32	perl_call_method _((char* methname, I32 flags));
+
+=item perl_call_pv
+
+Performs a callback to the specified Perl sub.  See L<perlcall>.
+
+	I32	perl_call_pv _((char* subname, I32 flags));
+
+=item perl_call_sv
+
+Performs a callback to the Perl sub whose name is in the SV.  See
+L<perlcall>.
+
+	I32	perl_call_sv _((SV* sv, I32 flags));
+
+=item perl_construct
+
+Initializes a new Perl interpreter.  See L<perlembed>.
+
+=item perl_destruct
+
+Shuts down a Perl interpreter.  See L<perlembed>.
+
+=item perl_eval_sv
+
+Tells Perl to C<eval> the string in the SV.
+
+	I32	perl_eval_sv _((SV* sv, I32 flags));
+
+=item perl_free
+
+Releases a Perl interpreter.  See L<perlembed>.
+
+=item perl_get_av
+
+Returns the AV of the specified Perl array.  If C<create> is set and the
+Perl variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then null is returned.
+
+	AV*	perl_get_av _((char* name, I32 create));
+
+=item perl_get_cv
+
+Returns the CV of the specified Perl sub.  If C<create> is set and the Perl
+variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then null is returned.
+
+	CV*	perl_get_cv _((char* name, I32 create));
+
+=item perl_get_hv
+
+Returns the HV of the specified Perl hash.  If C<create> is set and the Perl
+variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then null is returned.
+
+	HV*	perl_get_hv _((char* name, I32 create));
+
+=item perl_get_sv
+
+Returns the SV of the specified Perl scalar.  If C<create> is set and the
+Perl variable does not exist then it will be created.  If C<create> is not
+set and the variable does not exist then null is returned.
+
+	SV*	perl_get_sv _((char* name, I32 create));
+
+=item perl_parse
+
+Tells a Perl interpreter to parse a Perl script.  See L<perlembed>.
+
+=item perl_require_pv
+
+Tells Perl to C<require> a module.
+
+	void	perl_require_pv _((char* pv));
+
+=item perl_run
+
+Tells a Perl interpreter to run.  See L<perlembed>.
+
+=item POPi
+
+Pops an integer off the stack.
+
+	int POPi();
+
+=item POPl
+
+Pops a long off the stack.
+
+	long POPl();
+
+=item POPp
+
+Pops a string off the stack.
+
+	char * POPp();
+
+=item POPn
+
+Pops a double off the stack.
+
+	double POPn();
+
+=item POPs
+
+Pops an SV off the stack.
+
+	SV* POPs();
+
+=item PUSHMARK
+
+Opening bracket for arguments on a callback.  See C<PUTBACK> and L<perlcall>.
+
+	PUSHMARK(p)
+
+=item PUSHi
+
+Push an integer onto the stack.  The stack must have room for this element.
+See C<XPUSHi>.
+
+	PUSHi(int d)
+
+=item PUSHn
+
+Push a double onto the stack.  The stack must have room for this element.
+See C<XPUSHn>.
+
+	PUSHn(double d)
+
+=item PUSHp
+
+Push a string onto the stack.  The stack must have room for this element.
+The C<len> indicates the length of the string.  See C<XPUSHp>.
+
+	PUSHp(char *c, int len )
+
+=item PUSHs
+
+Push an SV onto the stack.  The stack must have room for this element.  See
+C<XPUSHs>.
+
+	PUSHs(sv)
+
+=item PUTBACK
+
+Closing bracket for XSUB arguments.  This is usually handled by C<xsubpp>.
+See C<PUSHMARK> and L<perlcall> for other uses.
+
+	PUTBACK;
+
+=item Renew
+
+The XSUB-writer's interface to the C C<realloc> function.
+
+	void * Renew( void *ptr, int size, type )
+
+=item Renewc
+
+The XSUB-writer's interface to the C C<realloc> function, with cast.
+
+	void * Renewc( void *ptr, int size, type, cast )
+
+=item RETVAL
+
+Variable which is setup by C<xsubpp> to hold the return value for an XSUB.
+This is always the proper type for the XSUB.  See L<perlxs>.
+
+=item safefree
+
+The XSUB-writer's interface to the C C<free> function.
+
+=item safemalloc
+
+The XSUB-writer's interface to the C C<malloc> function.
+
+=item saferealloc
+
+The XSUB-writer's interface to the C C<realloc> function.
+
+=item savepv
+
+Copy a string to a safe spot.  This does not use an SV.
+
+	char*	savepv _((char* sv));
+
+=item savepvn
+
+Copy a string to a safe spot.  The C<len> indicates number of bytes to
+copy.  This does not use an SV.
+
+	char*	savepvn _((char* sv, I32 len));
+
+=item SAVETMPS
+
+Opening bracket for temporaries on a callback.  See C<FREETMPS> and
+L<perlcall>.
+
+	SAVETMPS;
+
+=item SP
+
+Stack pointer.  This is usually handled by C<xsubpp>.  See C<dSP> and
+C<SPAGAIN>.
+
+=item SPAGAIN
+
+Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
+
+	SPAGAIN;
+
+=item ST
+
+Used to access elements on the XSUB's stack.
+
+	SV* ST(int x)
+
+=item strEQ
+
+Test two strings to see if they are equal.  Returns true or false.
+
+	int strEQ( char *s1, char *s2 )
+
+=item strGE
+
+Test two strings to see if the first, C<s1>, is greater than or equal to the
+second, C<s2>.  Returns true or false.
+
+	int strGE( char *s1, char *s2 )
+
+=item strGT
+
+Test two strings to see if the first, C<s1>, is greater than the second,
+C<s2>.  Returns true or false.
+
+	int strGT( char *s1, char *s2 )
+
+=item strLE
+
+Test two strings to see if the first, C<s1>, is less than or equal to the
+second, C<s2>.  Returns true or false.
+
+	int strLE( char *s1, char *s2 )
+
+=item strLT
+
+Test two strings to see if the first, C<s1>, is less than the second,
+C<s2>.  Returns true or false.
+
+	int strLT( char *s1, char *s2 )
+
+=item strNE
+
+Test two strings to see if they are different.  Returns true or false.
+
+	int strNE( char *s1, char *s2 )
+
+=item strnEQ
+
+Test two strings to see if they are equal.  The C<len> parameter indicates
+the number of bytes to compare.  Returns true or false.
+
+	int strnEQ( char *s1, char *s2 )
+
+=item strnNE
+
+Test two strings to see if they are different.  The C<len> parameter
+indicates the number of bytes to compare.  Returns true or false.
+
+	int strnNE( char *s1, char *s2, int len )
+
+=item sv_2mortal
+
+Marks an SV as mortal.  The SV will be destroyed when the current context
+ends.
+
+	SV*	sv_2mortal _((SV* sv));
+
+=item sv_bless
+
+Blesses an SV into a specified package.  The SV must be an RV.  The package
+must be designated by its stash (see C<gv_stashpv()>).  The refcount of the
+SV is unaffected.
+
+	SV*	sv_bless _((SV* sv, HV* stash));
+
+=item sv_catpv
+
+Concatenates the string onto the end of the string which is in the SV.
+
+	void	sv_catpv _((SV* sv, char* ptr));
+
+=item sv_catpvn
+
+Concatenates the string onto the end of the string which is in the SV.  The
+C<len> indicates number of bytes to copy.
+
+	void	sv_catpvn _((SV* sv, char* ptr, STRLEN len));
+
+=item sv_catsv
+
+Concatentates the string from SV C<ssv> onto the end of the string in SV
+C<dsv>.
+
+	void	sv_catsv _((SV* dsv, SV* ssv));
+
+=item SvCUR
+
+Returns the length of the string which is in the SV.  See C<SvLEN>.
+
+	int SvCUR (SV* sv)
+
+=item SvCUR_set
+
+Set the length of the string which is in the SV.  See C<SvCUR>.
+
+	SvCUR_set (SV* sv, int val )
+
+=item SvEND
+
+Returns a pointer to the last character in the string which is in the SV.
+See C<SvCUR>.  Access the character as
+
+	*SvEND(sv)
+
+=item SvGROW
+
+Expands the character buffer in the SV.
+
+	char * SvGROW( SV* sv, int len )
+
+=item SvIOK
+
+Returns a boolean indicating whether the SV contains an integer.
+
+	int SvIOK (SV* SV)
+
+=item SvIOK_off
+
+Unsets the IV status of an SV.
+
+	SvIOK_off (SV* sv)
+
+=item SvIOK_on
+
+Tells an SV that it is an integer.
+
+	SvIOK_on (SV* sv)
+
+=item SvIOKp
+
+Returns a boolean indicating whether the SV contains an integer.  Checks the
+B<private> setting.  Use C<SvIOK>.
+
+	int SvIOKp (SV* SV)
+
+=item sv_isa
+
+Returns a boolean indicating whether the SV is blessed into the specified
+class.  This does not know how to check for subtype, so it doesn't work in
+an inheritance relationship.
+
+	int	sv_isa _((SV* sv, char* name));
+
+=item SvIV
+
+Returns the integer which is in the SV.
+
+	int SvIV (SV* sv)
+
+=item sv_isobject
+
+Returns a boolean indicating whether the SV is an RV pointing to a blessed
+object.  If the SV is not an RV, or if the object is not blessed, then this
+will return false.
+
+	int	sv_isobject _((SV* sv));
+
+=item SvIVX
+
+Returns the integer which is stored in the SV.
+
+	int  SvIVX (SV* sv);
+
+=item SvLEN
+
+Returns the size of the string buffer in the SV.  See C<SvCUR>.
+
+	int SvLEN (SV* sv)
+
+=item sv_magic
+
+Adds magic to an SV.
+
+	void	sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen));
+
+=item sv_mortalcopy
+
+Creates a new SV which is a copy of the original SV.  The new SV is marked
+as mortal.
+
+	SV*	sv_mortalcopy _((SV* oldsv));
+
+=item SvOK
+
+Returns a boolean indicating whether the value is an SV.
+
+	int SvOK (SV* sv)
+
+=item sv_newmortal
+
+Creates a new SV which is mortal.  The refcount of the SV is set to 1.
+
+	SV*	sv_newmortal _((void));
+
+=item sv_no
+
+This is the C<false> SV.  See C<sv_yes>.  Always refer to this as C<&sv_no>.
+
+=item SvNIOK
+
+Returns a boolean indicating whether the SV contains a number, integer or
+double.
+
+	int SvNIOK (SV* SV)
+
+=item SvNIOK_off
+
+Unsets the NV/IV status of an SV.
+
+	SvNIOK_off (SV* sv)
+
+=item SvNIOKp
+
+Returns a boolean indicating whether the SV contains a number, integer or
+double.  Checks the B<private> setting.  Use C<SvNIOK>.
+
+	int SvNIOKp (SV* SV)
+
+=item SvNOK
+
+Returns a boolean indicating whether the SV contains a double.
+
+	int SvNOK (SV* SV)
+
+=item SvNOK_off
+
+Unsets the NV status of an SV.
+
+	SvNOK_off (SV* sv)
+
+=item SvNOK_on
+
+Tells an SV that it is a double.
+
+	SvNOK_on (SV* sv)
+
+=item SvNOKp
+
+Returns a boolean indicating whether the SV contains a double.  Checks the
+B<private> setting.  Use C<SvNOK>.
+
+	int SvNOKp (SV* SV)
+
+=item SvNV
+
+Returns the double which is stored in the SV.
+
+	double SvNV (SV* sv);
+
+=item SvNVX
+
+Returns the double which is stored in the SV.
+
+	double SvNVX (SV* sv);
+
+=item SvPOK
+
+Returns a boolean indicating whether the SV contains a character string.
+
+	int SvPOK (SV* SV)
+
+=item SvPOK_off
+
+Unsets the PV status of an SV.
+
+	SvPOK_off (SV* sv)
+
+=item SvPOK_on
+
+Tells an SV that it is a string.
+
+	SvPOK_on (SV* sv)
+
+=item SvPOKp
+
+Returns a boolean indicating whether the SV contains a character string.
+Checks the B<private> setting.  Use C<SvPOK>.
+
+	int SvPOKp (SV* SV)
+
+=item SvPV
+
+Returns a pointer to the string in the SV, or a stringified form of the SV
+if the SV does not contain a string.  If C<len> is C<na> then Perl will
+handle the length on its own.
+
+	char * SvPV (SV* sv, int len )
+
+=item SvPVX
+
+Returns a pointer to the string in the SV.  The SV must contain a string.
+
+	char * SvPVX (SV* sv)
+
+=item SvREFCNT
+
+Returns the value of the object's refcount.
+
+	int SvREFCNT (SV* sv);
+
+=item SvREFCNT_dec
+
+Decrements the refcount of the given SV.
+
+	void SvREFCNT_dec (SV* sv)
+
+=item SvREFCNT_inc
+
+Increments the refcount of the given SV.
+
+	void SvREFCNT_inc (SV* sv)
+
+=item SvROK
+
+Tests if the SV is an RV.
+
+	int SvROK (SV* sv)
+
+=item SvROK_off
+
+Unsets the RV status of an SV.
+
+	SvROK_off (SV* sv)
+
+=item SvROK_on
+
+Tells an SV that it is an RV.
+
+	SvROK_on (SV* sv)
+
+=item SvRV
+
+Dereferences an RV to return the SV.
+
+	SV*	SvRV (SV* sv);
+
+=item sv_setiv
+
+Copies an integer into the given SV.
+
+	void	sv_setiv _((SV* sv, IV num));
+
+=item sv_setnv
+
+Copies a double into the given SV.
+
+	void	sv_setnv _((SV* sv, double num));
+
+=item sv_setpv
+
+Copies a string into an SV.  The string must be null-terminated.
+
+	void	sv_setpv _((SV* sv, char* ptr));
+
+=item sv_setpvn
+
+Copies a string into an SV.  The C<len> parameter indicates the number of
+bytes to be copied.
+
+	void	sv_setpvn _((SV* sv, char* ptr, STRLEN len));
+
+=item sv_setref_iv
+
+Copies an integer into an SV, optionally blessing the SV.  The SV must be an
+RV.  The C<classname> argument indicates the package for the blessing.  Set
+C<classname> to C<Nullch> to avoid the blessing.  The new SV will be
+returned and will have a refcount of 1.
+
+	SV*	sv_setref_iv _((SV *rv, char *classname, IV iv));
+
+=item sv_setref_nv
+
+Copies a double into an SV, optionally blessing the SV.  The SV must be an
+RV.  The C<classname> argument indicates the package for the blessing.  Set
+C<classname> to C<Nullch> to avoid the blessing.  The new SV will be
+returned and will have a refcount of 1.
+
+	SV*	sv_setref_nv _((SV *rv, char *classname, double nv));
+
+=item sv_setref_pv
+
+Copies a pointer into an SV, optionally blessing the SV.  The SV must be an
+RV.  If the C<pv> argument is NULL then C<sv_undef> will be placed into the
+SV.  The C<classname> argument indicates the package for the blessing.  Set
+C<classname> to C<Nullch> to avoid the blessing.  The new SV will be
+returned and will have a refcount of 1.
+
+	SV*	sv_setref_pv _((SV *rv, char *classname, void* pv));
+
+Do not use with integral Perl types such as HV, AV, SV, CV, because those
+objects will become corrupted by the pointer copy process.
+
+Note that C<sv_setref_pvn> copies the string while this copies the pointer.
+
+=item sv_setref_pvn
+
+Copies a string into an SV, optionally blessing the SV.  The lenth of the
+string must be specified with C<n>.  The SV must be an RV.  The C<classname>
+argument indicates the package for the blessing.  Set C<classname> to
+C<Nullch> to avoid the blessing.  The new SV will be returned and will have
+a refcount of 1.
+
+	SV*	sv_setref_pvn _((SV *rv, char *classname, char* pv, I32 n));
+
+Note that C<sv_setref_pv> copies the pointer while this copies the string.
+
+=item sv_setsv
+
+Copies the contents of the source SV C<ssv> into the destination SV C<dsv>.
+(B<NOTE:> If C<ssv> has the C<SVs_TEMP> bit set, C<sv_setsv> may simply steal
+the string from C<ssv> and give it to C<dsv>, leaving C<ssv> empty.
+Caveat caller.)
+
+	void	sv_setsv _((SV* dsv, SV* ssv));
+
+=item SvSTASH
+
+Returns the stash of the SV.
+
+	HV * SvSTASH (SV* sv)
+
+=item SVt_IV
+
+Integer type flag for scalars.  See C<svtype>.
+
+=item SVt_PV
+
+Pointer type flag for scalars.  See C<svtype>.
+
+=item SVt_PVAV
+
+Type flag for arrays.  See C<svtype>.
+
+=item SVt_PVCV
+
+Type flag for code refs.  See C<svtype>.
+
+=item SVt_PVHV
+
+Type flag for hashes.  See C<svtype>.
+
+=item SVt_PVMG
+
+Type flag for blessed scalars.  See C<svtype>.
+
+=item SVt_NV
+
+Double type flag for scalars.  See C<svtype>.
+
+=item SvTRUE
+
+Returns a boolean indicating whether Perl would evaluate the SV as true or
+false, defined or undefined.
+
+	int SvTRUE (SV* sv)
+
+=item SvTYPE
+
+Returns the type of the SV.  See C<svtype>.
+
+	svtype	SvTYPE (SV* sv)
+
+=item svtype
+
+An enum of flags for Perl types.  These are found in the file B<sv.h> in the
+C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
+
+=item SvUPGRADE
+
+Used to upgrade an SV to a more complex form.  See C<svtype>.
+
+=item sv_undef
+
+This is the C<undef> SV.  Always refer to this as C<&sv_undef>.
+
+=item sv_usepvn
+
+Tells an SV to use C<ptr> to find its string value.  Normally the string is
+stored inside the SV; this allows the SV to use an outside string.  The
+string length, C<len>, must be supplied.  This function will realloc the
+memory pointed to by C<ptr>, so that pointer should not be freed or used by
+the programmer after giving it to sv_usepvn.
+
+	void	sv_usepvn _((SV* sv, char* ptr, STRLEN len));
+
+=item sv_yes
+
+This is the C<true> SV.  See C<sv_no>.  Always refer to this as C<&sv_yes>.
+
+=item THIS
+
+Variable which is setup by C<xsubpp> to designate the object in a C++ XSUB.
+This is always the proper type for the C++ object.  See C<CLASS> and
+L<perlxs>.
+
+=item toLOWER
+
+Converts the specified character to lowercase.
+
+	int toLOWER (char c)
+
+=item toUPPER
+
+Converts the specified character to uppercase.
+
+	int toUPPER (char c)
+
+=item warn
+
+This is the XSUB-writer's interface to Perl's C<warn> function.  Use this
+function the same way you use the C C<printf> function.  See C<croak()>.
+
+=item XPUSHi
+
+Push an integer onto the stack, extending the stack if necessary.  See
+C<PUSHi>.
+
+	XPUSHi(int d)
+
+=item XPUSHn
+
+Push a double onto the stack, extending the stack if necessary.  See
+C<PUSHn>.
+
+	XPUSHn(double d)
+
+=item XPUSHp
+
+Push a string onto the stack, extending the stack if necessary.  The C<len>
+indicates the length of the string.  See C<PUSHp>.
+
+	XPUSHp(char *c, int len)
+
+=item XPUSHs
+
+Push an SV onto the stack, extending the stack if necessary.  See C<PUSHs>.
+
+	XPUSHs(sv)
+
+=item XSRETURN
+
+Return from XSUB, indicating number of items on the stack.  This is usually
+handled by C<xsubpp>.
+
+	XSRETURN(x);
+
+=item XSRETURN_EMPTY
+
+Return from an XSUB immediately.
+
+	XSRETURN_EMPTY;
+
+=item XSRETURN_NO
+
+Return C<false> from an XSUB immediately.
+
+	XSRETURN_NO;
+
+=item XSRETURN_UNDEF
+
+Return C<undef> from an XSUB immediately.
+
+	XSRETURN_UNDEF;
+
+=item XSRETURN_YES
+
+Return C<true> from an XSUB immediately.
+
+	XSRETURN_YES;
+
+=item Zero
+
+The XSUB-writer's interface to the C C<memzero> function.  The C<d> is the
+destination, C<n> is the number of items, and C<t> is the type.
+
+	(void) Zero( d, n, t );
+
+=back
+
+=head1 AUTHOR
+
+Jeff Okamoto <okamoto@corp.hp.com>
+
+With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
+Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
+Bowers, Matthew Green, Tim Bunce, and Spider Boardman.
+
+API Listing by Dean Roehrich <roehrich@cray.com>.
+
+=head1 DATE
+
+Version 20: 1995/12/14
+
diff --git a/gnu/usr.bin/perl/pod/perlipc.pod b/gnu/usr.bin/perl/pod/perlipc.pod
new file mode 100644
index 00000000000..ac2c5fd584c
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlipc.pod
@@ -0,0 +1,917 @@
+=head1 NAME
+
+perlipc - Perl interprocess communication (signals, fifos, pipes, safe subprocceses, sockets, and semaphores)
+
+=head1 DESCRIPTION
+
+The basic IPC facilities of Perl are built out of the good old Unix
+signals, named pipes, pipe opens, the Berkeley socket routines, and SysV
+IPC calls.  Each is used in slightly different situations.
+
+=head1 Signals
+
+Perl uses a simple signal handling model: the %SIG hash contains names or
+references of user-installed signal handlers.  These handlers will be called
+with an argument which is the name of the signal that triggered it.  A
+signal may be generated intentionally from a particular keyboard sequence like
+control-C or control-Z, sent to you from an another process, or
+triggered automatically by the kernel when special events transpire, like
+a child process exiting, your process running out of stack space, or 
+hitting file size limit.
+
+For example, to trap an interrupt signal, set up a handler like this.
+Notice how all we do is set with a global variable and then raise an
+exception.  That's because on most systems libraries are not
+re-entrant, so calling any print() functions (or even anything that needs to
+malloc(3) more memory) could in theory trigger a memory fault
+and subsequent core dump.
+
+    sub catch_zap {
+	my $signame = shift;
+	$shucks++;
+	die "Somebody sent me a SIG$signame";
+    } 
+    $SIG{INT} = 'catch_zap';  # could fail in modules
+    $SIG{INT} = \&catch_zap;  # best strategy
+
+The names of the signals are the ones listed out by C<kill -l> on your
+system, or you can retrieve them from the Config module.  Set up an
+@signame list indexed by number to get the name and a %signo table
+indexed by name to get the number:
+
+    use Config;
+    defined $Config{sig_name} || die "No sigs?";
+    foreach $name (split(' ', $Config{sig_name})) {
+	$signo{$name} = $i;
+	$signame[$i] = $name;
+	$i++;
+    }   
+
+So to check whether signal 17 and SIGALRM were the same, just do this:
+
+    print "signal #17 = $signame[17]\n";
+    if ($signo{ALRM}) { 
+	print "SIGALRM is $signo{ALRM}\n";
+    }   
+
+You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
+the handler, in which case Perl will try to discard the signal or do the
+default thing.  Some signals can be neither trapped nor ignored, such as
+the KILL and STOP (but not the TSTP) signals.  One strategy for
+temporarily ignoring signals is to use a local() statement, which will be
+automatically restored once your block is exited.  (Remember that local()
+values are "inherited" by functions called from within that block.)
+
+    sub precious {
+	local $SIG{INT} = 'IGNORE';
+	&more_functions;
+    } 
+    sub more_functions {
+	# interrupts still ignored, for now...
+    } 
+
+Sending a signal to a negative process ID means that you send the signal
+to the entire Unix process-group.  This code send a hang-up signal to all
+processes in the current process group I<except for> the current process
+itself:
+
+    {
+	local $SIG{HUP} = 'IGNORE';
+	kill HUP => -$$;
+	# snazzy writing of: kill('HUP', -$$)
+    }
+
+Another interesting signal to send is signal number zero.  This doesn't
+actually affect another process, but instead checks whether it's alive
+or has changed its UID.  
+
+    unless (kill 0 => $kid_pid) {
+	warn "something wicked happened to $kid_pid";
+    } 
+
+You might also want to employ anonymous functions for simple signal
+handlers:
+
+    $SIG{INT} = sub { die "\nOutta here!\n" };
+
+But that will be problematic for the more complicated handlers that need
+to re-install themselves.  Because Perl's signal mechanism is currently
+based on the signal(3) function from the C library, you may somtimes be so
+misfortunate as to run on systems where that function is "broken", that
+is, it behaves in the old unreliable SysV way rather than the newer, more
+reasonable BSD and POSIX fashion.  So you'll see defensive people writing
+signal handlers like this:
+
+    sub REAPER { 
+	$SIG{CHLD} = \&REAPER;  # loathe sysV
+	$waitedpid = wait;
+    }
+    $SIG{CHLD} = \&REAPER;
+    # now do something that forks...
+
+or even the more elaborate:
+
+    use POSIX "wait_h";
+    sub REAPER { 
+	my $child;
+	$SIG{CHLD} = \&REAPER;  # loathe sysV
+        while ($child = waitpid(-1,WNOHANG)) {
+	    $Kid_Status{$child} = $?;
+	} 
+    }
+    $SIG{CHLD} = \&REAPER;
+    # do something that forks...
+
+Signal handling is also used for timeouts in Unix,   While safely
+protected within an C<eval{}> block, you set a signal handler to trap
+alarm signals and then schedule to have one delivered to you in some
+number of seconds.  Then try your blocking operation, clearing the alarm
+when it's done but not before you've exited your C<eval{}> block.  If it
+goes off, you'll use die() to jump out of the block, much as you might
+using longjmp() or throw() in other languages.
+
+Here's an example:
+
+    eval { 
+        local $SIG{ALRM} = sub { die "alarm clock restart" };
+        alarm 10; 
+        flock(FH, 2);   # blocking write lock
+        alarm 0; 
+    };
+    if ($@ and $@ !~ /alarm clock restart/) { die }
+
+For more complex signal handling, you might see the standard POSIX
+module.  Lamentably, this is almost entirely undocumented, but
+the F<t/lib/posix.t> file from the Perl source distribution has some
+examples in it.
+
+=head1 Named Pipes
+
+A named pipe (often referred to as a FIFO) is an old Unix IPC
+mechanism for processes communicating on the same machine.  It works
+just like a regular, connected anonymous pipes, except that the 
+processes rendezvous using a filename and don't have to be related.
+
+To create a named pipe, use the Unix command mknod(1) or on some
+systems, mkfifo(1).  These may not be in your normal path.
+
+    # system return val is backwards, so && not ||
+    #
+    $ENV{PATH} .= ":/etc:/usr/etc";
+    if  (      system('mknod',  $path, 'p') 
+	    && system('mkfifo', $path) )
+    {
+	die "mk{nod,fifo} $path failed;
+    } 
+
+
+A fifo is convenient when you want to connect a process to an unrelated
+one.  When you open a fifo, the program will block until there's something
+on the other end.  
+
+For example, let's say you'd like to have your F<.signature> file be a
+named pipe that has a Perl program on the other end.  Now every time any
+program (like a mailer, newsreader, finger program, etc.) tries to read
+from that file, the reading program will block and your program will
+supply the the new signature.  We'll use the pipe-checking file test B<-p>
+to find out whether anyone (or anything) has accidentally removed our fifo.
+
+    chdir; # go home
+    $FIFO = '.signature';
+    $ENV{PATH} .= ":/etc:/usr/games";
+
+    while (1) {
+	unless (-p $FIFO) {
+	    unlink $FIFO;
+	    system('mknod', $FIFO, 'p') 
+		&& die "can't mknod $FIFO: $!";
+	} 
+
+	# next line blocks until there's a reader
+	open (FIFO, "> $FIFO") || die "can't write $FIFO: $!";
+	print FIFO "John Smith (smith\@host.org)\n", `fortune -s`;
+	close FIFO;
+	sleep 2;    # to avoid dup sigs
+    }
+
+
+=head1 Using open() for IPC
+
+Perl's basic open() statement can also be used for unidirectional interprocess
+communication by either appending or prepending a pipe symbol to the second
+argument to open().  Here's how to start something up a child process you
+intend to write to:
+
+    open(SPOOLER, "| cat -v | lpr -h 2>/dev/null") 
+		    || die "can't fork: $!";
+    local $SIG{PIPE} = sub { die "spooler pipe broke" };
+    print SPOOLER "stuff\n";
+    close SPOOLER || die "bad spool: $! $?";
+
+And here's how to start up a child process you intend to read from:
+
+    open(STATUS, "netstat -an 2>&1 |")
+		    || die "can't fork: $!";
+    while (<STATUS>) {
+	next if /^(tcp|udp)/;
+	print;
+    } 
+    close SPOOLER || die "bad netstat: $! $?";
+
+If one can be sure that a particular program is a Perl script that is
+expecting filenames in @ARGV, the clever programmer can write something
+like this:
+
+    $ program f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
+
+and irrespective of which shell it's called from, the Perl program will
+read from the file F<f1>, the process F<cmd1>, standard input (F<tmpfile>
+in this case), the F<f2> file, the F<cmd2> command, and finally the F<f3>
+file.  Pretty nifty, eh?
+
+You might notice that you could use backticks for much the
+same effect as opening a pipe for reading:
+
+    print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`;
+    die "bad netstat" if $?;
+
+While this is true on the surface, it's much more efficient to process the
+file one line or record at a time because then you don't have to read the
+whole thing into memory at once. It also gives you finer control of the
+whole process, letting you to kill off the child process early if you'd
+like.
+
+Be careful to check both the open() and the close() return values.  If
+you're I<writing> to a pipe, you should also trap SIGPIPE.  Otherwise,
+think of what happens when you start up a pipe to a command that doesn't
+exist: the open() will in all likelihood succeed (it only reflects the
+fork()'s success), but then your output will fail--spectacularly.  Perl
+can't know whether the command worked because your command is actually
+running in a separate process whose exec() might have failed.  Therefore,
+while readers of bogus commands just return a quick end of file, writers
+to bogus command will trigger a signal they'd better be prepared to
+handle.  Consider:
+
+    open(FH, "|bogus");
+    print FH "bang\n";
+    close FH;
+
+=head2 Safe Pipe Opens
+
+Another interesting approach to IPC is making your single program go
+multiprocess and communicate between (or even amongst) yourselves.  The
+open() function will accept a file argument of either C<"-|"> or C<"|-">
+to do a very interesting thing: it forks a child connected to the
+filehandle you've opened.  The child is running the same program as the
+parent.  This is useful for safely opening a file when running under an
+assumed UID or GID, for example.  If you open a pipe I<to> minus, you can
+write to the filehandle you opened and your kid will find it in his
+STDIN.  If you open a pipe I<from> minus, you can read from the filehandle
+you opened whatever your kid writes to his STDOUT.
+
+    use English;
+    my $sleep_count = 0;
+
+    do { 
+	$pid = open(KID_TO_WRITE, "|-");
+	unless (defined $pid) {
+	    warn "cannot fork: $!";
+	    die "bailing out" if $sleep_count++ > 6;
+	    sleep 10;
+	} 
+    } until defined $pid;
+
+    if ($pid) {  # parent
+	print KID_TO_WRITE @some_data;
+	close(KID_TO_WRITE) || warn "kid exited $?";
+    } else {     # child
+	($EUID, $EGID) = ($UID, $GID); # suid progs only
+	open (FILE, "> /safe/file") 
+	    || die "can't open /safe/file: $!";
+	while (<STDIN>) {
+	    print FILE; # child's STDIN is parent's KID
+	} 
+	exit;  # don't forget this
+    } 
+
+Another common use for this construct is when you need to execute
+something without the shell's interference.  With system(), it's
+straigh-forward, but you can't use a pipe open or backticks safely.
+That's because there's no way to stop the shell from getting its hands on
+your arguments.   Instead, use lower-level control to call exec() directly.
+
+Here's a safe backtick or pipe open for read:
+
+    # add error processing as above
+    $pid = open(KID_TO_READ, "-|");
+
+    if ($pid) {   # parent
+	while (<KID_TO_READ>) {
+	    # do something interesting
+	} 	  
+	close(KID_TO_READ) || warn "kid exited $?";
+
+    } else {      # child
+	($EUID, $EGID) = ($UID, $GID); # suid only
+	exec($program, @options, @args)
+	    || die "can't exec program: $!";
+	# NOTREACHED
+    } 
+
+
+And here's a safe pipe open for writing:
+
+    # add error processing as above
+    $pid = open(KID_TO_WRITE, "|-");
+    $SIG{ALRM} = sub { die "whoops, $program pipe broke" };
+
+    if ($pid) {  # parent
+	for (@data) {
+	    print KID_TO_WRITE;
+	} 
+	close(KID_TO_WRITE) || warn "kid exited $?";
+
+    } else {     # child
+	($EUID, $EGID) = ($UID, $GID);
+	exec($program, @options, @args)
+	    || die "can't exec program: $!";
+	# NOTREACHED
+    } 
+
+Note that these operations are full Unix forks, which means they may not be
+correctly implemented on alien systems.  Additionally, these are not true
+multithreading.  If you'd like to learn more about threading, see the
+F<modules> file mentioned below in the L<SEE ALSO> section.
+
+=head2 Bidirectional Communication
+
+While this works reasonably well for unidirectional communication, what
+about bidirectional communication?  The obvious thing you'd like to do
+doesn't actually work:
+
+    open(PROG_FOR_READING_AND_WRITING, "| some program |")
+
+and if you forget to use the B<-w> flag, then you'll miss out 
+entirely on the diagnostic message:
+
+    Can't do bidirectional pipe at -e line 1.
+
+If you really want to, you can use the standard open2() library function
+to catch both ends.  There's also an open3() for tridirectional I/O so you
+can also catch your child's STDERR, but doing so would then require an
+awkward select() loop and wouldn't allow you to use normal Perl input
+operations.
+
+If you look at its source, you'll see that open2() uses low-level
+primitives like Unix pipe() and exec() to create all the connections.
+While it might have been slightly more efficient by using socketpair(), it
+would have then been even less portable than it already is.  The open2()
+and open3() functions are  unlikely to work anywhere except on a Unix
+system or some other one purporting to be POSIX compliant.
+
+Here's an example of using open2():
+
+    use FileHandle;
+    use IPC::Open2;
+    $pid = open2( \*Reader, \*Writer, "cat -u -n" );
+    Writer->autoflush(); # default here, actually
+    print Writer "stuff\n";
+    $got = <Reader>;
+
+The problem with this is that Unix buffering is going to really
+ruin your day.  Even though your C<Writer> filehandle is autoflushed,
+and the process on the other end will get your data in a timely manner,
+you can't usually do anything to force it to actually give it back to you
+in a similarly quick fashion.  In this case, we could, because we 
+gave I<cat> a B<-u> flag to make it unbuffered.  But very few Unix
+commands are designed to operate over pipes, so this seldom works
+unless you yourself wrote the program on the other end of the 
+double-ended pipe.
+
+A solution to this is the non-standard F<Comm.pl> library.  It uses
+pseudo-ttys to make your program behave more reasonably:
+
+    require 'Comm.pl';
+    $ph = open_proc('cat -n');
+    for (1..10) {
+	print $ph "a line\n";
+	print "got back ", scalar <$ph>;
+    }
+
+This way you don't have to have control over the source code of the
+program you're using.  The F<Comm> library also has expect() 
+and interact() functions.  Find the library (and hopefully its 
+successor F<IPC::Chat>) at your nearest CPAN archive as detailed
+in the L<SEE ALSO> section below.
+
+=head1 Sockets: Client/Server Communication
+
+While not limited to Unix-derived operating systems (e.g. WinSock on PCs
+provides socket support, as do some VMS libraries), you may not have
+sockets on your system, in which this section probably isn't going to do
+you much good.  With sockets, you can do both virtual circuits (i.e. TCP
+streams) and datagrams (i.e. UDP packets).  You may be able to do even more
+depending on your system.
+
+The Perl function calls for dealing with sockets have the same names as
+the corresponding system calls in C, but their arguments tend to differ
+for two reasons: first, Perl filehandles work differently than C file
+descriptors.  Second, Perl already knows the length of its strings, so you
+don't need to pass that information.
+
+One of the major problems with old socket code in Perl was that it used
+hard-coded values for some of the constants, which severely hurt
+portability.  If you ever see code that does anything like explicitly
+setting C<$AF_INET = 2>, you know you're in for big trouble:  An
+immeasurably superior approach is to use the C<Socket> module, which more
+reliably grants access to various constants and functions you'll need.
+
+=head2 Internet TCP Clients and Servers
+
+Use Internet-domain sockets when you want to do client-server
+communication that might extend to machines outside of your own system.
+
+Here's a sample TCP client using Internet-domain sockets:
+
+    #!/usr/bin/perl -w
+    require 5.002;
+    use strict;
+    use Socket;
+    my ($remote,$port, $iaddr, $paddr, $proto, $line);
+
+    $remote  = shift || 'localhost';
+    $port    = shift || 2345;  # random port
+    if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
+    die "No port" unless $port;
+    $iaddr   = inet_aton($remote) 		|| die "no host: $remote";
+    $paddr   = sockaddr_in($port, $iaddr);
+
+    $proto   = getprotobyname('tcp');
+    socket(SOCK, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
+    connect(SOCK, $paddr)    || die "connect: $!";
+    while ($line = <SOCK>) {
+	print $line;
+    } 
+
+    close (SOCK)	    || die "close: $!";
+    exit;
+
+And here's a corresponding server to go along with it.  We'll
+leave the address as INADDR_ANY so that the kernel can choose
+the appropriate interface on multihomed hosts.  If you want sit
+on a particular interface (like the external side of a gateway
+or firewall machine), you should fill this in with your real address
+instead.
+
+    #!/usr/bin/perl -Tw
+    require 5.002;
+    use strict;
+    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
+    use Socket;
+    use Carp;
+
+    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } 
+
+    my $port = shift || 2345;
+    my $proto = getprotobyname('tcp');
+    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
+    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 
+					pack("l", 1)) 	|| die "setsockopt: $!";
+    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
+    listen(Server,SOMAXCONN) 				|| die "listen: $!";
+
+    logmsg "server started on port $port";
+
+    my $paddr;
+
+    $SIG{CHLD} = \&REAPER;
+
+    for ( ; $paddr = accept(Client,Server); close Client) {
+	my($port,$iaddr) = sockaddr_in($paddr);
+	my $name = gethostbyaddr($iaddr,AF_INET);
+
+	logmsg "connection from $name [", 
+		inet_ntoa($iaddr), "] 
+		at port $port";
+
+	print CLIENT "Hello there, $name, it's now ", 
+			scalar localtime, "\n";
+    } 
+
+And here's a multithreaded version.  It's multithreaded in that
+like most typical servers, it spawns (forks) a slave server to 
+handle the client request so that the master server can quickly
+go back to service a new client.
+
+    #!/usr/bin/perl -Tw
+    require 5.002;
+    use strict;
+    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
+    use Socket;
+    use Carp;
+
+    sub spawn;  # forward declaration
+    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" } 
+
+    my $port = shift || 2345;
+    my $proto = getprotobyname('tcp');
+    socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
+    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, 
+					pack("l", 1)) 	|| die "setsockopt: $!";
+    bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
+    listen(Server,SOMAXCONN) 				|| die "listen: $!";
+
+    logmsg "server started on port $port";
+
+    my $waitedpid = 0;
+    my $paddr;
+
+    sub REAPER { 
+	$SIG{CHLD} = \&REAPER;  # loathe sysV
+	$waitedpid = wait;
+	logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+    }
+
+    $SIG{CHLD} = \&REAPER;
+
+    for ( $waitedpid = 0; 
+	  ($paddr = accept(Client,Server)) || $waitedpid; 
+	  $waitedpid = 0, close Client) 
+    {
+	next if $waitedpid;
+	my($port,$iaddr) = sockaddr_in($paddr);
+	my $name = gethostbyaddr($iaddr,AF_INET);
+
+	logmsg "connection from $name [", 
+		inet_ntoa($iaddr), "] 
+		at port $port";
+
+	spawn sub { 
+	    print "Hello there, $name, it's now ", scalar localtime, "\n";
+	    exec '/usr/games/fortune' 
+		or confess "can't exec fortune: $!";
+	};
+
+    } 
+
+    sub spawn {
+	my $coderef = shift;
+
+	unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { 
+	    confess "usage: spawn CODEREF";
+	}
+
+	my $pid;
+	if (!defined($pid = fork)) {
+	    logmsg "cannot fork: $!";
+	    return;
+	} elsif ($pid) {
+	    logmsg "begat $pid";
+	    return; # i'm the parent
+	}
+	# else i'm the child -- go spawn
+
+	open(STDIN,  "<&Client")   || die "can't dup client to stdin";
+	open(STDOUT, ">&Client")   || die "can't dup client to stdout";
+	## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
+	exit &$coderef();
+    } 
+
+This server takes the trouble to clone off a child version via fork() for
+each incoming request.  That way it can handle many requests at once,
+which you might not always want.  Even if you don't fork(), the listen()
+will allow that many pending connections.  Forking servers have to be
+particularly careful about cleaning up their dead children (called
+"zombies" in Unix parlance), because otherwise you'll quickly fill up your
+process table.
+
+We suggest that you use the B<-T> flag to use taint checking (see L<perlsec>)
+even if we aren't running setuid or setgid.  This is always a good idea
+for servers and other programs run on behalf of someone else (like CGI
+scripts), because it lessens the chances that people from the outside will
+be able to compromise your system.
+
+Let's look at another TCP client.  This one connects to the TCP "time"
+service on a number of different machines and shows how far their clocks
+differ from the system on which it's being run:
+
+    #!/usr/bin/perl  -w
+    require 5.002;
+    use strict;
+    use Socket;
+
+    my $SECS_of_70_YEARS = 2208988800;
+    sub ctime { scalar localtime(shift) } 
+
+    my $iaddr = gethostbyname('localhost'); 
+    my $proto = getprotobyname('tcp');   
+    my $port = getservbyname('time', 'tcp');  
+    my $paddr = sockaddr_in(0, $iaddr);
+    my($host);
+
+    $| = 1;
+    printf "%-24s %8s %s\n",  "localhost", 0, ctime(time());
+
+    foreach $host (@ARGV) {
+	printf "%-24s ", $host;
+	my $hisiaddr = inet_aton($host)     || die "unknown host";
+	my $hispaddr = sockaddr_in($port, $hisiaddr);
+	socket(SOCKET, PF_INET, SOCK_STREAM, $proto)   || die "socket: $!";
+	connect(SOCKET, $hispaddr)          || die "bind: $!";
+	my $rtime = '    ';
+	read(SOCKET, $rtime, 4);
+	close(SOCKET);
+	my $histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
+	printf "%8d %s\n", $histime - time, ctime($histime);
+    }
+
+=head2 Unix-Domain TCP Clients and Servers
+
+That's fine for Internet-domain clients and servers, but what local
+communications?  While you can use the same setup, sometimes you don't
+want to.  Unix-domain sockets are local to the current host, and are often
+used internally to implement pipes.  Unlike Internet domain sockets, UNIX
+domain sockets can show up in the file system with an ls(1) listing.
+
+    $ ls -l /dev/log
+    srw-rw-rw-  1 root            0 Oct 31 07:23 /dev/log
+
+You can test for these with Perl's B<-S> file test:
+
+    unless ( -S '/dev/log' ) {
+	die "something's wicked with the print system";
+    } 
+
+Here's a sample Unix-domain client:
+
+    #!/usr/bin/perl -w
+    require 5.002;
+    use Socket;
+    use strict;
+    my ($rendezvous, $line);
+
+    $rendezvous = shift || '/tmp/catsock';
+    socket(SOCK, PF_UNIX, SOCK_STREAM, 0)	|| die "socket: $!";
+    connect(SOCK, sockaddr_un($remote))		|| die "connect: $!";
+    while ($line = <SOCK>) {
+	print $line;
+    } 
+    exit;
+
+And here's a corresponding server.  
+
+    #!/usr/bin/perl -Tw
+    require 5.002;
+    use strict;
+    use Socket;
+    use Carp;
+
+    BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
+
+    my $NAME = '/tmp/catsock';
+    my $uaddr = sockaddr_un($NAME);
+    my $proto = getprotobyname('tcp');
+
+    socket(Server,PF_UNIX,SOCK_STREAM,0) 	|| die "socket: $!";
+    unlink($NAME);
+    bind  (Server, $uaddr) 			|| die "bind: $!";
+    listen(Server,SOMAXCONN)			|| die "listen: $!";
+
+    logmsg "server started on $NAME";
+
+    $SIG{CHLD} = \&REAPER;
+
+    for ( $waitedpid = 0; 
+	  accept(Client,Server) || $waitedpid; 
+	  $waitedpid = 0, close Client) 
+    {
+	next if $waitedpid;
+	logmsg "connection on $NAME";
+	spawn sub { 
+	    print "Hello there, it's now ", scalar localtime, "\n";
+	    exec '/usr/games/fortune' or die "can't exec fortune: $!";
+	};
+    } 
+
+As you see, it's remarkably similar to the Internet domain TCP server, so
+much so, in fact, that we've omitted several duplicate functions--spawn(),
+logmsg(), ctime(), and REAPER()--which are exactly the same as in the
+other server.
+
+So why would you ever want to use a Unix domain socket instead of a
+simpler named pipe?  Because a named pipe doesn't give you sessions.  You
+can't tell one process's data from another's.  With socket programming,
+you get a separate session for each client: that's why accept() takes two
+arguments.
+
+For example, let's say that you have a long running database server daemon
+that you want folks from the World Wide Web to be able to access, but only
+if they go through a CGI interface.  You'd have a small, simple CGI
+program that does whatever checks and logging you feel like, and then acts
+as a Unix-domain client and connects to your private server.
+
+=head2 UDP: Message Passing
+
+Another kind of client-server setup is one that uses not connections, but
+messages.  UDP communications involve much lower overhead but also provide
+less reliability, as there are no promises that messages will arrive at
+all, let alone in order and unmangled.  Still, UDP offers some advantages
+over TCP, including being able to "broadcast" or "multicast" to a whole
+bunch of destination hosts at once (usually on your local subnet).  If you
+find yourself overly concerned about reliability and start building checks
+into your message system, then you probably should just use TCP to start
+with.
+
+Here's a UDP program similar to the sample Internet TCP client given
+above.  However, instead of checking one host at a time, the UDP version
+will check many of them asynchronously by simulating a multicast and then
+using select() to do a timed-out wait for I/O.  To do something similar
+with TCP, you'd have to use a different socket handle for each host.
+
+    #!/usr/bin/perl -w
+    use strict;
+    require 5.002;
+    use Socket;
+    use Sys::Hostname;
+
+    my ( $count, $hisiaddr, $hispaddr, $histime, 
+	 $host, $iaddr, $paddr, $port, $proto, 
+	 $rin, $rout, $rtime, $SECS_of_70_YEARS);
+
+    $SECS_of_70_YEARS      = 2208988800;
+
+    $iaddr = gethostbyname(hostname());
+    $proto = getprotobyname('udp');
+    $port = getservbyname('time', 'udp');
+    $paddr = sockaddr_in(0, $iaddr); # 0 means let kernel pick
+
+    socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
+    bind(SOCKET, $paddr)                          || die "bind: $!";
+
+    $| = 1;
+    printf "%-12s %8s %s\n",  "localhost", 0, scalar localtime time;
+    $count = 0;
+    for $host (@ARGV) {
+	$count++;
+	$hisiaddr = inet_aton($host) 	|| die "unknown host";
+	$hispaddr = sockaddr_in($port, $hisiaddr);
+	defined(send(SOCKET, 0, 0, $hispaddr))    || die "send $host: $!";
+    }
+
+    $rin = '';
+    vec($rin, fileno(SOCKET), 1) = 1;
+
+    # timeout after 10.0 seconds
+    while ($count && select($rout = $rin, undef, undef, 10.0)) {
+	$rtime = '';
+	($hispaddr = recv(SOCKET, $rtime, 4, 0)) 	|| die "recv: $!";
+	($port, $hisiaddr) = sockaddr_in($hispaddr);
+	$host = gethostbyaddr($hisiaddr, AF_INET);
+	$histime = unpack("N", $rtime) - $SECS_of_70_YEARS ;
+	printf "%-12s ", $host;
+	printf "%8d %s\n", $histime - time, scalar localtime($histime);
+	$count--;
+    }
+
+=head1 SysV IPC
+
+While System V IPC isn't so widely used as sockets, it still has some
+interesting uses.  You can't, however, effectively use SysV IPC or
+Berkeley mmap() to have shared memory so as to share a variable amongst
+several processes.  That's because Perl would reallocate your string when
+you weren't wanting it to.
+
+
+Here's a small example showing shared memory usage.  
+
+    $IPC_PRIVATE = 0;
+    $IPC_RMID = 0;
+    $size = 2000;
+    $key = shmget($IPC_PRIVATE, $size , 0777 );
+    die unless defined $key;
+
+    $message = "Message #1";
+    shmwrite($key, $message, 0, 60 ) || die "$!";
+    shmread($key,$buff,0,60) || die "$!";
+
+    print $buff,"\n";
+
+    print "deleting $key\n";
+    shmctl($key ,$IPC_RMID, 0) || die "$!";
+
+Here's an example of a semaphore:
+
+    $IPC_KEY = 1234;
+    $IPC_RMID = 0;
+    $IPC_CREATE = 0001000;
+    $key = semget($IPC_KEY, $nsems , 0666 | $IPC_CREATE );
+    die if !defined($key);
+    print "$key\n";
+
+Put this code in a separate file to be run in more that one process
+Call the file F<take>:
+
+    # create a semaphore
+
+    $IPC_KEY = 1234;
+    $key = semget($IPC_KEY,  0 , 0 );
+    die if !defined($key);
+
+    $semnum = 0;
+    $semflag = 0;
+
+    # 'take' semaphore
+    # wait for semaphore to be zero
+    $semop = 0;
+    $opstring1 = pack("sss", $semnum, $semop, $semflag);
+
+    # Increment the semaphore count
+    $semop = 1;
+    $opstring2 = pack("sss", $semnum, $semop,  $semflag);
+    $opstring = $opstring1 . $opstring2;
+
+    semop($key,$opstring) || die "$!";
+
+Put this code in a separate file to be run in more that one process
+Call this file F<give>:
+
+    # 'give' the semaphore
+    # run this in the original process and you will see
+    # that the second process continues
+
+    $IPC_KEY = 1234;
+    $key = semget($IPC_KEY, 0, 0);
+    die if !defined($key);
+
+    $semnum = 0;
+    $semflag = 0;
+
+    # Decrement the semaphore count
+    $semop = -1;
+    $opstring = pack("sss", $semnum, $semop, $semflag);
+
+    semop($key,$opstring) || die "$!";
+
+=head1 WARNING
+
+The SysV IPC code above was written long ago, and it's definitely clunky
+looking.  It should at the very least be made to C<use strict> and
+C<require "sys/ipc.ph">.  Better yet, perhaps someone should create an
+C<IPC::SysV> module the way we have the C<Socket> module for normal
+client-server communications.
+
+(... time passes)  
+
+Voila!  Check out the IPC::SysV modules written by Jack Shirazi.  You can
+find them at a CPAN store near you.
+
+=head1 NOTES
+
+If you are running under version 5.000 (dubious) or 5.001, you can still
+use most of the examples in this document.  You may have to remove the
+C<use strict> and some of the my() statements for 5.000, and for both
+you'll have to load in version 1.2 of the F<Socket.pm> module, which
+was/is/shall-be included in I<perl5.001o>.
+
+Most of these routines quietly but politely return C<undef> when they fail
+instead of causing your program to die right then and there due to an
+uncaught exception.  (Actually, some of the new I<Socket> conversion
+functions  croak() on bad arguments.)  It is therefore essential
+that you should check the return values fo these functions.  Always begin
+your socket programs this way for optimal success, and don't forget to add
+B<-T> taint checking flag to the pound-bang line for servers:
+
+    #!/usr/bin/perl -w
+    require 5.002;
+    use strict;
+    use sigtrap;
+    use Socket;
+
+=head1 BUGS
+
+All these routines create system-specific portability problems.  As noted
+elsewhere, Perl is at the mercy of your C libraries for much of its system
+behaviour.  It's probably safest to assume broken SysV semantics for
+signals and to stick with simple TCP and UDP socket operations; e.g. don't
+try to pass open filedescriptors over a local UDP datagram socket if you
+want your code to stand a chance of being portable.
+
+Because few vendors provide C libraries that are safely 
+re-entrant, the prudent programmer will do little else within 
+a handler beyond die() to raise an exception and longjmp(3) out.
+
+=head1 AUTHOR
+
+Tom Christiansen, with occasional vestiges of Larry Wall's original
+version.
+
+=head1 SEE ALSO
+
+Besides the obvious functions in L<perlfunc>, you should also check out
+the F<modules> file at your nearest CPAN site.  (See L<perlmod> or best
+yet, the F<Perl FAQ> for a description of what CPAN is and where to get it.)
+Section 5 of the F<modules> file is devoted to "Networking, Device Control
+(modems) and Interprocess Communication", and contains numerous unbundled
+modules numerous networking modules, Chat and Expect operations, CGI
+programming, DCE, FTP, IPC, NNTP, Proxy, Ptty, RPC, SNMP, SMTP, Telnet,
+Threads, and ToolTalk--just to name a few.
diff --git a/gnu/usr.bin/perl/pod/perllol.pod b/gnu/usr.bin/perl/pod/perllol.pod
new file mode 100644
index 00000000000..11632e0c978
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perllol.pod
@@ -0,0 +1,313 @@
+=head1 NAME
+
+perlLoL - Manipulating Lists of Lists in Perl
+
+=head1 DESCRIPTION
+
+=head1 Declaration and Access of Lists of Lists
+
+The simplest thing to build is a list of lists (sometimes called an array
+of arrays).  It's reasonably easy to understand, and almost everything
+that applies here will also be applicable later on with the fancier data
+structures.
+
+A list of lists, or an array of an array if you would, is just a regular
+old array @LoL that you can get at with two subscripts, like $LoL[3][2].  Here's
+a declaration of the array:
+
+    # assign to our array a list of list references
+    @LoL = ( 
+	   [ "fred", "barney" ],
+	   [ "george", "jane", "elroy" ],
+	   [ "homer", "marge", "bart" ],
+    );
+
+    print $LoL[2][2];
+  bart
+
+Now you should be very careful that the outer bracket type
+is a round one, that is, parentheses.  That's because you're assigning to
+an @list, so you need parens.  If you wanted there I<not> to be an @LoL,
+but rather just a reference to it, you could do something more like this:
+
+    # assign a reference to list of list references
+    $ref_to_LoL = [
+	[ "fred", "barney", "pebbles", "bambam", "dino", ],
+	[ "homer", "bart", "marge", "maggie", ],
+	[ "george", "jane", "alroy", "judy", ],
+    ];
+
+    print $ref_to_LoL->[2][2];
+
+Notice that the outer bracket type has changed, and so our access syntax 
+has also changed.  That's because unlike C, in perl you can't freely
+interchange arrays and references thereto.  $ref_to_LoL is a reference to an 
+array, whereas @LoL is an array proper.  Likewise, $LoL[2] is not an 
+array, but an array ref.  So how come you can write these:
+
+    $LoL[2][2]
+    $ref_to_LoL->[2][2]
+
+instead of having to write these:
+
+    $LoL[2]->[2]
+    $ref_to_LoL->[2]->[2]
+
+Well, that's because the rule is that on adjacent brackets only (whether
+square or curly), you are free to omit the pointer dereferencing array.
+But you need not do so for the very first one if it's a scalar containing
+a reference, which means that $ref_to_LoL always needs it.
+
+=head1 Growing Your Own
+
+That's all well and good for declaration of a fixed data structure,
+but what if you wanted to add new elements on the fly, or build
+it up entirely from scratch?
+
+First, let's look at reading it in from a file.  This is something like
+adding a row at a time.  We'll assume that there's a flat file in which
+each line is a row and each word an element.  If you're trying to develop an
+@LoL list containing all these, here's the right way to do that:
+
+    while (<>) {
+	@tmp = split;
+	push @LoL, [ @tmp ];
+    } 
+
+You might also have loaded that from a function:
+
+    for $i ( 1 .. 10 ) {
+	$LoL[$i] = [ somefunc($i) ];
+    }
+
+Or you might have had a temporary variable sitting around with the
+list in it.  
+
+    for $i ( 1 .. 10 ) {
+	@tmp = somefunc($i);
+	$LoL[$i] = [ @tmp ];
+    }
+
+It's very important that you make sure to use the C<[]> list reference
+constructor.  That's because this will be very wrong:
+
+    $LoL[$i] = @tmp;
+
+You see, assigning a named list like that to a scalar just counts the 
+number of elements in @tmp, which probably isn't what you want.  
+
+If you are running under C<use strict>, you'll have to add some
+declarations to make it happy:
+
+    use strict;
+    my(@LoL, @tmp);
+    while (<>) {
+	@tmp = split;
+	push @LoL, [ @tmp ];
+    } 
+
+Of course, you don't need the temporary array to have a name at all:
+
+    while (<>) {
+	push @LoL, [ split ];
+    } 
+
+You also don't have to use push().  You could just make a direct assignment
+if you knew where you wanted to put it:
+
+    my (@LoL, $i, $line);
+    for $i ( 0 .. 10 ) 
+	$line = <>;
+	$LoL[$i] = [ split ' ', $line ];
+    } 
+
+or even just
+
+    my (@LoL, $i);
+    for $i ( 0 .. 10 ) 
+	$LoL[$i] = [ split ' ', <> ];
+    } 
+
+You should in general be leary of using potential list functions
+in a scalar context without explicitly stating such.  
+This would be clearer to the casual reader:
+
+    my (@LoL, $i);
+    for $i ( 0 .. 10 ) 
+	$LoL[$i] = [ split ' ', scalar(<>) ];
+    } 
+
+If you wanted to have a $ref_to_LoL variable as a reference to an array,
+you'd have to do something like this:
+
+    while (<>) {
+	push @$ref_to_LoL, [ split ];
+    } 
+
+Actually, if you were using strict, you'd not only have to declare $ref_to_LoL as
+you had to declare @LoL, but you'd I<also> having to initialize it to a
+reference to an empty list.  (This was a bug in 5.001m that's been fixed
+for the 5.002 release.)
+
+    my $ref_to_LoL = [];
+    while (<>) {
+	push @$ref_to_LoL, [ split ];
+    } 
+
+Ok, now you can add new rows.  What about adding new columns?  If you're
+just dealing with matrices, it's often easiest to use simple assignment:
+
+    for $x (1 .. 10) {
+	for $y (1 .. 10) {
+	    $LoL[$x][$y] = func($x, $y);
+	}
+    }
+
+    for $x ( 3, 7, 9 ) {
+	$LoL[$x][20] += func2($x);
+    } 
+
+It doesn't matter whether those elements are already 
+there or not: it'll gladly create them for you, setting
+intervening elements to C<undef> as need be.
+
+If you just wanted to append to a row, you'd have
+to do something a bit funnier looking:
+
+    # add new columns to an existing row
+    push @{ $LoL[0] }, "wilma", "betty";
+
+Notice that I I<couldn't> just say:
+
+    push $LoL[0], "wilma", "betty";  # WRONG!
+
+In fact, that wouldn't even compile.  How come?  Because the argument
+to push() must be a real array, not just a reference to such.
+
+=head1 Access and Printing
+
+Now it's time to print your data structure out.  How 
+are you going to do that?  Well, if you only want one
+of the elements, it's trivial:
+
+    print $LoL[0][0];
+
+If you want to print the whole thing, though, you can't
+just say 
+
+    print @LoL;		# WRONG
+
+because you'll just get references listed, and perl will never
+automatically dereference things for you.  Instead, you have to 
+roll yourself a loop or two.  This prints the whole structure,
+using the shell-style for() construct to loop across the outer
+set of subscripts.  
+
+    for $aref ( @LoL ) {
+	print "\t [ @$aref ],\n";
+    }
+
+If you wanted to keep track of subscripts, you might do this:
+
+    for $i ( 0 .. $#LoL ) {
+	print "\t elt $i is [ @{$LoL[$i]} ],\n";
+    }
+
+or maybe even this.  Notice the inner loop.
+
+    for $i ( 0 .. $#LoL ) {
+	for $j ( 0 .. $#{$LoL[$i]} ) {
+	    print "elt $i $j is $LoL[$i][$j]\n";
+	}
+    }
+
+As you can see, it's getting a bit complicated.  That's why 
+sometimes is easier to take a temporary on your way through:
+
+    for $i ( 0 .. $#LoL ) {
+	$aref = $LoL[$i];
+	for $j ( 0 .. $#{$aref} ) {
+	    print "elt $i $j is $LoL[$i][$j]\n";
+	}
+    }
+
+Hm... that's still a bit ugly.  How about this:
+
+    for $i ( 0 .. $#LoL ) {
+	$aref = $LoL[$i];
+	$n = @$aref - 1;
+	for $j ( 0 .. $n ) {
+	    print "elt $i $j is $LoL[$i][$j]\n";
+	}
+    }
+
+=head1 Slices
+
+If you want to get at a slide (part of a row) in a multidimensional
+array, you're going to have to do some fancy subscripting.  That's
+because while we have a nice synonym for single elements via the
+pointer arrow for dereferencing, no such convenience exists for slices.
+(Remember, of course, that you can always write a loop to do a slice
+operation.)
+
+Here's how to do one operation using a loop.  We'll assume an @LoL
+variable as before.
+
+    @part = ();
+    $x = 4; 	
+    for ($y = 7; $y < 13; $y++) {
+	push @part, $LoL[$x][$y];
+    } 
+
+That same loop could be replaced with a slice operation:
+
+    @part = @{ $LoL[4] } [ 7..12 ];
+
+but as you might well imagine, this is pretty rough on the reader.
+
+Ah, but what if you wanted a I<two-dimensional slice>, such as having
+$x run from 4..8 and $y run from 7 to 12?  Hm... here's the simple way:
+
+    @newLoL = ();
+    for ($startx = $x = 4; $x <= 8; $x++) {
+	for ($starty = $y = 7; $x <= 12; $y++) {
+	    $newLoL[$x - $startx][$y - $starty] = $LoL[$x][$y];
+	}
+    } 
+
+We can reduce some of the looping through slices 
+
+    for ($x = 4; $x <= 8; $x++) {
+	push @newLoL, [ @{ $LoL[$x] } [ 7..12 ] ];
+    }
+
+If you were into Schwartzian Transforms, you would probably
+have selected map for that
+
+    @newLoL = map { [ @{ $LoL[$_] } [ 7..12 ] ] } 4 .. 8;
+
+Although if your manager accused of seeking job security (or rapid
+insecurity) through inscrutable code, it would be hard to argue. :-)
+If I were you, I'd put that in a function:
+
+    @newLoL = splice_2D( \@LoL, 4 => 8, 7 => 12 );
+    sub splice_2D {
+	my $lrr = shift; 	# ref to list of list refs!
+	my ($x_lo, $x_hi, 
+	    $y_lo, $y_hi) = @_;
+
+	return map { 
+	    [ @{ $lrr->[$_] } [ $y_lo .. $y_hi ] ] 
+	} $x_lo .. $x_hi;
+    } 
+
+
+=head1 SEE ALSO
+
+perldata(1), perlref(1), perldsc(1)
+
+=head1 AUTHOR
+
+Tom Christiansen <tchrist@perl.com>
+
+Last udpate: Sat Oct  7 19:35:26 MDT 1995
diff --git a/gnu/usr.bin/perl/pod/perlmod.pod b/gnu/usr.bin/perl/pod/perlmod.pod
new file mode 100644
index 00000000000..80a40362466
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlmod.pod
@@ -0,0 +1,1069 @@
+=head1 NAME
+
+perlmod - Perl modules (packages)
+
+=head1 DESCRIPTION
+
+=head2 Packages
+
+Perl provides a mechanism for alternative namespaces to protect packages
+from stomping on each others variables.  In fact, apart from certain
+magical variables, there's really no such thing as a global variable in
+Perl.  The package statement declares the compilation unit as being in the
+given namespace.  The scope of the package declaration is from the
+declaration itself through the end of the enclosing block (the same scope
+as the local() operator).  All further unqualified dynamic identifiers
+will be in this namespace.  A package statement only affects dynamic
+variables--including those you've used local() on--but I<not> lexical
+variables created with my().  Typically it would be the first declaration
+in a file to be included by the C<require> or C<use> operator.  You can
+switch into a package in more than one place; it merely influences which
+symbol table is used by the compiler for the rest of that block.  You can
+refer to variables and filehandles in other packages by prefixing the
+identifier with the package name and a double colon:
+C<$Package::Variable>.  If the package name is null, the C<main> package
+as assumed.  That is, C<$::sail> is equivalent to C<$main::sail>.
+
+(The old package delimiter was a single quote, but double colon
+is now the preferred delimiter, in part because it's more readable
+to humans, and in part because it's more readable to B<emacs> macros.
+It also makes C++ programmers feel like they know what's going on.)
+
+Packages may be nested inside other packages: C<$OUTER::INNER::var>.  This
+implies nothing about the order of name lookups, however.  All symbols
+are either local to the current package, or must be fully qualified
+from the outer package name down.  For instance, there is nowhere
+within package C<OUTER> that C<$INNER::var> refers to C<$OUTER::INNER::var>.
+It would treat package C<INNER> as a totally separate global package.
+
+Only identifiers starting with letters (or underscore) are stored in a
+package's symbol table.  All other symbols are kept in package C<main>,
+including all of the punctuation variables like $_.  In addition, the
+identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC and SIG are
+forced to be in package C<main>, even when used for other purposes than
+their built-in one.  Note also that, if you have a package called C<m>,
+C<s> or C<y>, then you can't use the qualified form of an identifier
+because it will be interpreted instead as a pattern match, a substitution,
+or a translation.
+
+(Variables beginning with underscore used to be forced into package
+main, but we decided it was more useful for package writers to be able
+to use leading underscore to indicate private variables and method names.
+$_ is still global though.)
+
+Eval()ed strings are compiled in the package in which the eval() was
+compiled.  (Assignments to C<$SIG{}>, however, assume the signal
+handler specified is in the C<main> package.  Qualify the signal handler
+name if you wish to have a signal handler in a package.)  For an
+example, examine F<perldb.pl> in the Perl library.  It initially switches
+to the C<DB> package so that the debugger doesn't interfere with variables
+in the script you are trying to debug.  At various points, however, it
+temporarily switches back to the C<main> package to evaluate various
+expressions in the context of the C<main> package (or wherever you came
+from).  See L<perldebug>.
+
+See L<perlsub> for other scoping issues related to my() and local(), 
+or L<perlref> regarding closures.
+
+=head2 Symbol Tables
+
+The symbol table for a package happens to be stored in the associative
+array of that name appended with two colons.  The main symbol table's
+name is thus C<%main::>, or C<%::> for short.  Likewise the nested package
+mentioned earlier is named C<%OUTER::INNER::>.
+
+The value in each entry of the associative array is what you are referring
+to when you use the C<*name> typeglob notation.  In fact, the following
+have the same effect, though the first is more efficient because it does
+the symbol table lookups at compile time:
+
+    local(*main::foo) = *main::bar; local($main::{'foo'}) =
+    $main::{'bar'};
+
+You can use this to print out all the variables in a package, for
+instance.  Here is F<dumpvar.pl> from the Perl library:
+
+   package dumpvar;
+   sub main::dumpvar {
+       ($package) = @_;
+       local(*stab) = eval("*${package}::");
+       while (($key,$val) = each(%stab)) {
+	   local(*entry) = $val;
+	   if (defined $entry) {
+	       print "\$$key = '$entry'\n";
+	   }
+
+	   if (defined @entry) {
+	       print "\@$key = (\n";
+	       foreach $num ($[ .. $#entry) {
+		   print "  $num\t'",$entry[$num],"'\n";
+	       }
+	       print ")\n";
+	   }
+
+	   if ($key ne "${package}::" && defined %entry) {
+	       print "\%$key = (\n";
+	       foreach $key (sort keys(%entry)) {
+		   print "  $key\t'",$entry{$key},"'\n";
+	       }
+	       print ")\n";
+	   }
+       }
+   }
+
+Note that even though the subroutine is compiled in package C<dumpvar>,
+the name of the subroutine is qualified so that its name is inserted
+into package C<main>.
+
+Assignment to a typeglob performs an aliasing operation, i.e.,
+
+    *dick = *richard;
+
+causes variables, subroutines and file handles accessible via the
+identifier C<richard> to also be accessible via the symbol C<dick>.  If
+you only want to alias a particular variable or subroutine, you can
+assign a reference instead:
+
+    *dick = \$richard;
+
+makes $richard and $dick the same variable, but leaves
+@richard and @dick as separate arrays.  Tricky, eh?
+
+This mechanism may be used to pass and return cheap references
+into or from subroutines if you won't want to copy the whole
+thing.
+
+    %some_hash = ();
+    *some_hash = fn( \%another_hash );
+    sub fn {
+	local *hashsym = shift;
+	# now use %hashsym normally, and you
+	# will affect the caller's %another_hash
+	my %nhash = (); # do what you want
+	return \%nhash; 
+    }
+
+On return, the reference wil overwrite the hash slot in the
+symbol table specified by the *some_hash typeglob.  This
+is a somewhat tricky way of passing around refernces cheaply
+when you won't want to have to remember to dereference variables
+explicitly.
+
+Another use of symbol tables is for making "constant"  scalars.
+
+    *PI = \3.14159265358979;
+
+Now you cannot alter $PI, which is probably a good thing all in all.
+
+=head2 Package Constructors and Destructors
+
+There are two special subroutine definitions that function as package
+constructors and destructors.  These are the C<BEGIN> and C<END>
+routines.  The C<sub> is optional for these routines.
+
+A C<BEGIN> subroutine is executed as soon as possible, that is, the
+moment it is completely defined, even before the rest of the containing
+file is parsed.  You may have multiple C<BEGIN> blocks within a
+file--they will execute in order of definition.  Because a C<BEGIN>
+block executes immediately, it can pull in definitions of subroutines
+and such from other files in time to be visible to the rest of the
+file.
+
+An C<END> subroutine is executed as late as possible, that is, when the
+interpreter is being exited, even if it is exiting as a result of a
+die() function.  (But not if it's is being blown out of the water by a
+signal--you have to trap that yourself (if you can).)  You may have
+multiple C<END> blocks within a file--they will execute in reverse
+order of definition; that is: last in, first out (LIFO).
+
+Note that when you use the B<-n> and B<-p> switches to Perl, C<BEGIN>
+and C<END> work just as they do in B<awk>, as a degenerate case.
+
+=head2 Perl Classes
+
+There is no special class syntax in Perl, but a package may function
+as a class if it provides subroutines that function as methods.  Such a
+package may also derive some of its methods from another class package
+by listing the other package name in its @ISA array.  
+
+For more on this, see L<perlobj>.
+
+=head2 Perl Modules
+
+A module is just a package that is defined in a library file of
+the same name, and is designed to be reusable.  It may do this by
+providing a mechanism for exporting some of its symbols into the symbol
+table of any package using it.  Or it may function as a class
+definition and make its semantics available implicitly through method
+calls on the class and its objects, without explicit exportation of any
+symbols.  Or it can do a little of both.
+
+For example, to start a normal module called Fred, create
+a file called Fred.pm and put this at the start of it:
+
+    package 	 Fred;
+    require 	 Exporter;
+    @ISA       = qw(Exporter);
+    @EXPORT    = qw(func1 func2);
+    @EXPORT_OK = qw($sally @listabob %harry func3);
+
+Then go on to declare and use your variables in functions
+without any qualifications.
+See L<Exporter> and the I<Perl Modules File> for details on 
+mechanics and style issues in module creation.
+
+Perl modules are included into your program by saying
+
+    use Module;
+
+or
+
+    use Module LIST;
+
+This is exactly equivalent to
+
+    BEGIN { require "Module.pm"; import Module; }
+
+or
+
+    BEGIN { require "Module.pm"; import Module LIST; }
+
+As a special case
+
+    use Module ();
+
+is exactly equivalent to
+
+    BEGIN { require "Module.pm"; }
+
+All Perl module files have the extension F<.pm>.  C<use> assumes this so
+that you don't have to spell out "F<Module.pm>" in quotes.  This also
+helps to differentiate new modules from old F<.pl> and F<.ph> files.
+Module names are also capitalized unless they're functioning as pragmas,
+"Pragmas" are in effect compiler directives, and are sometimes called
+"pragmatic modules" (or even "pragmata" if you're a classicist).
+
+Because the C<use> statement implies a C<BEGIN> block, the importation
+of semantics happens at the moment the C<use> statement is compiled,
+before the rest of the file is compiled.  This is how it is able
+to function as a pragma mechanism, and also how modules are able to
+declare subroutines that are then visible as list operators for
+the rest of the current file.  This will not work if you use C<require>
+instead of C<use>.  With require you can get into this problem:
+
+    require Cwd;		# make Cwd:: accessible
+    $here = Cwd::getcwd();	
+
+    use Cwd;			# import names from Cwd:: 
+    $here = getcwd();
+
+    require Cwd;	    	# make Cwd:: accessible
+    $here = getcwd(); 		# oops! no main::getcwd()
+
+In general C<use Module ();> is recommended over C<require Module;>.
+
+Perl packages may be nested inside other package names, so we can have
+package names containing C<::>.  But if we used that package name
+directly as a filename it would makes for unwieldy or impossible
+filenames on some systems.  Therefore, if a module's name is, say,
+C<Text::Soundex>, then its definition is actually found in the library
+file F<Text/Soundex.pm>.
+
+Perl modules always have a F<.pm> file, but there may also be dynamically
+linked executables or autoloaded subroutine definitions associated with
+the module.  If so, these will be entirely transparent to the user of
+the module.  It is the responsibility of the F<.pm> file to load (or
+arrange to autoload) any additional functionality.  The POSIX module
+happens to do both dynamic loading and autoloading, but the user can
+just say C<use POSIX> to get it all.
+
+For more information on writing extension modules, see L<perlxs>
+and L<perlguts>.
+
+=head1 NOTE
+
+Perl does not enforce private and public parts of its modules as you may
+have been used to in other languages like C++, Ada, or Modula-17.  Perl
+doesn't have an infatuation with enforced privacy.  It would prefer
+that you stayed out of its living room because you weren't invited, not
+because it has a shotgun.
+
+The module and its user have a contract, part of which is common law,
+and part of which is "written".  Part of the common law contract is
+that a module doesn't pollute any namespace it wasn't asked to.  The
+written contract for the module (AKA documentation) may make other
+provisions.  But then you know when you C<use RedefineTheWorld> that
+you're redefining the world and willing to take the consequences.
+
+=head1 THE PERL MODULE LIBRARY
+
+A number of modules are included the the Perl distribution.  These are
+described below, and all end in F<.pm>.  You may also discover files in 
+the library directory that end in either F<.pl> or F<.ph>.  These are old
+libraries supplied so that old programs that use them still run.  The
+F<.pl> files will all eventually be converted into standard modules, and
+the F<.ph> files made by B<h2ph> will probably end up as extension modules
+made by B<h2xs>.  (Some F<.ph> values may already be available through the
+POSIX module.)  The B<pl2pm> file in the distribution may help in your
+conversion, but it's just a mechanical process, so is far from bullet proof.
+
+=head2 Pragmatic Modules
+
+They work somewhat like pragmas in that they tend to affect the compilation of
+your program, and thus will usually only work well when used within a
+C<use>, or C<no>.  These are locally scoped, so an inner BLOCK
+may countermand any of these by saying
+
+    no integer;
+    no strict 'refs';
+
+which lasts until the end of that BLOCK.
+
+The following programs are defined (and have their own documentation).
+
+=over 12
+
+=item diagnostics
+
+Pragma to produce enhanced diagnostics
+
+=item integer
+
+Pragma to compute arithmetic in integer instead of double
+
+=item less
+
+Pragma to request less of something from the compiler
+
+=item overload
+
+Pragma for overloading operators 
+
+=item sigtrap
+
+Pragma to enable stack backtrace on unexpected signals
+
+=item strict
+
+Pragma to restrict unsafe constructs
+
+=item subs
+
+Pragma to predeclare sub names
+
+=back
+
+=head2 Standard Modules
+
+Standard, bundled modules are all expected to behave in a well-defined
+manner with respect to namespace pollution because they use the
+Exporter module.  See their own documentation for details.
+
+=over 12
+
+=item AnyDBM_File
+
+provide framework for multiple DBMs
+
+=item AutoLoader
+
+load functions only on demand
+
+=item AutoSplit
+
+split a package for autoloading
+
+=item Benchmark
+
+benchmark running times of code
+
+=item Carp
+
+warn of errors (from perspective of caller)
+
+=item Config
+
+access Perl configuration option
+
+=item Cwd
+
+get pathname of current working directory
+
+=item DB_File
+
+Perl access to Berkeley DB
+
+=item Devel::SelfStubber
+
+generate stubs for a SelfLoading module
+
+=item DynaLoader
+
+Dynamically load C libraries into Perl code
+
+=item English
+
+use nice English (or awk) names for ugly punctuation variables
+
+=item Env
+
+perl module that imports environment variables
+
+=item Exporter
+
+provide inport/export controls for Perl modules
+
+=item ExtUtils::Liblist
+
+determine libraries to use and how to use them
+
+=item ExtUtils::MakeMaker
+
+create an extension Makefile
+
+=item ExtUtils::Manifest
+
+utilities to write and check a MANIFEST file
+
+=item ExtUtils::Mkbootstrap
+
+make a bootstrap file for use by DynaLoader
+
+=item ExtUtils::Miniperl
+
+!!!GOOD QUESTION!!!
+
+=item Fcntl
+
+load the C Fcntl.h defines
+
+=item File::Basename
+
+parse file specifications
+
+=item File::CheckTree
+
+run many filetest checks on a tree
+
+=item File::Find
+
+traverse a file tree
+
+=item FileHandle
+
+supply object methods for filehandles
+
+=item File::Path
+
+create or remove a series of directories
+
+=item Getopt::Long
+
+extended getopt processing
+
+=item Getopt::Std
+
+Process single-character switches with switch clustering
+
+=item I18N::Collate
+
+compare 8-bit scalar data according to the current locale
+
+=item IPC::Open2
+
+a process for both reading and writing
+
+=item IPC::Open3
+
+open a process for reading, writing, and error handling
+
+=item Net::Ping
+
+check a host for upness
+
+=item POSIX
+
+Perl interface to IEEE Std 1003.1
+
+=item SelfLoader
+
+load functions only on demand
+
+=item Safe
+
+Creation controlled compartments in which perl code can be evaluated.
+
+=item Socket
+
+load the C socket.h defines and structure manipulators
+
+=item Test::Harness
+
+run perl standard test scripts with statistics
+
+=item Text::Abbrev
+
+rceate an abbreviation table from a list
+
+=back
+
+To find out I<all> the modules installed on your system, including
+those without documentation or outside the standard release, do this:
+
+    find `perl -e 'print "@INC"'` -name '*.pm' -print
+
+They should all have their own documentation installed and accessible via
+your system man(1) command.  If that fails, try the I<perldoc> program.
+
+=head2 Extension Modules
+
+Extension modules are written in C (or a mix of Perl and C) and get
+dynamically loaded into Perl if and when you need them.  Supported
+extension modules include the Socket, Fcntl, and POSIX modules.
+
+Many popular C extension modules do not come bundled (at least, not
+completely) due to their size, volatility, or simply lack of time for
+adequate testing and configuration across the multitude of platforms on
+which Perl was beta-tested.  You are encouraged to look for them in
+archie(1L), the Perl FAQ or Meta-FAQ, the WWW page, and even with their
+authors before randomly posting asking for their present condition and
+disposition.
+
+=head1 CPAN
+
+CPAN stands for the Comprehensive Perl Archive Network.  This is a globally
+replicated collection of all known Perl materials, including hundreds 
+of unbunded modules.  Here are the major categories of modules:
+
+=over
+
+=item *
+Language Extensions and Documentation Tools 
+
+=item *
+Development Support
+
+=item *
+Operating System Interfaces
+
+=item *
+Networking, Device Control (modems) and InterProcess Communication
+
+=item *
+Data Types and Data Type Utilities
+
+=item *
+Database Interfaces
+
+=item *
+User Interfaces
+
+=item *
+Interfaces to / Emulations of Other Programming Languages
+
+=item *
+File Names, File Systems and File Locking (see also File Handles)
+
+=item *
+String Processing, Language Text Processing, Parsing and Searching
+
+=item *
+Option, Argument, Parameter and Configuration File Processing
+
+=item *
+Internationalization and Locale
+
+=item *
+Authentication, Security and Encryption
+
+=item *
+World Wide Web, HTML, HTTP, CGI, MIME
+
+=item *
+Server and Daemon Utilities
+
+=item *
+Archiving and Compression
+
+=item *
+Images, Pixmap and Bitmap Manipulation, Drawing and Graphing
+
+=item *
+Mail and Usenet News
+
+=item *
+Control Flow Utilities (callbacks and exceptions etc)
+
+=item *
+File Handle and Input/Output Stream Utilities
+
+=item *
+Miscellaneous Modules
+
+=back
+
+Some of the reguster CPAN sites as of this writing include the following.
+You should try to choose one close to you:
+
+=over
+
+=item *
+ftp://ftp.sterling.com/programming/languages/perl/
+
+=item *
+ftp://ftp.sedl.org/pub/mirrors/CPAN/
+
+=item *
+ftp://ftp.uoknor.edu/mirrors/CPAN/
+
+=item *
+ftp://ftp.delphi.com/pub/mirrors/packages/perl/CPAN/
+
+=item *
+ftp://uiarchive.cso.uiuc.edu/pub/lang/perl/CPAN/
+
+=item *
+ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
+
+=item *
+ftp://ftp.switch.ch/mirror/CPAN/
+
+=item *
+ftp://ftp.sunet.se/pub/lang/perl/CPAN/
+
+=item *
+ftp://ftp.ci.uminho.pt/pub/lang/perl/
+
+=item *
+ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/
+
+=item *
+ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
+
+=item *
+ftp://ftp.rz.ruhr-uni-bochum.de/pub/programming/languages/perl/CPAN/
+
+=item *
+ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/
+
+=item *
+ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/
+
+=item *
+ftp://ftp.ibp.fr/pub/perl/CPAN/
+
+=item *
+ftp://ftp.funet.fi/pub/languages/perl/CPAN/
+
+=item *
+ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/
+
+=item *
+ftp://ftp.mame.mu.oz.au/pub/perl/CPAN/
+
+=item *
+ftp://coombs.anu.edu.au/pub/perl/
+
+=item *
+ftp://dongpo.math.ncu.edu.tw/perl/CPAN/
+
+=item *
+ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
+
+=item *
+ftp://ftp.is.co.za/programming/perl/CPAN/
+
+=back
+
+For an up-to-date listing of CPAN sites, 
+see http://www.perl.com/perl/ or ftp://ftp.perl.com/perl/ .
+
+=head1 Modules: Creation, Use and Abuse
+
+(The following section is borrowed directly from Tim Bunce's modules
+file, available at your nearest CPAN site.)
+
+Perl 5 implements a class using a package, but the presence of a
+package doesn't imply the presence of a class.  A package is just a
+namespace.  A class is a package that provides subroutines that can be
+used as methods.  A method is just a subroutine that expects, as its
+first argument, either the name of a package (for "static" methods),
+or a reference to something (for "virtual" methods).
+
+A module is a file that (by convention) provides a class of the same
+name (sans the .pm), plus an import method in that class that can be
+called to fetch exported symbols.  This module may implement some of
+its methods by loading dynamic C or C++ objects, but that should be
+totally transparent to the user of the module.  Likewise, the module
+might set up an AUTOLOAD function to slurp in subroutine definitions on
+demand, but this is also transparent.  Only the .pm file is required to
+exist.
+
+=head2 Guidelines for Module Creation
+
+=over 4
+
+=item Do similar modules already exist in some form?
+
+If so, please try to reuse the existing modules either in whole or
+by inheriting useful features into a new class.  If this is not
+practical try to get together with the module authors to work on
+extending or enhancing the functionality of the existing modules.
+A perfect example is the plethora of packages in perl4 for dealing
+with command line options.
+
+If you are writing a module to expand an already existing set of
+modules, please coordinate with the author of the package.  It
+helps if you follow the same naming scheme and module interaction
+scheme as the original author.
+
+=item Try to design the new module to be easy to extend and reuse.
+
+Use blessed references.  Use the two argument form of bless to bless
+into the class name given as the first parameter of the constructor,
+e.g.:
+
+ sub new { 
+	my $class = shift;
+	return bless {}, $class;
+ }
+
+or even this if you'd like it to be used as either a static
+or a virtual method.
+
+ sub new { 
+	my $self  = shift;
+	my $class = ref($self) || $self;
+	return bless {}, $class;
+ }
+
+Pass arrays as references so more parameters can be added later
+(it's also faster).  Convert functions into methods where
+appropriate.  Split large methods into smaller more flexible ones.
+Inherit methods from other modules if appropriate.
+
+Avoid class name tests like: die "Invalid" unless ref $ref eq 'FOO'.
+Generally you can delete the "eq 'FOO'" part with no harm at all.
+Let the objects look after themselves! Generally, avoid hardwired
+class names as far as possible.
+
+Avoid $r-E<gt>Class::func() where using @ISA=qw(... Class ...) and
+$r-E<gt>func() would work (see perlbot man page for more details).
+
+Use autosplit so little used or newly added functions won't be a
+burden to programs which don't use them. Add test functions to
+the module after __END__ either using AutoSplit or by saying:
+
+ eval join('',<main::DATA>) || die $@ unless caller();
+
+Does your module pass the 'empty sub-class' test? If you say
+"@SUBCLASS::ISA = qw(YOURCLASS);" your applications should be able
+to use SUBCLASS in exactly the same way as YOURCLASS.  For example,
+does your application still work if you change:  $obj = new YOURCLASS;
+into: $obj = new SUBCLASS; ?
+
+Avoid keeping any state information in your packages. It makes it
+difficult for multiple other packages to use yours. Keep state
+information in objects.
+
+Always use C<-w>. Try to C<use strict;> (or C<use strict qw(...);>).
+Remember that you can add C<no strict qw(...);> to individual blocks
+of code which need less strictness. Always use C<-w>. Always use C<-w>!
+Follow the guidelines in the perlstyle(1) manual.
+
+=item Some simple style guidelines
+
+The perlstyle manual supplied with perl has many helpful points.
+
+Coding style is a matter of personal taste. Many people evolve their
+style over several years as they learn what helps them write and
+maintain good code.  Here's one set of assorted suggestions that
+seem to be widely used by experienced developers:
+
+Use underscores to separate words.  It is generally easier to read
+$var_names_like_this than $VarNamesLikeThis, especially for
+non-native speakers of English. It's also a simple rule that works
+consistently with VAR_NAMES_LIKE_THIS.
+
+Package/Module names are an exception to this rule. Perl informally
+reserves lowercase module names for 'pragma' modules like integer
+and strict. Other modules normally begin with a capital letter and
+use mixed case with no underscores (need to be short and portable).
+
+You may find it helpful to use letter case to indicate the scope
+or nature of a variable. For example:
+
+ $ALL_CAPS_HERE   constants only (beware clashes with perl vars)
+ $Some_Caps_Here  package-wide global/static
+ $no_caps_here    function scope my() or local() variables
+
+Function and method names seem to work best as all lowercase.
+E.g., $obj-E<gt>as_string().
+
+You can use a leading underscore to indicate that a variable or
+function should not be used outside the package that defined it.
+
+=item Select what to export.
+
+Do NOT export method names!
+
+Do NOT export anything else by default without a good reason!
+
+Exports pollute the namespace of the module user.  If you must
+export try to use @EXPORT_OK in preference to @EXPORT and avoid
+short or common names to reduce the risk of name clashes.
+
+Generally anything not exported is still accessible from outside the
+module using the ModuleName::item_name (or $blessed_ref-E<gt>method)
+syntax.  By convention you can use a leading underscore on names to
+informally indicate that they are 'internal' and not for public use.
+
+(It is actually possible to get private functions by saying:
+my $subref = sub { ... };  &$subref; But there's no way to call that
+directly as a method, since a method must have a name in the symbol
+table.)
+
+As a general rule, if the module is trying to be object oriented
+then export nothing. If it's just a collection of functions then
+@EXPORT_OK anything but use @EXPORT with caution.
+
+=item Select a name for the module.
+
+This name should be as descriptive, accurate and complete as
+possible.  Avoid any risk of ambiguity. Always try to use two or
+more whole words.  Generally the name should reflect what is special
+about what the module does rather than how it does it.  Please use
+nested module names to informally group or categorise a module.
+A module should have a very good reason not to have a nested name.
+Module names should begin with a capital letter.
+
+Having 57 modules all called Sort will not make life easy for anyone
+(though having 23 called Sort::Quick is only marginally better :-).
+Imagine someone trying to install your module alongside many others.
+If in any doubt ask for suggestions in comp.lang.perl.misc.
+
+If you are developing a suite of related modules/classes it's good
+practice to use nested classes with a common prefix as this will
+avoid namespace clashes. For example:  Xyz::Control, Xyz::View,
+Xyz::Model etc. Use the modules in this list as a naming guide.
+
+If adding a new module to a set, follow the original author's
+standards for naming modules and the interface to methods in
+those modules.
+
+To be portable each component of a module name should be limited to
+11 characters. If it might be used on DOS then try to ensure each is
+unique in the first 8 characters. Nested modules make this easier.
+
+=item Have you got it right?
+
+How do you know that you've made the right decisions? Have you
+picked an interface design that will cause problems later? Have
+you picked the most appropriate name? Do you have any questions?
+
+The best way to know for sure, and pick up many helpful suggestions,
+is to ask someone who knows. Comp.lang.perl.misc is read by just about
+all the people who develop modules and it's the best place to ask.
+
+All you need to do is post a short summary of the module, its
+purpose and interfaces. A few lines on each of the main methods is
+probably enough. (If you post the whole module it might be ignored
+by busy people - generally the very people you want to read it!)
+
+Don't worry about posting if you can't say when the module will be
+ready - just say so in the message. It might be worth inviting
+others to help you, they may be able to complete it for you!
+
+=item README and other Additional Files.
+
+It's well known that software developers usually fully document the
+software they write. If, however, the world is in urgent need of
+your software and there is not enough time to write the full
+documentation please at least provide a README file containing:
+
+=over 10
+
+=item *
+A description of the module/package/extension etc.
+
+=item *
+A copyright notice - see below.
+
+=item *
+Prerequisites - what else you may need to have.
+
+=item *
+How to build it - possible changes to Makefile.PL etc.
+
+=item *
+How to install it.
+
+=item *
+Recent changes in this release, especially incompatibilities
+
+=item *
+Changes / enhancements you plan to make in the future.
+
+=back
+
+If the README file seems to be getting too large you may wish to
+split out some of the sections into separate files: INSTALL,
+Copying, ToDo etc.
+
+=item Adding a Copyright Notice.
+
+How you choose to licence your work is a personal decision.
+The general mechanism is to assert your Copyright and then make
+a declaration of how others may copy/use/modify your work.
+
+Perl, for example, is supplied with two types of licence: The GNU
+GPL and The Artistic License (see the files README, Copying and
+Artistic).  Larry has good reasons for NOT just using the GNU GPL.
+
+My personal recommendation, out of respect for Larry, Perl and the
+perl community at large is to simply state something like:
+
+ Copyright (c) 1995 Your Name. All rights reserved.
+ This program is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+This statement should at least appear in the README file. You may
+also wish to include it in a Copying file and your source files.
+Remember to include the other words in addition to the Copyright.
+
+=item Give the module a version/issue/release number.
+
+To be fully compatible with the Exporter and MakeMaker modules you
+should store your module's version number in a non-my package
+variable called $VERSION.  This should be a valid floating point 
+number with at least two digits after the decimal (ie hundredths,
+e.g, $VERSION = "0.01").  Don't use a "1.3.2" style version.
+See Exporter.pm in Perl5.001m or later for details.
+
+It may be handy to add a function or method to retrieve the number.
+Use the number in announcements and archive file names when
+releasing the module (ModuleName-1.02.tar.Z).
+See perldoc ExtUtils::MakeMaker.pm for details.
+
+=item How to release and distribute a module.
+
+It's good idea to post an announcement of the availability of your
+module (or the module itself if small) to the comp.lang.perl.announce
+Usenet newsgroup.  This will at least ensure very wide once-off
+distribution.
+
+If possible you should place the module into a major ftp archive and
+include details of it's location in your announcement.
+
+Some notes about ftp archives: Please use a long descriptive file
+name which includes the version number. Most incoming directories
+will not be readable/listable, i.e., you won't be able to see your
+file after uploading it. Remember to send your email notification
+message as soon as possible after uploading else your file may get
+deleted automatically. Allow time for the file to be processed
+and/or check the file has been processed before announcing its
+location.
+
+FTP Archives for Perl Modules:
+
+Follow the instructions and links on
+
+   http://franz.ww.tu-berlin.de/modulelist
+
+or upload to one of these sites: 
+
+   ftp://franz.ww.tu-berlin.de/incoming
+   ftp://ftp.cis.ufl.edu/incoming  
+
+and notify upload@franz.ww.tu-berlin.de.
+
+By using the WWW interface you can ask the Upload Server to mirror
+your modules from your ftp or WWW site into your own directory on
+CPAN!
+
+Please remember to send me an updated entry for the Module list!
+
+=item Take care when changing a released module.
+
+Always strive to remain compatible with previous released versions
+(see 2.2 above) Otherwise try to add a mechanism to revert to the
+old behaviour if people rely on it. Document incompatible changes.
+
+=back
+
+=head2 Guidelines for Converting Perl 4 Library Scripts into Modules
+
+=over 4
+
+=item There is no requirement to convert anything.
+
+If it ain't broke, don't fix it! Perl 4 library scripts should
+continue to work with no problems. You may need to make some minor
+changes (like escaping non-array @'s in double quoted strings) but
+there is no need to convert a .pl file into a Module for just that.
+
+=item Consider the implications.
+
+All the perl applications which make use of the script will need to
+be changed (slightly) if the script is converted into a module.  Is
+it worth it unless you plan to make other changes at the same time?
+
+=item Make the most of the opportunity.
+
+If you are going to convert the script to a module you can use the
+opportunity to redesign the interface. The 'Guidelines for Module
+Creation' above include many of the issues you should consider.
+
+=item The pl2pm utility will get you started.
+
+This utility will read *.pl files (given as parameters) and write
+corresponding *.pm files. The pl2pm utilities does the following:
+
+=over 10
+
+=item *
+Adds the standard Module prologue lines
+
+=item *
+Converts package specifiers from ' to ::
+
+=item *
+Converts die(...) to croak(...)
+
+=item *
+Several other minor changes
+
+=back
+
+Being a mechanical process pl2pm is not bullet proof. The converted
+code will need careful checking, especially any package statements.
+Don't delete the original .pl file till the new .pm one works!
+
+=back
+
+=head2 Guidelines for Reusing Application Code
+
+=over 4
+
+=item Complete applications rarely belong in the Perl Module Library.
+
+=item Many applications contain some perl code which could be reused.
+
+Help save the world! Share your code in a form that makes it easy
+to reuse.
+
+=item Break-out the reusable code into one or more separate module files.
+
+=item Take the opportunity to reconsider and redesign the interfaces.
+
+=item In some cases the 'application' can then be reduced to a small
+
+fragment of code built on top of the reusable modules. In these cases
+the application could invoked as:
+
+     perl -e 'use Module::Name; method(@ARGV)' ...
+or   
+     perl -mModule::Name ...    (in perl5.002?)
+
+=back
+
diff --git a/gnu/usr.bin/perl/pod/perlobj.pod b/gnu/usr.bin/perl/pod/perlobj.pod
new file mode 100644
index 00000000000..81c6c962468
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlobj.pod
@@ -0,0 +1,410 @@
+=head1 NAME
+
+perlobj - Perl objects
+
+=head1 DESCRIPTION
+
+First of all, you need to understand what references are in Perl.  See
+L<perlref> for that.  
+
+Here are three very simple definitions that you should find reassuring.
+
+=over 4
+
+=item 1.
+
+An object is simply a reference that happens to know which class it
+belongs to.
+
+=item 2.
+
+A class is simply a package that happens to provide methods to deal
+with object references.
+
+=item 3.
+
+A method is simply a subroutine that expects an object reference (or
+a package name, for static methods) as the first argument.
+
+=back
+
+We'll cover these points now in more depth.
+
+=head2 An Object is Simply a Reference
+
+Unlike say C++, Perl doesn't provide any special syntax for
+constructors.  A constructor is merely a subroutine that returns a
+reference to something "blessed" into a class, generally the
+class that the subroutine is defined in.  Here is a typical
+constructor:
+
+    package Critter;
+    sub new { bless {} }
+
+The C<{}> constructs a reference to an anonymous hash containing no 
+key/value pairs.  The bless() takes that reference and tells the object
+it references that it's now a Critter, and returns the reference.
+This is for convenience, since the referenced object itself knows that
+it has been blessed, and its reference to it could have been returned 
+directly, like this:
+
+    sub new {
+	my $self = {};
+	bless $self;
+	return $self;
+    }
+
+In fact, you often see such a thing in more complicated constructors
+that wish to call methods in the class as part of the construction:
+
+    sub new {
+	my $self = {}
+	bless $self;
+	$self->initialize();
+	return $self;
+    }
+
+If you care about inheritance (and you should; see L<perlmod/"Modules:
+Creation, Use and Abuse">), then you want to use the two-arg form of bless
+so that your constructors may be inherited:
+
+    sub new {
+	my $class = shift;
+	my $self = {};
+	bless $self, $class
+	$self->initialize();
+	return $self;
+    }
+
+Or if you expect people to call not just C<CLASS-E<gt>new()> but also
+C<$obj-E<gt>new()>, then use something like this.  The initialize()
+method used will be of whatever $class we blessed the 
+object into:
+
+    sub new {
+	my $this = shift;
+	my $class = ref($this) || $this;
+	my $self = {};
+	bless $self, $class
+	$self->initialize();
+	return $self;
+    }
+
+Within the class package, the methods will typically deal with the
+reference as an ordinary reference.  Outside the class package,
+the reference is generally treated as an opaque value that may
+only be accessed through the class's methods.
+
+A constructor may re-bless a referenced object currently belonging to
+another class, but then the new class is responsible for all cleanup
+later.  The previous blessing is forgotten, as an object may only
+belong to one class at a time.  (Although of course it's free to 
+inherit methods from many classes.)
+
+A clarification:  Perl objects are blessed.  References are not.  Objects
+know which package they belong to.  References do not.  The bless()
+function simply uses the reference in order to find the object.  Consider
+the following example:
+
+    $a = {};
+    $b = $a;
+    bless $a, BLAH;
+    print "\$b is a ", ref($b), "\n";
+
+This reports $b as being a BLAH, so obviously bless() 
+operated on the object and not on the reference.
+
+=head2 A Class is Simply a Package
+
+Unlike say C++, Perl doesn't provide any special syntax for class
+definitions.  You just use a package as a class by putting method
+definitions into the class.
+
+There is a special array within each package called @ISA which says
+where else to look for a method if you can't find it in the current
+package.  This is how Perl implements inheritance.  Each element of the
+@ISA array is just the name of another package that happens to be a
+class package.  The classes are searched (depth first) for missing
+methods in the order that they occur in @ISA.  The classes accessible
+through @ISA are known as base classes of the current class. 
+
+If a missing method is found in one of the base classes, it is cached
+in the current class for efficiency.  Changing @ISA or defining new
+subroutines invalidates the cache and causes Perl to do the lookup again.
+
+If a method isn't found, but an AUTOLOAD routine is found, then
+that is called on behalf of the missing method.
+
+If neither a method nor an AUTOLOAD routine is found in @ISA, then one
+last try is made for the method (or an AUTOLOAD routine) in a class
+called UNIVERSAL.  If that doesn't work, Perl finally gives up and
+complains.
+
+Perl classes only do method inheritance.  Data inheritance is left
+up to the class itself.  By and large, this is not a problem in Perl,
+because most classes model the attributes of their object using
+an anonymous hash, which serves as its own little namespace to be
+carved up by the various classes that might want to do something
+with the object.
+
+=head2 A Method is Simply a Subroutine
+
+Unlike say C++, Perl doesn't provide any special syntax for method
+definition.  (It does provide a little syntax for method invocation
+though.  More on that later.)  A method expects its first argument
+to be the object or package it is being invoked on.  There are just two
+types of methods, which we'll call static and virtual, in honor of
+the two C++ method types they most closely resemble.
+
+A static method expects a class name as the first argument.  It
+provides functionality for the class as a whole, not for any individual
+object belonging to the class.  Constructors are typically static
+methods.  Many static methods simply ignore their first argument, since
+they already know what package they're in, and don't care what package
+they were invoked via.  (These aren't necessarily the same, since
+static methods follow the inheritance tree just like ordinary virtual
+methods.)  Another typical use for static methods is to look up an
+object by name:
+
+    sub find {
+	my ($class, $name) = @_;
+	$objtable{$name};
+    }
+
+A virtual method expects an object reference as its first argument.
+Typically it shifts the first argument into a "self" or "this" variable,
+and then uses that as an ordinary reference.
+
+    sub display {
+	my $self = shift;
+	my @keys = @_ ? @_ : sort keys %$self;
+	foreach $key (@keys) {
+	    print "\t$key => $self->{$key}\n";
+	}
+    }
+
+=head2 Method Invocation
+
+There are two ways to invoke a method, one of which you're already
+familiar with, and the other of which will look familiar.  Perl 4
+already had an "indirect object" syntax that you use when you say
+
+    print STDERR "help!!!\n";
+
+This same syntax can be used to call either static or virtual methods.
+We'll use the two methods defined above, the static method to lookup
+an object reference and the virtual method to print out its attributes.
+
+    $fred = find Critter "Fred";
+    display $fred 'Height', 'Weight';
+
+These could be combined into one statement by using a BLOCK in the
+indirect object slot:
+
+    display {find Critter "Fred"} 'Height', 'Weight';
+
+For C++ fans, there's also a syntax using -E<gt> notation that does exactly
+the same thing.  The parentheses are required if there are any arguments.
+
+    $fred = Critter->find("Fred");
+    $fred->display('Height', 'Weight');
+
+or in one statement,
+
+    Critter->find("Fred")->display('Height', 'Weight');
+
+There are times when one syntax is more readable, and times when the
+other syntax is more readable.  The indirect object syntax is less
+cluttered, but it has the same ambiguity as ordinary list operators.
+Indirect object method calls are parsed using the same rule as list
+operators: "If it looks like a function, it is a function".  (Presuming
+for the moment that you think two words in a row can look like a
+function name.  C++ programmers seem to think so with some regularity,
+especially when the first word is "new".)  Thus, the parens of
+
+    new Critter ('Barney', 1.5, 70)
+
+are assumed to surround ALL the arguments of the method call, regardless
+of what comes after.  Saying
+
+    new Critter ('Bam' x 2), 1.4, 45
+
+would be equivalent to
+
+    Critter->new('Bam' x 2), 1.4, 45
+
+which is unlikely to do what you want.
+
+There are times when you wish to specify which class's method to use.
+In this case, you can call your method as an ordinary subroutine
+call, being sure to pass the requisite first argument explicitly:
+
+    $fred =  MyCritter::find("Critter", "Fred");
+    MyCritter::display($fred, 'Height', 'Weight');
+
+Note however, that this does not do any inheritance.  If you merely
+wish to specify that Perl should I<START> looking for a method in a
+particular package, use an ordinary method call, but qualify the method
+name with the package like this:
+
+    $fred = Critter->MyCritter::find("Fred");
+    $fred->MyCritter::display('Height', 'Weight');
+
+If you're trying to control where the method search begins I<and> you're
+executing in the class itself, then you may use the SUPER pseudoclass,
+which says to start looking in your base class's @ISA list without having
+to explicitly name it:
+
+    $self->SUPER::display('Height', 'Weight');
+
+Please note that the C<SUPER::> construct is I<only> meaningful within the
+class.
+
+Sometimes you want to call a method when you don't know the method name
+ahead of time.  You can use the arrow form, replacing the method name
+with a simple scalar variable containing the method name:
+
+    $method = $fast ? "findfirst" : "findbest";
+    $fred->$method(@args);
+
+=head2 Destructors
+
+When the last reference to an object goes away, the object is
+automatically destroyed.  (This may even be after you exit, if you've
+stored references in global variables.)  If you want to capture control
+just before the object is freed, you may define a DESTROY method in
+your class.  It will automatically be called at the appropriate moment,
+and you can do any extra cleanup you need to do.
+
+Perl doesn't do nested destruction for you.  If your constructor
+reblessed a reference from one of your base classes, your DESTROY may
+need to call DESTROY for any base classes that need it.  But this only
+applies to reblessed objects--an object reference that is merely
+I<CONTAINED> in the current object will be freed and destroyed
+automatically when the current object is freed.
+
+=head2 WARNING
+
+An indirect object is limited to a name, a scalar variable, or a block,
+because it would have to do too much lookahead otherwise, just like any
+other postfix dereference in the language.  The left side of -E<gt> is not so
+limited, because it's an infix operator, not a postfix operator.  
+
+That means that below, A and B are equivalent to each other, and C and D
+are equivalent, but AB and CD are different:
+
+    A: method $obref->{"fieldname"} 
+    B: (method $obref)->{"fieldname"}
+    C: $obref->{"fieldname"}->method() 
+    D: method {$obref->{"fieldname"}}
+
+=head2 Summary
+
+That's about all there is to it.  Now you just need to go off and buy a
+book about object-oriented design methodology, and bang your forehead
+with it for the next six months or so.
+
+=head2 Two-Phased Garbage Collection
+
+For most purposes, Perl uses a fast and simple reference-based
+garbage collection system.  For this reason, there's an extra
+dereference going on at some level, so if you haven't built
+your Perl executable using your C compiler's C<-O> flag, performance
+will suffer.  If you I<have> built Perl with C<cc -O>, then this
+probably won't matter.
+
+A more serious concern is that unreachable memory with a non-zero
+reference count will not normally get freed.  Therefore, this is a bad
+idea:  
+
+    {
+	my $a;
+	$a = \$a;
+    } 
+
+Even thought $a I<should> go away, it can't.  When building recursive data
+structures, you'll have to break the self-reference yourself explicitly
+if you don't care to leak.  For example, here's a self-referential
+node such as one might use in a sophisticated tree structure:
+
+    sub new_node {
+	my $self = shift;
+	my $class = ref($self) || $self;
+	my $node = {};
+	$node->{LEFT} = $node->{RIGHT} = $node;
+	$node->{DATA} = [ @_ ];
+	return bless $node => $class;
+    } 
+
+If you create nodes like that, they (currently) won't go away unless you
+break their self reference yourself.  (In other words, this is not to be
+construed as a feature, and you shouldn't depend on it.)
+
+Almost.
+
+When an interpreter thread finally shuts down (usually when your program
+exits), then a rather costly but complete mark-and-sweep style of garbage
+collection is performed, and everything allocated by that thread gets
+destroyed.  This is essential to support Perl as an embedded or a
+multithreadable language.  For example, this program demonstrates Perl's
+two-phased garbage collection:
+
+    #!/usr/bin/perl 
+    package Subtle;
+
+    sub new {
+	my $test;
+	$test = \$test;
+	warn "CREATING " . \$test;
+	return bless \$test;
+    } 
+
+    sub DESTROY {
+	my $self = shift;
+	warn "DESTROYING $self";
+    } 
+
+    package main;
+
+    warn "starting program";
+    {
+	my $a = Subtle->new;
+	my $b = Subtle->new;
+	$$a = 0;  # break selfref
+	warn "leaving block";
+    } 
+
+    warn "just exited block";
+    warn "time to die...";
+    exit;
+
+When run as F</tmp/test>, the following output is produced:
+
+    starting program at /tmp/test line 18.
+    CREATING SCALAR(0x8e5b8) at /tmp/test line 7.
+    CREATING SCALAR(0x8e57c) at /tmp/test line 7.
+    leaving block at /tmp/test line 23.
+    DESTROYING Subtle=SCALAR(0x8e5b8) at /tmp/test line 13.
+    just exited block at /tmp/test line 26.
+    time to die... at /tmp/test line 27.
+    DESTROYING Subtle=SCALAR(0x8e57c) during global destruction.
+
+Notice that "global destruction" bit there?  That's the thread
+garbage collector reaching the unreachable.  
+
+Objects are always destructed, even when regular refs aren't and in fact
+are destructed in a separate pass before ordinary refs just to try to
+prevent object destructors from using refs that have been themselves
+destructed.  Plain refs are only garbage collected if the destruct level
+is greater than 0.  You can test the higher levels of global destruction
+by setting the PERL_DESTRUCT_LEVEL environment variable, presuming
+C<-DDEBUGGING> was enabled during perl build time.
+
+A more complete garbage collection strategy will be implemented
+at a future date.
+
+=head1 SEE ALSO
+
+You should also check out L<perlbot> for other object tricks, traps, and tips, 
+as well as L<perlmod> for some style guides on constructing both modules
+and classes.
diff --git a/gnu/usr.bin/perl/pod/perlop.pod b/gnu/usr.bin/perl/pod/perlop.pod
new file mode 100644
index 00000000000..483a686ebb6
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlop.pod
@@ -0,0 +1,1119 @@
+=head1 NAME
+
+perlop - Perl operators and precedence
+
+=head1 SYNOPSIS
+
+Perl operators have the following associativity and precedence,
+listed from highest precedence to lowest.  Note that all operators
+borrowed from C keep the same precedence relationship with each other,
+even where C's precedence is slightly screwy.  (This makes learning
+Perl easier for C folks.)  With very few exceptions, these all 
+operate on scalar values only, not array values.
+
+    left	terms and list operators (leftward)
+    left	->
+    nonassoc	++ --
+    right	**
+    right	! ~ \ and unary + and -
+    left	=~ !~ 
+    left	* / % x
+    left	+ - .
+    left	<< >>
+    nonassoc	named unary operators
+    nonassoc	< > <= >= lt gt le ge
+    nonassoc	== != <=> eq ne cmp
+    left	&
+    left	| ^
+    left	&&
+    left	||
+    nonassoc	..
+    right	?:
+    right	= += -= *= etc.
+    left	, =>
+    nonassoc	list operators (rightward)
+    right	not
+    left	and
+    left	or xor
+
+In the following sections, these operators are covered in precedence order.
+
+=head1 DESCRIPTION
+
+=head2 Terms and List Operators (Leftward)
+
+Any TERM is of highest precedence of Perl.  These includes variables,
+quote and quotelike operators, any expression in parentheses,
+and any function whose arguments are parenthesized.  Actually, there
+aren't really functions in this sense, just list operators and unary
+operators behaving as functions because you put parentheses around
+the arguments.  These are all documented in L<perlfunc>.
+
+If any list operator (print(), etc.) or any unary operator (chdir(), etc.)
+is followed by a left parenthesis as the next token, the operator and
+arguments within parentheses are taken to be of highest precedence,
+just like a normal function call.
+
+In the absence of parentheses, the precedence of list operators such as
+C<print>, C<sort>, or C<chmod> is either very high or very low depending on
+whether you look at the left side of operator or the right side of it.
+For example, in
+
+    @ary = (1, 3, sort 4, 2);
+    print @ary;		# prints 1324
+
+the commas on the right of the sort are evaluated before the sort, but
+the commas on the left are evaluated after.  In other words, list
+operators tend to gobble up all the arguments that follow them, and
+then act like a simple TERM with regard to the preceding expression.
+Note that you have to be careful with parens:
+
+    # These evaluate exit before doing the print:
+    print($foo, exit);	# Obviously not what you want.
+    print $foo, exit;	# Nor is this.
+
+    # These do the print before evaluating exit:
+    (print $foo), exit;	# This is what you want.
+    print($foo), exit;	# Or this.
+    print ($foo), exit;	# Or even this.
+
+Also note that
+
+    print ($foo & 255) + 1, "\n";
+
+probably doesn't do what you expect at first glance.  See 
+L<Named Unary Operators> for more discussion of this.
+
+Also parsed as terms are the C<do {}> and C<eval {}> constructs, as
+well as subroutine and method calls, and the anonymous 
+constructors C<[]> and C<{}>.
+
+See also L<Quote and Quotelike Operators> toward the end of this section,
+as well as L<"I/O Operators">.
+
+=head2 The Arrow Operator
+
+Just as in C and C++, "C<-E<gt>>" is an infix dereference operator.  If the
+right side is either a C<[...]> or C<{...}> subscript, then the left side
+must be either a hard or symbolic reference to an array or hash (or
+a location capable of holding a hard reference, if it's an lvalue (assignable)).
+See L<perlref>.
+
+Otherwise, the right side is a method name or a simple scalar variable
+containing the method name, and the left side must either be an object
+(a blessed reference) or a class name (that is, a package name).
+See L<perlobj>.
+
+=head2 Autoincrement and Autodecrement
+
+"++" and "--" work as in C.  That is, if placed before a variable, they
+increment or decrement the variable before returning the value, and if
+placed after, increment or decrement the variable after returning the value.
+
+The autoincrement operator has a little extra built-in magic to it.  If
+you increment a variable that is numeric, or that has ever been used in
+a numeric context, you get a normal increment.  If, however, the
+variable has only been used in string contexts since it was set, and
+has a value that is not null and matches the pattern
+C</^[a-zA-Z]*[0-9]*$/>, the increment is done as a string, preserving each
+character within its range, with carry:
+
+    print ++($foo = '99');	# prints '100'
+    print ++($foo = 'a0');	# prints 'a1'
+    print ++($foo = 'Az');	# prints 'Ba'
+    print ++($foo = 'zz');	# prints 'aaa'
+
+The autodecrement operator is not magical.
+
+=head2 Exponentiation
+
+Binary "**" is the exponentiation operator.  Note that it binds even more
+tightly than unary minus, so -2**4 is -(2**4), not (-2)**4. (This is
+implemented using C's pow(3) function, which actually works on doubles
+internally.)
+
+=head2 Symbolic Unary Operators
+
+Unary "!" performs logical negation, i.e. "not".  See also C<not> for a lower
+precedence version of this.
+
+Unary "-" performs arithmetic negation if the operand is numeric.  If
+the operand is an identifier, a string consisting of a minus sign
+concatenated with the identifier is returned.  Otherwise, if the string
+starts with a plus or minus, a string starting with the opposite sign
+is returned.  One effect of these rules is that C<-bareword> is equivalent
+to C<"-bareword">.
+
+Unary "~" performs bitwise negation, i.e. 1's complement.
+
+Unary "+" has no effect whatsoever, even on strings.  It is useful
+syntactically for separating a function name from a parenthesized expression
+that would otherwise be interpreted as the complete list of function
+arguments.  (See examples above under L<List Operators>.)
+
+Unary "\" creates a reference to whatever follows it.  See L<perlref>.
+Do not confuse this behavior with the behavior of backslash within a
+string, although both forms do convey the notion of protecting the next
+thing from interpretation.
+
+=head2 Binding Operators
+
+Binary "=~" binds a scalar expression to a pattern match.  Certain operations
+search or modify the string $_ by default.  This operator makes that kind
+of operation work on some other string.  The right argument is a search
+pattern, substitution, or translation.  The left argument is what is
+supposed to be searched, substituted, or translated instead of the default
+$_.  The return value indicates the success of the operation.  (If the
+right argument is an expression rather than a search pattern,
+substitution, or translation, it is interpreted as a search pattern at run
+time.  This is less efficient than an explicit search, since the pattern
+must be compiled every time the expression is evaluated--unless you've
+used C</o>.)
+
+Binary "!~" is just like "=~" except the return value is negated in
+the logical sense.
+
+=head2 Multiplicative Operators
+
+Binary "*" multiplies two numbers.
+
+Binary "/" divides two numbers.
+
+Binary "%" computes the modulus of the two numbers.
+
+Binary "x" is the repetition operator.  In a scalar context, it
+returns a string consisting of the left operand repeated the number of
+times specified by the right operand.  In a list context, if the left
+operand is a list in parens, it repeats the list.
+
+    print '-' x 80;		# print row of dashes
+
+    print "\t" x ($tab/8), ' ' x ($tab%8);	# tab over
+
+    @ones = (1) x 80;		# a list of 80 1's
+    @ones = (5) x @ones;	# set all elements to 5
+
+
+=head2 Additive Operators
+
+Binary "+" returns the sum of two numbers.
+
+Binary "-" returns the difference of two numbers.
+
+Binary "." concatenates two strings.
+
+=head2 Shift Operators
+
+Binary "<<" returns the value of its left argument shifted left by the
+number of bits specified by the right argument.  Arguments should be 
+integers.
+
+Binary ">>" returns the value of its left argument shifted right by the
+number of bits specified by the right argument.  Arguments should be 
+integers.
+
+=head2 Named Unary Operators
+
+The various named unary operators are treated as functions with one
+argument, with optional parentheses.  These include the filetest
+operators, like C<-f>, C<-M>, etc.  See L<perlfunc>.
+
+If any list operator (print(), etc.) or any unary operator (chdir(), etc.)
+is followed by a left parenthesis as the next token, the operator and
+arguments within parentheses are taken to be of highest precedence,
+just like a normal function call.  Examples:
+
+    chdir $foo    || die;	# (chdir $foo) || die
+    chdir($foo)   || die;	# (chdir $foo) || die
+    chdir ($foo)  || die;	# (chdir $foo) || die
+    chdir +($foo) || die;	# (chdir $foo) || die
+
+but, because * is higher precedence than ||:
+
+    chdir $foo * 20;	# chdir ($foo * 20)
+    chdir($foo) * 20;	# (chdir $foo) * 20
+    chdir ($foo) * 20;	# (chdir $foo) * 20
+    chdir +($foo) * 20;	# chdir ($foo * 20)
+
+    rand 10 * 20;	# rand (10 * 20)
+    rand(10) * 20;	# (rand 10) * 20
+    rand (10) * 20;	# (rand 10) * 20
+    rand +(10) * 20;	# rand (10 * 20)
+
+See also L<"List Operators">.
+
+=head2 Relational Operators
+
+Binary "<" returns true if the left argument is numerically less than
+the right argument.
+
+Binary ">" returns true if the left argument is numerically greater
+than the right argument.
+
+Binary "<=" returns true if the left argument is numerically less than
+or equal to the right argument.
+
+Binary ">=" returns true if the left argument is numerically greater
+than or equal to the right argument.
+
+Binary "lt" returns true if the left argument is stringwise less than
+the right argument.
+
+Binary "gt" returns true if the left argument is stringwise greater
+than the right argument.
+
+Binary "le" returns true if the left argument is stringwise less than
+or equal to the right argument.
+
+Binary "ge" returns true if the left argument is stringwise greater
+than or equal to the right argument.
+
+=head2 Equality Operators
+
+Binary "==" returns true if the left argument is numerically equal to
+the right argument.
+
+Binary "!=" returns true if the left argument is numerically not equal
+to the right argument.
+
+Binary "<=>" returns -1, 0, or 1 depending on whether the left argument is numerically
+less than, equal to, or greater than the right argument.
+
+Binary "eq" returns true if the left argument is stringwise equal to
+the right argument.
+
+Binary "ne" returns true if the left argument is stringwise not equal
+to the right argument.
+
+Binary "cmp" returns -1, 0, or 1 depending on whether the left argument is stringwise
+less than, equal to, or greater than the right argument.
+
+=head2 Bitwise And
+
+Binary "&" returns its operators ANDed together bit by bit.
+
+=head2 Bitwise Or and Exclusive Or
+
+Binary "|" returns its operators ORed together bit by bit.
+
+Binary "^" returns its operators XORed together bit by bit.
+
+=head2 C-style Logical And
+
+Binary "&&" performs a short-circuit logical AND operation.  That is,
+if the left operand is false, the right operand is not even evaluated.
+Scalar or list context propagates down to the right operand if it
+is evaluated.
+
+=head2 C-style Logical Or
+
+Binary "||" performs a short-circuit logical OR operation.  That is,
+if the left operand is true, the right operand is not even evaluated.
+Scalar or list context propagates down to the right operand if it
+is evaluated.
+
+The C<||> and C<&&> operators differ from C's in that, rather than returning
+0 or 1, they return the last value evaluated.  Thus, a reasonably portable
+way to find out the home directory (assuming it's not "0") might be:
+
+    $home = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
+	(getpwuid($<))[7] || die "You're homeless!\n";
+
+As more readable alternatives to C<&&> and C<||>, Perl provides "and" and
+"or" operators (see below).  The short-circuit behavior is identical.  The
+precedence of "and" and "or" is much lower, however, so that you can
+safely use them after a list operator without the need for
+parentheses:
+
+    unlink "alpha", "beta", "gamma"
+	    or gripe(), next LINE;
+
+With the C-style operators that would have been written like this:
+
+    unlink("alpha", "beta", "gamma")
+	    || (gripe(), next LINE);
+
+=head2 Range Operator
+
+Binary ".." is the range operator, which is really two different
+operators depending on the context.  In a list context, it returns an
+array of values counting (by ones) from the left value to the right
+value.  This is useful for writing C<for (1..10)> loops and for doing
+slice operations on arrays.  Be aware that under the current implementation,
+a temporary array is created, so you'll burn a lot of memory if you 
+write something like this:
+
+    for (1 .. 1_000_000) {
+	# code
+    } 
+
+In a scalar context, ".." returns a boolean value.  The operator is
+bistable, like a flip-flop, and emulates the line-range (comma) operator
+of B<sed>, B<awk>, and various editors.  Each ".." operator maintains its
+own boolean state.  It is false as long as its left operand is false.
+Once the left operand is true, the range operator stays true until the
+right operand is true, I<AFTER> which the range operator becomes false
+again.  (It doesn't become false till the next time the range operator is
+evaluated.  It can test the right operand and become false on the same
+evaluation it became true (as in B<awk>), but it still returns true once.
+If you don't want it to test the right operand till the next evaluation
+(as in B<sed>), use three dots ("...") instead of two.)  The right
+operand is not evaluated while the operator is in the "false" state, and
+the left operand is not evaluated while the operator is in the "true"
+state.  The precedence is a little lower than || and &&.  The value
+returned is either the null string for false, or a sequence number
+(beginning with 1) for true.  The sequence number is reset for each range
+encountered.  The final sequence number in a range has the string "E0"
+appended to it, which doesn't affect its numeric value, but gives you
+something to search for if you want to exclude the endpoint.  You can
+exclude the beginning point by waiting for the sequence number to be
+greater than 1.  If either operand of scalar ".." is a numeric literal,
+that operand is implicitly compared to the C<$.> variable, the current
+line number.  Examples:
+
+As a scalar operator:
+
+    if (101 .. 200) { print; }	# print 2nd hundred lines
+    next line if (1 .. /^$/);	# skip header lines
+    s/^/> / if (/^$/ .. eof());	# quote body
+
+As a list operator:
+
+    for (101 .. 200) { print; }	# print $_ 100 times
+    @foo = @foo[$[ .. $#foo];	# an expensive no-op
+    @foo = @foo[$#foo-4 .. $#foo];	# slice last 5 items
+
+The range operator (in a list context) makes use of the magical
+autoincrement algorithm if the operands are strings.  You
+can say
+
+    @alphabet = ('A' .. 'Z');
+
+to get all the letters of the alphabet, or
+
+    $hexdigit = (0 .. 9, 'a' .. 'f')[$num & 15];
+
+to get a hexadecimal digit, or
+
+    @z2 = ('01' .. '31');  print $z2[$mday];
+
+to get dates with leading zeros.  If the final value specified is not
+in the sequence that the magical increment would produce, the sequence
+goes until the next value would be longer than the final value
+specified.
+
+=head2 Conditional Operator
+
+Ternary "?:" is the conditional operator, just as in C.  It works much
+like an if-then-else.  If the argument before the ? is true, the
+argument before the : is returned, otherwise the argument after the :
+is returned.  For example:
+
+    printf "I have %d dog%s.\n", $n, 
+	    ($n == 1) ? '' : "s";
+
+Scalar or list context propagates downward into the 2nd
+or 3rd argument, whichever is selected.  
+
+    $a = $ok ? $b : $c;  # get a scalar
+    @a = $ok ? @b : @c;  # get an array
+    $a = $ok ? @b : @c;  # oops, that's just a count!
+
+The operator may be assigned to if both the 2nd and 3rd arguments are
+legal lvalues (meaning that you can assign to them):
+
+    ($a_or_b ? $a : $b) = $c;
+
+This is not necessarily guaranteed to contribute to the readability of your program.
+
+=head2 Assignment Operators
+
+"=" is the ordinary assignment operator.
+
+Assignment operators work as in C.  That is,
+
+    $a += 2;
+
+is equivalent to
+
+    $a = $a + 2;
+
+although without duplicating any side effects that dereferencing the lvalue
+might trigger, such as from tie().  Other assignment operators work similarly.  
+The following are recognized: 
+
+    **=    +=    *=    &=    <<=    &&=
+           -=    /=    |=    >>=    ||=
+           .=    %=    ^=
+	         x=
+
+Note that while these are grouped by family, they all have the precedence
+of assignment.
+
+Unlike in C, the assignment operator produces a valid lvalue.  Modifying
+an assignment is equivalent to doing the assignment and then modifying
+the variable that was assigned to.  This is useful for modifying
+a copy of something, like this:
+
+    ($tmp = $global) =~ tr [A-Z] [a-z];
+
+Likewise,
+
+    ($a += 2) *= 3;
+
+is equivalent to
+
+    $a += 2;
+    $a *= 3;
+
+=head2 Comma Operator
+
+Binary "," is the comma operator.  In a scalar context it evaluates
+its left argument, throws that value away, then evaluates its right
+argument and returns that value.  This is just like C's comma operator.
+
+In a list context, it's just the list argument separator, and inserts
+both its arguments into the list.
+
+The => digraph is mostly just a synonym for the comma operator.  It's useful for
+documenting arguments that come in pairs.  As of release 5.001, it also forces
+any word to the left of it to be interpreted as a string.
+
+=head2 List Operators (Rightward)
+
+On the right side of a list operator, it has very low precedence,
+such that it controls all comma-separated expressions found there.
+The only operators with lower precedence are the logical operators
+"and", "or", and "not", which may be used to evaluate calls to list
+operators without the need for extra parentheses:
+
+    open HANDLE, "filename"
+	or die "Can't open: $!\n";
+
+See also discussion of list operators in L<List Operators (Leftward)>.
+
+=head2 Logical Not
+
+Unary "not" returns the logical negation of the expression to its right.
+It's the equivalent of "!" except for the very low precedence.
+
+=head2 Logical And
+
+Binary "and" returns the logical conjunction of the two surrounding
+expressions.  It's equivalent to && except for the very low
+precedence.  This means that it short-circuits: i.e. the right
+expression is evaluated only if the left expression is true.
+
+=head2 Logical or and Exclusive Or
+
+Binary "or" returns the logical disjunction of the two surrounding
+expressions.  It's equivalent to || except for the very low
+precedence.  This means that it short-circuits: i.e. the right
+expression is evaluated only if the left expression is false.
+
+Binary "xor" returns the exclusive-OR of the two surrounding expressions.
+It cannot short circuit, of course.
+
+=head2 C Operators Missing From Perl
+
+Here is what C has that Perl doesn't:
+
+=over 8
+
+=item unary &
+
+Address-of operator.  (But see the "\" operator for taking a reference.)
+
+=item unary *
+
+Dereference-address operator. (Perl's prefix dereferencing 
+operators are typed: $, @, %, and &.)
+
+=item (TYPE)
+
+Type casting operator.  
+
+=back
+
+=head2 Quote and Quotelike Operators
+
+While we usually think of quotes as literal values, in Perl they
+function as operators, providing various kinds of interpolating and
+pattern matching capabilities.  Perl provides customary quote characters
+for these behaviors, but also provides a way for you to choose your
+quote character for any of them.  In the following table, a C<{}> represents
+any pair of delimiters you choose.  Non-bracketing delimiters use
+the same character fore and aft, but the 4 sorts of brackets 
+(round, angle, square, curly) will all nest.
+
+    Customary  Generic     Meaning    Interpolates
+	''	 q{}	   Literal	   no
+	""	qq{}	   Literal	   yes
+	``	qx{}	   Command	   yes
+		qw{}	  Word list	   no
+	//	 m{}	Pattern match	   yes
+		 s{}{}	 Substitution	   yes
+		tr{}{}	 Translation	   no
+
+For constructs that do interpolation, variables beginning with "C<$>" or "C<@>"
+are interpolated, as are the following sequences:
+
+    \t		tab
+    \n		newline
+    \r		return
+    \f		form feed
+    \b		backspace
+    \a		alarm (bell)
+    \e		escape
+    \033	octal char
+    \x1b	hex char
+    \c[		control char
+    \l		lowercase next char
+    \u		uppercase next char
+    \L		lowercase till \E
+    \U		uppercase till \E
+    \E		end case modification
+    \Q		quote regexp metacharacters till \E
+
+Patterns are subject to an additional level of interpretation as a
+regular expression.  This is done as a second pass, after variables are
+interpolated, so that regular expressions may be incorporated into the
+pattern from the variables.  If this is not what you want, use C<\Q> to
+interpolate a variable literally.
+
+Apart from the above, there are no multiple levels of interpolation.  In
+particular, contrary to the expectations of shell programmers, backquotes
+do I<NOT> interpolate within double quotes, nor do single quotes impede
+evaluation of variables when used within double quotes.
+
+=head2 Regexp Quotelike Operators
+
+Here are the quotelike operators that apply to pattern
+matching and related activities.
+
+=over 8
+
+=item ?PATTERN?
+
+This is just like the C</pattern/> search, except that it matches only
+once between calls to the reset() operator.  This is a useful
+optimization when you only want to see the first occurrence of
+something in each file of a set of files, for instance.  Only C<??>
+patterns local to the current package are reset.
+
+This usage is vaguely deprecated, and may be removed in some future
+version of Perl.
+
+=item m/PATTERN/gimosx
+
+=item /PATTERN/gimosx
+
+Searches a string for a pattern match, and in a scalar context returns
+true (1) or false ('').  If no string is specified via the C<=~> or
+C<!~> operator, the $_ string is searched.  (The string specified with
+C<=~> need not be an lvalue--it may be the result of an expression
+evaluation, but remember the C<=~> binds rather tightly.)  See also
+L<perlre>.
+
+Options are:
+
+    g	Match globally, i.e. find all occurrences.
+    i	Do case-insensitive pattern matching.
+    m	Treat string as multiple lines.
+    o	Only compile pattern once.
+    s	Treat string as single line.
+    x	Use extended regular expressions.
+
+If "/" is the delimiter then the initial C<m> is optional.  With the C<m>
+you can use any pair of non-alphanumeric, non-whitespace characters as
+delimiters.  This is particularly useful for matching Unix path names
+that contain "/", to avoid LTS (leaning toothpick syndrome).
+
+PATTERN may contain variables, which will be interpolated (and the
+pattern recompiled) every time the pattern search is evaluated.  (Note
+that C<$)> and C<$|> might not be interpolated because they look like
+end-of-string tests.)  If you want such a pattern to be compiled only
+once, add a C</o> after the trailing delimiter.  This avoids expensive
+run-time recompilations, and is useful when the value you are
+interpolating won't change over the life of the script.  However, mentioning
+C</o> constitutes a promise that you won't change the variables in the pattern.
+If you change them, Perl won't even notice.
+
+If the PATTERN evaluates to a null string, the last
+successfully executed regular expression is used instead.
+
+If used in a context that requires a list value, a pattern match returns a
+list consisting of the subexpressions matched by the parentheses in the
+pattern, i.e. ($1, $2, $3...).  (Note that here $1 etc. are also set, and
+that this differs from Perl 4's behavior.)  If the match fails, a null
+array is returned.  If the match succeeds, but there were no parentheses,
+a list value of (1) is returned.
+
+Examples:
+
+    open(TTY, '/dev/tty');
+    <TTY> =~ /^y/i && foo();	# do foo if desired
+
+    if (/Version: *([0-9.]*)/) { $version = $1; }
+
+    next if m#^/usr/spool/uucp#;
+
+    # poor man's grep
+    $arg = shift;
+    while (<>) {
+	print if /$arg/o;	# compile only once
+    }
+
+    if (($F1, $F2, $Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))
+
+This last example splits $foo into the first two words and the
+remainder of the line, and assigns those three fields to $F1, $F2 and
+$Etc.  The conditional is true if any variables were assigned, i.e. if
+the pattern matched.
+
+The C</g> modifier specifies global pattern matching--that is, matching
+as many times as possible within the string.  How it behaves depends on
+the context.  In a list context, it returns a list of all the
+substrings matched by all the parentheses in the regular expression.
+If there are no parentheses, it returns a list of all the matched
+strings, as if there were parentheses around the whole pattern.
+
+In a scalar context, C<m//g> iterates through the string, returning TRUE
+each time it matches, and FALSE when it eventually runs out of
+matches.  (In other words, it remembers where it left off last time and
+restarts the search at that point.  You can actually find the current
+match position of a string using the pos() function--see L<perlfunc>.)
+If you modify the string in any way, the match position is reset to the
+beginning.  Examples:
+
+    # list context
+    ($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);
+
+    # scalar context
+    $/ = ""; $* = 1;  # $* deprecated in Perl 5
+    while ($paragraph = <>) {
+	while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
+	    $sentences++;
+	}
+    }
+    print "$sentences\n";
+
+=item q/STRING/
+
+=item C<'STRING'>
+
+A single-quoted, literal string.  Backslashes are ignored, unless
+followed by the delimiter or another backslash, in which case the
+delimiter or backslash is interpolated.
+
+    $foo = q!I said, "You said, 'She said it.'"!;
+    $bar = q('This is it.');
+
+=item qq/STRING/
+
+=item "STRING"
+
+A double-quoted, interpolated string.
+
+    $_ .= qq
+     (*** The previous line contains the naughty word "$1".\n)
+		if /(tcl|rexx|python)/;      # :-)
+
+=item qx/STRING/
+
+=item `STRING`
+
+A string which is interpolated and then executed as a system command.
+The collected standard output of the command is returned.  In scalar
+context, it comes back as a single (potentially multi-line) string.
+In list context, returns a list of lines (however you've defined lines
+with $/ or $INPUT_RECORD_SEPARATOR).
+
+    $today = qx{ date };
+
+See L<I/O Operators> for more discussion.
+
+=item qw/STRING/
+
+Returns a list of the words extracted out of STRING, using embedded
+whitespace as the word delimiters.  It is exactly equivalent to
+
+    split(' ', q/STRING/);
+
+Some frequently seen examples:
+
+    use POSIX qw( setlocale localeconv )
+    @EXPORT = qw( foo bar baz );
+
+=item s/PATTERN/REPLACEMENT/egimosx
+
+Searches a string for a pattern, and if found, replaces that pattern
+with the replacement text and returns the number of substitutions
+made.  Otherwise it returns false (0).
+
+If no string is specified via the C<=~> or C<!~> operator, the C<$_>
+variable is searched and modified.  (The string specified with C<=~> must
+be a scalar variable, an array element, a hash element, or an assignment
+to one of those, i.e. an lvalue.)
+
+If the delimiter chosen is single quote, no variable interpolation is
+done on either the PATTERN or the REPLACEMENT.  Otherwise, if the
+PATTERN contains a $ that looks like a variable rather than an
+end-of-string test, the variable will be interpolated into the pattern
+at run-time.  If you only want the pattern compiled once the first time
+the variable is interpolated, use the C</o> option.  If the pattern
+evaluates to a null string, the last successfully executed regular
+expression is used instead.  See L<perlre> for further explanation on these.
+
+Options are:
+
+    e	Evaluate the right side as an expression.
+    g	Replace globally, i.e. all occurrences.
+    i	Do case-insensitive pattern matching.
+    m	Treat string as multiple lines.
+    o	Only compile pattern once.
+    s	Treat string as single line.
+    x	Use extended regular expressions.
+
+Any non-alphanumeric, non-whitespace delimiter may replace the
+slashes.  If single quotes are used, no interpretation is done on the
+replacement string (the C</e> modifier overrides this, however).  If
+backquotes are used, the replacement string is a command to execute
+whose output will be used as the actual replacement text.  If the
+PATTERN is delimited by bracketing quotes, the REPLACEMENT has its own
+pair of quotes, which may or may not be bracketing quotes, e.g.
+C<s(foo)(bar)> or C<sE<lt>fooE<gt>/bar/>.  A C</e> will cause the
+replacement portion to be interpreter as a full-fledged Perl expression
+and eval()ed right then and there.  It is, however, syntax checked at
+compile-time.
+
+Examples:
+
+    s/\bgreen\b/mauve/g;		# don't change wintergreen
+
+    $path =~ s|/usr/bin|/usr/local/bin|;
+
+    s/Login: $foo/Login: $bar/; # run-time pattern
+
+    ($foo = $bar) =~ s/this/that/;
+
+    $count = ($paragraph =~ s/Mister\b/Mr./g);
+
+    $_ = 'abc123xyz';
+    s/\d+/$&*2/e;		# yields 'abc246xyz'
+    s/\d+/sprintf("%5d",$&)/e;	# yields 'abc  246xyz'
+    s/\w/$& x 2/eg;		# yields 'aabbcc  224466xxyyzz'
+
+    s/%(.)/$percent{$1}/g;	# change percent escapes; no /e
+    s/%(.)/$percent{$1} || $&/ge;	# expr now, so /e
+    s/^=(\w+)/&pod($1)/ge;	# use function call
+
+    # /e's can even nest;  this will expand
+    # simple embedded variables in $_
+    s/(\$\w+)/$1/eeg;
+
+    # Delete C comments.
+    $program =~ s {
+	/\*	# Match the opening delimiter.
+	.*?	# Match a minimal number of characters.
+	\*/	# Match the closing delimiter.
+    } []gsx;
+
+    s/^\s*(.*?)\s*$/$1/;	# trim white space
+
+    s/([^ ]*) *([^ ]*)/$2 $1/;	# reverse 1st two fields
+
+Note the use of $ instead of \ in the last example.  Unlike 
+B<sed>, we only use the \<I<digit>> form in the left hand side.
+Anywhere else it's $<I<digit>>.
+
+Occasionally, you can't just use a C</g> to get all the changes
+to occur.  Here are two common cases:
+
+    # put commas in the right places in an integer
+    1 while s/(.*\d)(\d\d\d)/$1,$2/g;      # perl4
+    1 while s/(\d)(\d\d\d)(?!\d)/$1,$2/g;  # perl5
+
+    # expand tabs to 8-column spacing
+    1 while s/\t+/' ' x (length($&)*8 - length($`)%8)/e;
+
+
+=item tr/SEARCHLIST/REPLACEMENTLIST/cds
+
+=item y/SEARCHLIST/REPLACEMENTLIST/cds
+
+Translates all occurrences of the characters found in the search list
+with the corresponding character in the replacement list.  It returns
+the number of characters replaced or deleted.  If no string is
+specified via the =~ or !~ operator, the $_ string is translated.  (The
+string specified with =~ must be a scalar variable, an array element,
+or an assignment to one of those, i.e. an lvalue.)  For B<sed> devotees,
+C<y> is provided as a synonym for C<tr>.  If the SEARCHLIST is
+delimited by bracketing quotes, the REPLACEMENTLIST has its own pair of
+quotes, which may or may not be bracketing quotes, e.g. C<tr[A-Z][a-z]>
+or C<tr(+-*/)/ABCD/>.
+
+Options:
+
+    c	Complement the SEARCHLIST.
+    d	Delete found but unreplaced characters.
+    s	Squash duplicate replaced characters.
+
+If the C</c> modifier is specified, the SEARCHLIST character set is
+complemented.  If the C</d> modifier is specified, any characters specified
+by SEARCHLIST not found in REPLACEMENTLIST are deleted.  (Note
+that this is slightly more flexible than the behavior of some B<tr>
+programs, which delete anything they find in the SEARCHLIST, period.)
+If the C</s> modifier is specified, sequences of characters that were
+translated to the same character are squashed down to a single instance of the
+character.
+
+If the C</d> modifier is used, the REPLACEMENTLIST is always interpreted
+exactly as specified.  Otherwise, if the REPLACEMENTLIST is shorter
+than the SEARCHLIST, the final character is replicated till it is long
+enough.  If the REPLACEMENTLIST is null, the SEARCHLIST is replicated.
+This latter is useful for counting characters in a class or for
+squashing character sequences in a class.
+
+Examples:
+
+    $ARGV[1] =~ tr/A-Z/a-z/;	# canonicalize to lower case
+
+    $cnt = tr/*/*/;		# count the stars in $_
+
+    $cnt = $sky =~ tr/*/*/;	# count the stars in $sky
+
+    $cnt = tr/0-9//;		# count the digits in $_
+
+    tr/a-zA-Z//s;		# bookkeeper -> bokeper
+
+    ($HOST = $host) =~ tr/a-z/A-Z/;
+
+    tr/a-zA-Z/ /cs;		# change non-alphas to single space
+
+    tr [\200-\377]
+       [\000-\177];		# delete 8th bit
+
+If multiple translations are given for a character, only the first one is used:
+
+    tr/AAA/XYZ/
+
+will translate any A to X.
+
+Note that because the translation table is built at compile time, neither
+the SEARCHLIST nor the REPLACEMENTLIST are subjected to double quote
+interpolation.  That means that if you want to use variables, you must use
+an eval():
+
+    eval "tr/$oldlist/$newlist/";
+    die $@ if $@;
+
+    eval "tr/$oldlist/$newlist/, 1" or die $@;
+
+=back
+
+=head2 I/O Operators
+
+There are several I/O operators you should know about.  
+A string is enclosed by backticks (grave accents) first undergoes
+variable substitution just like a double quoted string.  It is then
+interpreted as a command, and the output of that command is the value
+of the pseudo-literal, like in a shell.  In a scalar context, a single
+string consisting of all the output is returned.  In a list context,
+a list of values is returned, one for each line of output.  (You can
+set C<$/> to use a different line terminator.)  The command is executed
+each time the pseudo-literal is evaluated.  The status value of the
+command is returned in C<$?> (see L<perlvar> for the interpretation
+of C<$?>).  Unlike in B<csh>, no translation is done on the return
+data--newlines remain newlines.  Unlike in any of the shells, single
+quotes do not hide variable names in the command from interpretation.
+To pass a $ through to the shell you need to hide it with a backslash.
+The generalized form of backticks is C<qx//>.  (Because backticks
+always undergo shell expansion as well, see L<perlsec> for 
+security concerns.)
+
+Evaluating a filehandle in angle brackets yields the next line from
+that file (newline included, so it's never false until end of file, at
+which time an undefined value is returned).  Ordinarily you must assign
+that value to a variable, but there is one situation where an automatic
+assignment happens.  I<If and ONLY if> the input symbol is the only
+thing inside the conditional of a C<while> loop, the value is
+automatically assigned to the variable C<$_>.  The assigned value is
+then tested to see if it is defined.  (This may seem like an odd thing
+to you, but you'll use the construct in almost every Perl script you
+write.)  Anyway, the following lines are equivalent to each other:
+
+    while (defined($_ = <STDIN>)) { print; }
+    while (<STDIN>) { print; }
+    for (;<STDIN>;) { print; }
+    print while defined($_ = <STDIN>);
+    print while <STDIN>;
+
+The filehandles STDIN, STDOUT and STDERR are predefined.  (The
+filehandles C<stdin>, C<stdout> and C<stderr> will also work except in
+packages, where they would be interpreted as local identifiers rather
+than global.)  Additional filehandles may be created with the open()
+function.  See L<perlfunc/open()> for details on this.
+
+If a <FILEHANDLE> is used in a context that is looking for a list, a
+list consisting of all the input lines is returned, one line per list
+element.  It's easy to make a I<LARGE> data space this way, so use with
+care.
+
+The null filehandle E<lt>E<gt> is special and can be used to emulate the
+behavior of B<sed> and B<awk>.  Input from E<lt>E<gt> comes either from
+standard input, or from each file listed on the command line.  Here's
+how it works: the first time E<lt>E<gt> is evaluated, the @ARGV array is
+checked, and if it is null, C<$ARGV[0]> is set to "-", which when opened
+gives you standard input.  The @ARGV array is then processed as a list
+of filenames.  The loop
+
+    while (<>) {
+	...			# code for each line
+    }
+
+is equivalent to the following Perl-like pseudo code:
+
+    unshift(@ARGV, '-') if $#ARGV < $[;
+    while ($ARGV = shift) {
+	open(ARGV, $ARGV);
+	while (<ARGV>) {
+	    ...		# code for each line
+	}
+    }
+
+except that it isn't so cumbersome to say, and will actually work.  It
+really does shift array @ARGV and put the current filename into variable
+$ARGV.  It also uses filehandle I<ARGV> internally--E<lt>E<gt> is just a synonym
+for <ARGV>, which is magical.  (The pseudo code above doesn't work
+because it treats <ARGV> as non-magical.)
+
+You can modify @ARGV before the first E<lt>E<gt> as long as the array ends up
+containing the list of filenames you really want.  Line numbers (C<$.>)
+continue as if the input were one big happy file.  (But see example
+under eof() for how to reset line numbers on each file.)
+
+If you want to set @ARGV to your own list of files, go right ahead.  If
+you want to pass switches into your script, you can use one of the 
+Getopts modules or put a loop on the front like this:
+
+    while ($_ = $ARGV[0], /^-/) {
+	shift;
+        last if /^--$/;
+	if (/^-D(.*)/) { $debug = $1 }
+	if (/^-v/)     { $verbose++  }
+	...		# other switches
+    }
+    while (<>) {
+	...		# code for each line
+    }
+
+The E<lt>E<gt> symbol will return FALSE only once.  If you call it again after
+this it will assume you are processing another @ARGV list, and if you
+haven't set @ARGV, will input from STDIN.
+
+If the string inside the angle brackets is a reference to a scalar
+variable (e.g. <$foo>), then that variable contains the name of the
+filehandle to input from, or a reference to the same.  For example:
+
+    $fh = \*STDIN;
+    $line = <$fh>;
+
+If the string inside angle brackets is not a filehandle or a scalar
+variable containing a filehandle name or reference, then it is interpreted
+as a filename pattern to be globbed, and either a list of filenames or the
+next filename in the list is returned, depending on context.  One level of
+$ interpretation is done first, but you can't say C<E<lt>$fooE<gt>>
+because that's an indirect filehandle as explained in the previous
+paragraph.  In older version of Perl, programmers would insert curly
+brackets to force interpretation as a filename glob: C<E<lt>${foo}E<gt>>.
+These days, it's considered cleaner to call the internal function directly
+as C<glob($foo)>, which is probably the right way to have done it in the
+first place.)  Example:
+
+    while (<*.c>) {
+	chmod 0644, $_;
+    }
+
+is equivalent to
+
+    open(FOO, "echo *.c | tr -s ' \t\r\f' '\\012\\012\\012\\012'|");
+    while (<FOO>) {
+	chop;
+	chmod 0644, $_;
+    }
+
+In fact, it's currently implemented that way.  (Which means it will not
+work on filenames with spaces in them unless you have csh(1) on your
+machine.)  Of course, the shortest way to do the above is:
+
+    chmod 0644, <*.c>;
+
+Because globbing invokes a shell, it's often faster to call readdir() yourself
+and just do your own grep() on the filenames.  Furthermore, due to its current
+implementation of using a shell, the glob() routine may get "Arg list too 
+long" errors (unless you've installed tcsh(1L) as F</bin/csh>).
+
+A glob only evaluates its (embedded) argument when it is starting a new
+list.  All values must be read before it will start over.  In a list
+context this isn't important, because you automatically get them all
+anyway.  In a scalar context, however, the operator returns the next value
+each time it is called, or a FALSE value if you've just run out.  Again,
+FALSE is returned only once.  So if you're expecting a single value from
+a glob, it is much better to say
+
+    ($file) = <blurch*>;
+
+than
+
+    $file = <blurch*>;
+
+because the latter will alternate between returning a filename and
+returning FALSE.  
+
+It you're trying to do variable interpolation, it's definitely better
+to use the glob() function, because the older notation can cause people
+to become confused with the indirect filehandle notatin.
+
+    @files = glob("$dir/*.[ch]");
+    @files = glob($files[$i]);
+
+=head2 Constant Folding
+
+Like C, Perl does a certain amount of expression evaluation at
+compile time, whenever it determines that all of the arguments to an
+operator are static and have no side effects.  In particular, string
+concatenation happens at compile time between literals that don't do
+variable substitution.  Backslash interpretation also happens at
+compile time.  You can say
+
+    'Now is the time for all' . "\n" .
+	'good men to come to.'
+
+and this all reduces to one string internally.  Likewise, if 
+you say
+
+    foreach $file (@filenames) {
+	if (-s $file > 5 + 100 * 2**16) { ... }
+    } 
+
+the compiler will pre-compute the number that
+expression represents so that the interpreter
+won't have to.
+
+
+=head2 Integer arithmetic
+
+By default Perl assumes that it must do most of its arithmetic in
+floating point.  But by saying
+
+    use integer;
+
+you may tell the compiler that it's okay to use integer operations
+from here to the end of the enclosing BLOCK.  An inner BLOCK may
+countermand this by saying 
+
+    no integer;
+
+which lasts until the end of that BLOCK.
+
diff --git a/gnu/usr.bin/perl/pod/perlovl.pod b/gnu/usr.bin/perl/pod/perlovl.pod
new file mode 100644
index 00000000000..208456d239e
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlovl.pod
@@ -0,0 +1,15 @@
+=head1 NAME
+
+perlovl - overload perl mathematical functions [superseded]
+
+=head1 DESCRIPTION
+
+This man page has been superseded by L<overload>.
+
+=head1 WARNING
+
+The old interface involving %OVERLOAD is deprecated and will go away
+RSN. Convert your scripts to
+use overload ...;
+style.
+
diff --git a/gnu/usr.bin/perl/pod/perlpod.pod b/gnu/usr.bin/perl/pod/perlpod.pod
new file mode 100644
index 00000000000..6566ffb357d
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlpod.pod
@@ -0,0 +1,160 @@
+=head1 NAME
+
+perlpod - plain old documentation
+
+=head1 DESCRIPTION
+
+A pod-to-whatever translator reads a pod file paragraph by paragraph,
+and translates it to the appropriate output format.  There are
+three kinds of paragraphs:
+
+=over 4
+
+=item *
+
+A verbatim paragraph, distinguished by being indented (that is,
+it starts with space or tab).  It should be reproduced exactly,
+with tabs assumed to be on 8-column boundaries.  There are no
+special formatting escapes, so you can't italicize or anything
+like that.  A \ means \, and nothing else.
+
+=item *
+
+A command.  All command paragraphs start with "=", followed by an
+identifier, followed by arbitrary text that the command can
+use however it pleases.  Currently recognized commands are
+
+    =head1 heading
+    =head2 heading
+    =item text
+    =over N
+    =back
+    =cut
+    =pod
+
+The "=pod" directive does nothing beyond telling the compiler to lay
+off of through the next "=cut".  It's useful for adding another 
+paragraph to the doc if you're mixing up code and pod a lot.  
+
+Head1 and head2 produce first and second level headings, with the text on
+the same paragraph as "=headn" forming the heading description.
+
+Item, over, and back require a little more explanation: Over starts a
+section specifically for the generation of a list using =item commands. At
+the end of your list, use =back to end it. You will probably want to give
+"4" as the number to =over, as some formatters will use this for indention.
+This should probably be a default. Note also that there are some basic rules
+to using =item: don't use them outside of an =over/=back block, use at least
+one inside an =over/=back block, you don't _have_ to include the =back if
+the list just runs off the document, and perhaps most importantly, keep the
+items consistent: either use "=item *" for all of them, to produce bullets,
+or use "=item 1.", "=item 2.", etc., to produce numbered lists, or use
+"=item foo", "=item bar", etc., i.e., things that looks nothing like bullets
+or numbers. If you start with bullets or numbers, stick with them, as many
+formatters you the first =item type to decide how to format the list.  
+
+And don't forget, when using any command, that that command lasts up until
+the end of the B<paragraph>, not the line. Hence in the examples below, you
+can see the blank lines after each command to end it's paragraph.
+
+Some examples of lists include:
+
+ =over 4
+
+ =item *
+
+ First item
+
+ =item *
+
+ Second item
+
+ =back
+
+ =over 4
+
+ =item Foo()
+
+ Description of Foo function
+
+ =item Bar()
+
+ Description of Bar function
+
+ =back
+
+=item *
+
+An ordinary block of text.  It will be filled, and maybe even
+justified.  Certain interior sequences are recognized both
+here and in commands:
+
+    I<text>     italicize text, used for emphasis or variables
+    B<text>     embolden text, used for switches and programs
+    S<text>     text contains non-breaking spaces
+    C<code>	literal code 
+    L<name>     A link (cross reference) to name
+		    L<name>		manpage
+		    L<name/ident>	item in manpage
+		    L<name/"sec">	section in other manpage
+		    L<"sec">		section in this manpage
+					(the quotes are optional)
+		    L</"sec">		ditto
+    F<file>	Used for filenames
+    X<index>	An index entry
+    Z<>         A zero-width character
+
+That's it.  The intent is simplicity, not power.  I wanted paragraphs
+to look like paragraphs (block format), so that they stand out
+visually, and so that I could run them through fmt easily to reformat
+them (that's F7 in my version of B<vi>).  I wanted the translator (and not
+me) to worry about whether " or ' is a left quote or a right quote
+within filled text, and I wanted it to leave the quotes alone dammit in
+verbatim mode, so I could slurp in a working program, shift it over 4
+spaces, and have it print out, er, verbatim.  And presumably in a
+constant width font.
+
+In particular, you can leave things like this verbatim in your text:
+
+    Perl
+    FILEHANDLE
+    $variable
+    function()
+    manpage(3r)
+
+Doubtless a few other commands or sequences will need to be added along
+the way, but I've gotten along surprisingly well with just these.
+
+Note that I'm not at all claiming this to be sufficient for producing a
+book.  I'm just trying to make an idiot-proof common source for nroff,
+TeX, and other markup languages, as used for online documentation.
+Translators exist for B<pod2man>  (that's for nroff(1) and troff(1)),
+B<pod2html>, B<pod2latex>, and B<pod2fm>.
+
+=head1 Embedding Pods in Perl Modules
+
+You can embed pod documentation in your Perl scripts.  Start your
+documentation with a =head1 command at the beg, and end it with 
+an =cut command.  Perl will ignore the pod text.  See any of the
+supplied library modules for examples.  If you're going to put
+your pods at the end of the file, and you're using an __END__
+or __DATA__ cut mark, make sure to put a blank line there before
+the first pod directive.
+
+    __END__
+
+    =head1 NAME
+
+    modern - I am a modern module
+
+If you had not had that blank line there, then the translators wouldn't
+have seen it.
+
+=head1 SEE ALSO
+
+L<pod2man> and L<perlsyn/"PODs: Embedded Documentation">
+
+=head1 AUTHOR
+
+Larry Wall
+
diff --git a/gnu/usr.bin/perl/pod/perlre.pod b/gnu/usr.bin/perl/pod/perlre.pod
new file mode 100644
index 00000000000..5446746e910
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlre.pod
@@ -0,0 +1,530 @@
+=head1 NAME
+
+perlre - Perl regular expressions
+
+=head1 DESCRIPTION
+
+This page describes the syntax of regular expressions in Perl.  For a
+description of how to actually I<use> regular expressions in matching
+operations, plus various examples of the same, see C<m//> and C<s///> in
+L<perlop>.
+
+The matching operations can
+have various modifiers, some of which relate to the interpretation of
+the regular expression inside.  These are:
+
+    i   Do case-insensitive pattern matching.
+    m   Treat string as multiple lines.
+    s   Treat string as single line.
+    x   Extend your pattern's legibility with whitespace and comments.
+
+These are usually written as "the C</x> modifier", even though the delimiter
+in question might not actually be a slash.  In fact, any of these
+modifiers may also be embedded within the regular expression itself using
+the new C<(?...)> construct.  See below.
+
+The C</x> modifier itself needs a little more explanation.  It tells
+the regular expression parser to ignore whitespace that is not
+backslashed or within a character class.  You can use this to break up
+your regular expression into (slightly) more readable parts.  The C<#>
+character is also treated as a metacharacter introducing a comment,
+just as in ordinary Perl code.  Taken together, these features go a
+long way towards making Perl 5 a readable language.  See the C comment
+deletion code in L<perlop>.
+
+=head2 Regular Expressions
+
+The patterns used in pattern matching are regular expressions such as
+those supplied in the Version 8 regexp routines.  (In fact, the
+routines are derived (distantly) from Henry Spencer's freely
+redistributable reimplementation of the V8 routines.)
+See L<Version 8 Regular Expressions> for details.
+
+In particular the following metacharacters have their standard I<egrep>-ish
+meanings:
+
+    \	Quote the next metacharacter
+    ^	Match the beginning of the line
+    .	Match any character (except newline)
+    $	Match the end of the line (or before newline at the end)
+    |	Alternation
+    ()	Grouping
+    []	Character class
+
+By default, the "^" character is guaranteed to match only at the
+beginning of the string, the "$" character only at the end (or before the
+newline at the end) and Perl does certain optimizations with the
+assumption that the string contains only one line.  Embedded newlines
+will not be matched by "^" or "$".  You may, however, wish to treat a
+string as a multi-line buffer, such that the "^" will match after any
+newline within the string, and "$" will match before any newline.  At the
+cost of a little more overhead, you can do this by using the /m modifier
+on the pattern match operator.  (Older programs did this by setting C<$*>,
+but this practice is deprecated in Perl 5.)
+
+To facilitate multi-line substitutions, the "." character never matches a
+newline unless you use the C</s> modifier, which tells Perl to pretend
+the string is a single line--even if it isn't.  The C</s> modifier also
+overrides the setting of C<$*>, in case you have some (badly behaved) older
+code that sets it in another module.
+
+The following standard quantifiers are recognized:
+
+    *	   Match 0 or more times
+    +	   Match 1 or more times
+    ?	   Match 1 or 0 times
+    {n}    Match exactly n times
+    {n,}   Match at least n times
+    {n,m}  Match at least n but not more than m times
+
+(If a curly bracket occurs in any other context, it is treated
+as a regular character.)  The "*" modifier is equivalent to C<{0,}>, the "+"
+modifier to C<{1,}>, and the "?" modifier to C<{0,1}>.  n and m are limited
+to integral values less than 65536.
+
+By default, a quantified subpattern is "greedy", that is, it will match as
+many times as possible without causing the rest of the pattern not to match.  
+The standard quantifiers are all "greedy", in that they match as many
+occurrences as possible (given a particular starting location) without
+causing the pattern to fail.  If you want it to match the minimum number
+of times possible, follow the quantifier with a "?" after any of them.
+Note that the meanings don't change, just the "gravity":
+
+    *?	   Match 0 or more times
+    +?	   Match 1 or more times
+    ??	   Match 0 or 1 time
+    {n}?   Match exactly n times
+    {n,}?  Match at least n times
+    {n,m}? Match at least n but not more than m times
+
+Since patterns are processed as double quoted strings, the following
+also work:
+
+    \t		tab
+    \n		newline
+    \r		return
+    \f		form feed
+    \a		alarm (bell)
+    \e		escape (think troff)
+    \033	octal char (think of a PDP-11)
+    \x1B	hex char
+    \c[		control char
+    \l		lowercase next char (think vi)
+    \u		uppercase next char (think vi)
+    \L		lowercase till \E (think vi)
+    \U		uppercase till \E (think vi)
+    \E		end case modification (think vi)
+    \Q		quote regexp metacharacters till \E
+
+In addition, Perl defines the following:
+
+    \w	Match a "word" character (alphanumeric plus "_")
+    \W	Match a non-word character
+    \s	Match a whitespace character
+    \S	Match a non-whitespace character
+    \d	Match a digit character
+    \D	Match a non-digit character
+
+Note that C<\w> matches a single alphanumeric character, not a whole
+word.  To match a word you'd need to say C<\w+>.  You may use C<\w>,
+C<\W>, C<\s>, C<\S>, C<\d> and C<\D> within character classes (though not
+as either end of a range).
+
+Perl defines the following zero-width assertions:
+
+    \b	Match a word boundary
+    \B	Match a non-(word boundary)
+    \A	Match only at beginning of string
+    \Z	Match only at end of string (or before newline at the end)
+    \G	Match only where previous m//g left off
+
+A word boundary (C<\b>) is defined as a spot between two characters that
+has a C<\w> on one side of it and and a C<\W> on the other side of it (in
+either order), counting the imaginary characters off the beginning and
+end of the string as matching a C<\W>.  (Within character classes C<\b>
+represents backspace rather than a word boundary.)  The C<\A> and C<\Z> are
+just like "^" and "$" except that they won't match multiple times when the
+C</m> modifier is used, while "^" and "$" will match at every internal line
+boundary.  To match the actual end of the string, not ignoring newline,
+you can use C<\Z(?!\n)>.
+
+When the bracketing construct C<( ... )> is used, \<digit> matches the
+digit'th substring.  Outside of the pattern, always use "$" instead of "\"
+in front of the digit.  (While the \<digit> notation can on rare occasion work
+outside the current pattern, this should not be relied upon.  See the
+WARNING below.) The scope of $<digit> (and C<$`>, C<$&>, and C<$'>)
+extends to the end of the enclosing BLOCK or eval string, or to the next
+successful pattern match, whichever comes first.  If you want to use
+parentheses to delimit a subpattern (e.g. a set of alternatives) without
+saving it as a subpattern, follow the ( with a ?.
+
+You may have as many parentheses as you wish.  If you have more
+than 9 substrings, the variables $10, $11, ... refer to the
+corresponding substring.  Within the pattern, \10, \11, etc. refer back
+to substrings if there have been at least that many left parens before
+the backreference.  Otherwise (for backward compatibility) \10 is the
+same as \010, a backspace, and \11 the same as \011, a tab.  And so
+on.  (\1 through \9 are always backreferences.)
+
+C<$+> returns whatever the last bracket match matched.  C<$&> returns the
+entire matched string.  ($0 used to return the same thing, but not any
+more.)  C<$`> returns everything before the matched string.  C<$'> returns
+everything after the matched string.  Examples:
+
+    s/^([^ ]*) *([^ ]*)/$2 $1/;     # swap first two words
+
+    if (/Time: (..):(..):(..)/) {
+	$hours = $1;
+	$minutes = $2;
+	$seconds = $3;
+    }
+
+You will note that all backslashed metacharacters in Perl are
+alphanumeric, such as C<\b>, C<\w>, C<\n>.  Unlike some other regular expression
+languages, there are no backslashed symbols that aren't alphanumeric.
+So anything that looks like \\, \(, \), \<, \>, \{, or \} is always
+interpreted as a literal character, not a metacharacter.  This makes it
+simple to quote a string that you want to use for a pattern but that
+you are afraid might contain metacharacters.  Simply quote all the
+non-alphanumeric characters:
+
+    $pattern =~ s/(\W)/\\$1/g;
+
+You can also use the built-in quotemeta() function to do this.
+An even easier way to quote metacharacters right in the match operator
+is to say
+
+    /$unquoted\Q$quoted\E$unquoted/
+
+Perl 5 defines a consistent extension syntax for regular expressions.
+The syntax is a pair of parens with a question mark as the first thing
+within the parens (this was a syntax error in Perl 4).  The character
+after the question mark gives the function of the extension.  Several
+extensions are already supported:
+
+=over 10
+
+=item (?#text)
+
+A comment.  The text is ignored.  If the C</x> switch is used to enable
+whitespace formatting, a simple C<#> will suffice.
+
+=item (?:regexp)
+
+This groups things like "()" but doesn't make backrefences like "()" does.  So
+
+    split(/\b(?:a|b|c)\b/)
+
+is like
+
+    split(/\b(a|b|c)\b/)
+
+but doesn't spit out extra fields.
+
+=item (?=regexp)
+
+A zero-width positive lookahead assertion.  For example, C</\w+(?=\t)/>
+matches a word followed by a tab, without including the tab in C<$&>.
+
+=item (?!regexp)
+
+A zero-width negative lookahead assertion.  For example C</foo(?!bar)/>
+matches any occurrence of "foo" that isn't followed by "bar".  Note
+however that lookahead and lookbehind are NOT the same thing.  You cannot
+use this for lookbehind: C</(?!foo)bar/> will not find an occurrence of
+"bar" that is preceded by something which is not "foo".  That's because
+the C<(?!foo)> is just saying that the next thing cannot be "foo"--and
+it's not, it's a "bar", so "foobar" will match.  You would have to do
+something like C</(?foo)...bar/> for that.   We say "like" because there's
+the case of your "bar" not having three characters before it.  You could
+cover that this way: C</(?:(?!foo)...|^..?)bar/>.  Sometimes it's still
+easier just to say:
+
+    if (/foo/ && $` =~ /bar$/)
+
+
+=item (?imsx)
+
+One or more embedded pattern-match modifiers.  This is particularly
+useful for patterns that are specified in a table somewhere, some of
+which want to be case sensitive, and some of which don't.  The case
+insensitive ones merely need to include C<(?i)> at the front of the
+pattern.  For example:
+
+    $pattern = "foobar";
+    if ( /$pattern/i )
+
+    # more flexible:
+
+    $pattern = "(?i)foobar";
+    if ( /$pattern/ )
+
+=back
+
+The specific choice of question mark for this and the new minimal
+matching construct was because 1) question mark is pretty rare in older
+regular expressions, and 2) whenever you see one, you should stop
+and "question" exactly what is going on.  That's psychology...
+
+=head2 Backtracking
+
+A fundamental feature of regular expression matching involves the notion
+called I<backtracking>.  which is used (when needed) by all regular
+expression quantifiers, namely C<*>, C<*?>, C<+>, C<+?>, C<{n,m}>, and
+C<{n,m}?>.
+
+For a regular expression to match, the I<entire> regular expression must
+match, not just part of it.  So if the beginning of a pattern containing a
+quantifier succeeds in a way that causes later parts in the pattern to
+fail, the matching engine backs up and recalculates the beginning
+part--that's why it's called backtracking.
+
+Here is an example of backtracking:  Let's say you want to find the
+word following "foo" in the string "Food is on the foo table.":
+
+    $_ = "Food is on the foo table.";
+    if ( /\b(foo)\s+(\w+)/i ) {
+	print "$2 follows $1.\n";
+    }
+
+When the match runs, the first part of the regular expression (C<\b(foo)>)
+finds a possible match right at the beginning of the string, and loads up
+$1 with "Foo".  However, as soon as the matching engine sees that there's
+no whitespace following the "Foo" that it had saved in $1, it realizes its
+mistake and starts over again one character after where it had had the
+tentative match.  This time it goes all the way until the next occurrence
+of "foo". The complete regular expression matches this time, and you get
+the expected output of "table follows foo."
+
+Sometimes minimal matching can help a lot.  Imagine you'd like to match
+everything between "foo" and "bar".  Initially, you write something
+like this:
+
+    $_ =  "The food is under the bar in the barn.";
+    if ( /foo(.*)bar/ ) {
+	print "got <$1>\n";
+    }
+
+Which perhaps unexpectedly yields:
+
+  got <d is under the bar in the >
+
+That's because C<.*> was greedy, so you get everything between the
+I<first> "foo" and the I<last> "bar".  In this case, it's more effective
+to use minimal matching to make sure you get the text between a "foo"
+and the first "bar" thereafter.
+
+    if ( /foo(.*?)bar/ ) { print "got <$1>\n" }
+  got <d is under the >
+
+Here's another example: let's say you'd like to match a number at the end
+of a string, and you also want to keep the preceding part the match.
+So you write this:
+
+    $_ = "I have 2 numbers: 53147";
+    if ( /(.*)(\d*)/ ) {				# Wrong!
+	print "Beginning is <$1>, number is <$2>.\n";
+    }
+
+That won't work at all, because C<.*> was greedy and gobbled up the
+whole string. As C<\d*> can match on an empty string the complete
+regular expression matched successfully.
+
+    Beginning is <I have 2: 53147>, number is <>.
+
+Here are some variants, most of which don't work:
+
+    $_ = "I have 2 numbers: 53147";
+    @pats = qw{
+	(.*)(\d*)
+	(.*)(\d+)
+	(.*?)(\d*)
+	(.*?)(\d+)
+	(.*)(\d+)$
+	(.*?)(\d+)$
+	(.*)\b(\d+)$
+	(.*\D)(\d+)$
+    };
+
+    for $pat (@pats) {
+	printf "%-12s ", $pat;
+	if ( /$pat/ ) {
+	    print "<$1> <$2>\n";
+	} else {
+	    print "FAIL\n";
+	}
+    }
+
+That will print out:
+
+    (.*)(\d*)    <I have 2 numbers: 53147> <>
+    (.*)(\d+)    <I have 2 numbers: 5314> <7>
+    (.*?)(\d*)   <> <>
+    (.*?)(\d+)   <I have > <2>
+    (.*)(\d+)$   <I have 2 numbers: 5314> <7>
+    (.*?)(\d+)$  <I have 2 numbers: > <53147>
+    (.*)\b(\d+)$ <I have 2 numbers: > <53147>
+    (.*\D)(\d+)$ <I have 2 numbers: > <53147>
+
+As you see, this can be a bit tricky.  It's important to realize that a
+regular expression is merely a set of assertions that gives a definition
+of success.  There may be 0, 1, or several different ways that the
+definition might succeed against a particular string.  And if there are
+multiple ways it might succeed, you need to understand backtracking in
+order to know which variety of success you will achieve.
+
+When using lookahead assertions and negations, this can all get even
+tricker.  Imagine you'd like to find a sequence of nondigits not 
+followed by "123".  You might try to write that as
+
+	$_ = "ABC123";
+	if ( /^\D*(?!123)/ ) {				# Wrong!
+	    print "Yup, no 123 in $_\n";
+	}
+
+But that isn't going to match; at least, not the way you're hoping.  It
+claims that there is no 123 in the string.  Here's a clearer picture of
+why it that pattern matches, contrary to popular expectations:
+
+    $x = 'ABC123' ;
+    $y = 'ABC445' ;
+
+    print "1: got $1\n" if $x =~ /^(ABC)(?!123)/ ;
+    print "2: got $1\n" if $y =~ /^(ABC)(?!123)/ ;
+
+    print "3: got $1\n" if $x =~ /^(\D*)(?!123)/ ;
+    print "4: got $1\n" if $y =~ /^(\D*)(?!123)/ ;
+
+This prints
+
+    2: got ABC
+    3: got AB
+    4: got ABC
+
+You might have expected test 3 to fail because it just seems to a more
+general purpose version of test 1.  The important difference between
+them is that test 3 contains a quantifier (C<\D*>) and so can use
+backtracking, whereas test 1 will not.  What's happening is
+that you've asked "Is it true that at the start of $x, following 0 or more
+nondigits, you have something that's not 123?"  If the pattern matcher had
+let C<\D*> expand to "ABC", this would have caused the whole pattern to
+fail.  
+The search engine will initially match C<\D*> with "ABC".  Then it will
+try to match C<(?!123> with "123" which, of course, fails.  But because
+a quantifier (C<\D*>) has been used in the regular expression, the
+search engine can backtrack and retry the match differently
+in the hope of matching the complete regular expression.  
+
+Well now, 
+the pattern really, I<really> wants to succeed, so it uses the
+standard regexp backoff-and-retry and lets C<\D*> expand to just "AB" this
+time.  Now there's indeed something following "AB" that is not
+"123".  It's in fact "C123", which suffices.
+
+We can deal with this by using both an assertion and a negation.  We'll
+say that the first part in $1 must be followed by a digit, and in fact, it
+must also be followed by something that's not "123".  Remember that the
+lookaheads are zero-width expressions--they only look, but don't consume
+any of the string in their match.  So rewriting this way produces what
+you'd expect; that is, case 5 will fail, but case 6 succeeds:
+
+    print "5: got $1\n" if $x =~ /^(\D*)(?=\d)(?!123)/ ;
+    print "6: got $1\n" if $y =~ /^(\D*)(?=\d)(?!123)/ ;
+
+    6: got ABC
+
+In other words, the two zero-width assertions next to each other work like
+they're ANDed together, just as you'd use any builtin assertions:  C</^$/>
+matches only if you're at the beginning of the line AND the end of the
+line simultaneously.  The deeper underlying truth is that juxtaposition in
+regular expressions always means AND, except when you write an explicit OR
+using the vertical bar.  C</ab/> means match "a" AND (then) match "b",
+although the attempted matches are made at different positions because "a"
+is not a zero-width assertion, but a one-width assertion.
+
+One warning: particularly complicated regular expressions can take
+exponential time to solve due to the immense number of possible ways they
+can use backtracking to try match.  For example this will take a very long
+time to run
+
+    /((a{0,5}){0,5}){0,5}/
+
+And if you used C<*>'s instead of limiting it to 0 through 5 matches, then
+it would take literally forever--or until you ran out of stack space.
+
+=head2 Version 8 Regular Expressions
+
+In case you're not familiar with the "regular" Version 8 regexp
+routines, here are the pattern-matching rules not described above.
+
+Any single character matches itself, unless it is a I<metacharacter>
+with a special meaning described here or above.  You can cause
+characters which normally function as metacharacters to be interpreted
+literally by prefixing them with a "\" (e.g. "\." matches a ".", not any
+character; "\\" matches a "\").  A series of characters matches that
+series of characters in the target string, so the pattern C<blurfl>
+would match "blurfl" in the target string.
+
+You can specify a character class, by enclosing a list of characters
+in C<[]>, which will match any one of the characters in the list.  If the
+first character after the "[" is "^", the class matches any character not
+in the list.  Within a list, the "-" character is used to specify a
+range, so that C<a-z> represents all the characters between "a" and "z",
+inclusive.
+
+Characters may be specified using a metacharacter syntax much like that
+used in C: "\n" matches a newline, "\t" a tab, "\r" a carriage return,
+"\f" a form feed, etc.  More generally, \I<nnn>, where I<nnn> is a string
+of octal digits, matches the character whose ASCII value is I<nnn>.
+Similarly, \xI<nn>, where I<nn> are hexidecimal digits, matches the
+character whose ASCII value is I<nn>. The expression \cI<x> matches the
+ASCII character control-I<x>.  Finally, the "." metacharacter matches any
+character except "\n" (unless you use C</s>).
+
+You can specify a series of alternatives for a pattern using "|" to
+separate them, so that C<fee|fie|foe> will match any of "fee", "fie",
+or "foe" in the target string (as would C<f(e|i|o)e>).  Note that the
+first alternative includes everything from the last pattern delimiter
+("(", "[", or the beginning of the pattern) up to the first "|", and
+the last alternative contains everything from the last "|" to the next
+pattern delimiter.  For this reason, it's common practice to include
+alternatives in parentheses, to minimize confusion about where they
+start and end.  Note however that "|" is interpreted as a literal with
+square brackets, so if you write C<[fee|fie|foe]> you're really only
+matching C<[feio|]>.
+
+Within a pattern, you may designate subpatterns for later reference by
+enclosing them in parentheses, and you may refer back to the I<n>th
+subpattern later in the pattern using the metacharacter \I<n>.
+Subpatterns are numbered based on the left to right order of their
+opening parenthesis.  Note that a backreference matches whatever
+actually matched the subpattern in the string being examined, not the
+rules for that subpattern.  Therefore, C<(0|0x)\d*\s\1\d*> will
+match "0x1234 0x4321",but not "0x1234 01234", since subpattern 1
+actually matched "0x", even though the rule C<0|0x> could
+potentially match the leading 0 in the second number.
+
+=head2 WARNING on \1 vs $1
+
+Some people get too used to writing things like
+
+    $pattern =~ s/(\W)/\\\1/g;
+
+This is grandfathered for the RHS of a substitute to avoid shocking the
+B<sed> addicts, but it's a dirty habit to get into.  That's because in
+PerlThink, the right-hand side of a C<s///> is a double-quoted string.  C<\1> in
+the usual double-quoted string means a control-A.  The customary Unix
+meaning of C<\1> is kludged in for C<s///>.  However, if you get into the habit
+of doing that, you get yourself into trouble if you then add an C</e>
+modifier.
+
+    s/(\d+)/ \1 + 1 /eg;
+
+Or if you try to do
+
+    s/(\d+)/\1000/;
+
+You can't disambiguate that by saying C<\{1}000>, whereas you can fix it with
+C<${1}000>.  Basically, the operation of interpolation should not be confused
+with the operation of matching a backreference.  Certainly they mean two
+different things on the I<left> side of the C<s///>.
diff --git a/gnu/usr.bin/perl/pod/perlref.pod b/gnu/usr.bin/perl/pod/perlref.pod
new file mode 100644
index 00000000000..d528bc87974
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlref.pod
@@ -0,0 +1,464 @@
+=head1 NAME
+
+perlref - Perl references and nested data structures
+
+=head1 DESCRIPTION
+
+Before release 5 of Perl it was difficult to represent complex data
+structures, because all references had to be symbolic, and even that was
+difficult to do when you wanted to refer to a variable rather than a
+symbol table entry.  Perl 5 not only makes it easier to use symbolic
+references to variables, but lets you have "hard" references to any piece
+of data.  Any scalar may hold a hard reference.  Since arrays and hashes
+contain scalars, you can now easily build arrays of arrays, arrays of
+hashes, hashes of arrays, arrays of hashes of functions, and so on.
+
+Hard references are smart--they keep track of reference counts for you,
+automatically freeing the thing referred to when its reference count
+goes to zero.  If that thing happens to be an object, the object is
+destructed.  See L<perlobj> for more about objects.  (In a sense,
+everything in Perl is an object, but we usually reserve the word for
+references to objects that have been officially "blessed" into a class package.)
+
+A symbolic reference contains the name of a variable, just as a
+symbolic link in the filesystem merely contains the name of a file.  
+The C<*glob> notation is a kind of symbolic reference.  Hard references
+are more like hard links in the file system: merely another way
+at getting at the same underlying object, irrespective of its name.
+
+"Hard" references are easy to use in Perl.  There is just one
+overriding principle:  Perl does no implicit referencing or
+dereferencing.  When a scalar is holding a reference, it always behaves
+as a scalar.  It doesn't magically start being an array or a hash
+unless you tell it so explicitly by dereferencing it.
+
+References can be constructed several ways.
+
+=over 4
+
+=item 1.
+
+By using the backslash operator on a variable, subroutine, or value.
+(This works much like the & (address-of) operator works in C.)  Note
+that this typically creates I<ANOTHER> reference to a variable, since
+there's already a reference to the variable in the symbol table.  But
+the symbol table reference might go away, and you'll still have the
+reference that the backslash returned.  Here are some examples:
+
+    $scalarref = \$foo;
+    $arrayref  = \@ARGV;
+    $hashref   = \%ENV;
+    $coderef   = \&handler;
+    $globref   = \*STDOUT;
+
+
+=item 2.
+
+A reference to an anonymous array can be constructed using square
+brackets:
+
+    $arrayref = [1, 2, ['a', 'b', 'c']];
+
+Here we've constructed a reference to an anonymous array of three elements
+whose final element is itself reference to another anonymous array of three
+elements.  (The multidimensional syntax described later can be used to
+access this.  For example, after the above, $arrayref-E<gt>[2][1] would have
+the value "b".)
+
+Note that taking a reference to an enumerated list is not the same
+as using square brackets--instead it's the same as creating
+a list of references!
+
+    @list = (\$a, \$b, \$c);  
+    @list = \($a, $b, $c);	# same thing!
+
+=item 3.
+
+A reference to an anonymous hash can be constructed using curly
+brackets:
+
+    $hashref = {
+	'Adam'  => 'Eve',
+	'Clyde' => 'Bonnie',
+    };
+
+Anonymous hash and array constructors can be intermixed freely to
+produce as complicated a structure as you want.  The multidimensional
+syntax described below works for these too.  The values above are
+literals, but variables and expressions would work just as well, because
+assignment operators in Perl (even within local() or my()) are executable
+statements, not compile-time declarations.
+
+Because curly brackets (braces) are used for several other things
+including BLOCKs, you may occasionally have to disambiguate braces at the
+beginning of a statement by putting a C<+> or a C<return> in front so
+that Perl realizes the opening brace isn't starting a BLOCK.  The economy and
+mnemonic value of using curlies is deemed worth this occasional extra
+hassle.
+
+For example, if you wanted a function to make a new hash and return a
+reference to it, you have these options:
+
+    sub hashem {        { @_ } }   # silently wrong
+    sub hashem {       +{ @_ } }   # ok
+    sub hashem { return { @_ } }   # ok
+
+=item 4.
+
+A reference to an anonymous subroutine can be constructed by using
+C<sub> without a subname:
+
+    $coderef = sub { print "Boink!\n" };
+
+Note the presence of the semicolon.  Except for the fact that the code
+inside isn't executed immediately, a C<sub {}> is not so much a
+declaration as it is an operator, like C<do{}> or C<eval{}>.  (However, no
+matter how many times you execute that line (unless you're in an
+C<eval("...")>), C<$coderef> will still have a reference to the I<SAME>
+anonymous subroutine.)
+
+Anonymous subroutines act as closures with respect to my() variables,
+that is, variables visible lexically within the current scope.  Closure
+is a notion out of the Lisp world that says if you define an anonymous
+function in a particular lexical context, it pretends to run in that
+context even when it's called outside of the context.
+
+In human terms, it's a funny way of passing arguments to a subroutine when
+you define it as well as when you call it.  It's useful for setting up
+little bits of code to run later, such as callbacks.  You can even
+do object-oriented stuff with it, though Perl provides a different
+mechanism to do that already--see L<perlobj>.
+
+You can also think of closure as a way to write a subroutine template without
+using eval.  (In fact, in version 5.000, eval was the I<only> way to get
+closures.  You may wish to use "require 5.001" if you use closures.)
+
+Here's a small example of how closures works:
+
+    sub newprint {
+	my $x = shift;
+	return sub { my $y = shift; print "$x, $y!\n"; };
+    }
+    $h = newprint("Howdy");
+    $g = newprint("Greetings");
+
+    # Time passes...
+
+    &$h("world");
+    &$g("earthlings");
+
+This prints
+
+    Howdy, world!
+    Greetings, earthlings!
+
+Note particularly that $x continues to refer to the value passed into
+newprint() I<despite> the fact that the "my $x" has seemingly gone out of
+scope by the time the anonymous subroutine runs.  That's what closure
+is all about.
+
+This only applies to lexical variables, by the way.  Dynamic variables
+continue to work as they have always worked.  Closure is not something
+that most Perl programmers need trouble themselves about to begin with.
+
+=item 5.
+
+References are often returned by special subroutines called constructors.
+Perl objects are just references to a special kind of object that happens to know
+which package it's associated with.  Constructors are just special
+subroutines that know how to create that association.  They do so by
+starting with an ordinary reference, and it remains an ordinary reference
+even while it's also being an object.  Constructors are customarily
+named new(), but don't have to be:
+
+    $objref = new Doggie (Tail => 'short', Ears => 'long');
+
+=item 6.
+
+References of the appropriate type can spring into existence if you
+dereference them in a context that assumes they exist.  Since we haven't
+talked about dereferencing yet, we can't show you any examples yet.
+
+=item 7.
+
+References to filehandles can be created by taking a reference to 
+a typeglob.  This is currently the best way to pass filehandles into or
+out of subroutines, or to store them in larger data structures.
+
+    splutter(\*STDOUT);
+    sub splutter {
+	my $fh = shift;
+	print $fh "her um well a hmmm\n";
+    }
+
+    $rec = get_rec(\*STDIN);
+    sub get_rec {
+	my $fh = shift;
+	return scalar <$fh>;
+    }
+
+=back
+
+That's it for creating references.  By now you're probably dying to
+know how to use references to get back to your long-lost data.  There
+are several basic methods.
+
+=over 4
+
+=item 1.
+
+Anywhere you'd put an identifier as part of a variable or subroutine
+name, you can replace the identifier with a simple scalar variable
+containing a reference of the correct type:
+
+    $bar = $$scalarref;
+    push(@$arrayref, $filename);
+    $$arrayref[0] = "January";
+    $$hashref{"KEY"} = "VALUE";
+    &$coderef(1,2,3);
+    print $globref "output\n";
+
+It's important to understand that we are specifically I<NOT> dereferencing
+C<$arrayref[0]> or C<$hashref{"KEY"}> there.  The dereference of the
+scalar variable happens I<BEFORE> it does any key lookups.  Anything more
+complicated than a simple scalar variable must use methods 2 or 3 below.
+However, a "simple scalar" includes an identifier that itself uses method
+1 recursively.  Therefore, the following prints "howdy".
+
+    $refrefref = \\\"howdy";
+    print $$$$refrefref;
+
+=item 2.
+
+Anywhere you'd put an identifier as part of a variable or subroutine
+name, you can replace the identifier with a BLOCK returning a reference
+of the correct type.  In other words, the previous examples could be
+written like this:
+
+    $bar = ${$scalarref};
+    push(@{$arrayref}, $filename);
+    ${$arrayref}[0] = "January";
+    ${$hashref}{"KEY"} = "VALUE";
+    &{$coderef}(1,2,3);
+    $globref->print("output\n");  # iff you use FileHandle
+
+Admittedly, it's a little silly to use the curlies in this case, but
+the BLOCK can contain any arbitrary expression, in particular,
+subscripted expressions:
+
+    &{ $dispatch{$index} }(1,2,3);	# call correct routine 
+
+Because of being able to omit the curlies for the simple case of C<$$x>,
+people often make the mistake of viewing the dereferencing symbols as
+proper operators, and wonder about their precedence.  If they were,
+though, you could use parens instead of braces.  That's not the case.
+Consider the difference below; case 0 is a short-hand version of case 1,
+I<NOT> case 2:
+
+    $$hashref{"KEY"}   = "VALUE";	# CASE 0
+    ${$hashref}{"KEY"} = "VALUE";	# CASE 1
+    ${$hashref{"KEY"}} = "VALUE";	# CASE 2
+    ${$hashref->{"KEY"}} = "VALUE";	# CASE 3
+
+Case 2 is also deceptive in that you're accessing a variable
+called %hashref, not dereferencing through $hashref to the hash
+it's presumably referencing.  That would be case 3.
+
+=item 3.
+
+The case of individual array elements arises often enough that it gets
+cumbersome to use method 2.  As a form of syntactic sugar, the two
+lines like that above can be written:
+
+    $arrayref->[0] = "January";
+    $hashref->{"KEY"} = "VALUE";
+
+The left side of the array can be any expression returning a reference,
+including a previous dereference.  Note that C<$array[$x]> is I<NOT> the
+same thing as C<$array-E<gt>[$x]> here:
+
+    $array[$x]->{"foo"}->[0] = "January";
+
+This is one of the cases we mentioned earlier in which references could
+spring into existence when in an lvalue context.  Before this
+statement, C<$array[$x]> may have been undefined.  If so, it's
+automatically defined with a hash reference so that we can look up
+C<{"foo"}> in it.  Likewise C<$array[$x]-E<gt>{"foo"}> will automatically get
+defined with an array reference so that we can look up C<[0]> in it.
+
+One more thing here.  The arrow is optional I<BETWEEN> brackets
+subscripts, so you can shrink the above down to
+
+    $array[$x]{"foo"}[0] = "January";
+
+Which, in the degenerate case of using only ordinary arrays, gives you
+multidimensional arrays just like C's:
+
+    $score[$x][$y][$z] += 42;
+
+Well, okay, not entirely like C's arrays, actually.  C doesn't know how
+to grow its arrays on demand.  Perl does.
+
+=item 4.
+
+If a reference happens to be a reference to an object, then there are
+probably methods to access the things referred to, and you should probably
+stick to those methods unless you're in the class package that defines the
+object's methods.  In other words, be nice, and don't violate the object's
+encapsulation without a very good reason.  Perl does not enforce
+encapsulation.  We are not totalitarians here.  We do expect some basic
+civility though.
+
+=back
+
+The ref() operator may be used to determine what type of thing the
+reference is pointing to.  See L<perlfunc>.
+
+The bless() operator may be used to associate a reference with a package
+functioning as an object class.  See L<perlobj>.
+
+A typeglob may be dereferenced the same way a reference can, since
+the dereference syntax always indicates the kind of reference desired.
+So C<${*foo}> and C<${\$foo}> both indicate the same scalar variable.
+
+Here's a trick for interpolating a subroutine call into a string:
+
+    print "My sub returned @{[mysub(1,2,3)]} that time.\n";
+
+The way it works is that when the C<@{...}> is seen in the double-quoted
+string, it's evaluated as a block.  The block creates a reference to an
+anonymous array containing the results of the call to C<mysub(1,2,3)>.  So
+the whole block returns a reference to an array, which is then
+dereferenced by C<@{...}> and stuck into the double-quoted string. This
+chicanery is also useful for arbitrary expressions:
+
+    print "That yeilds @{[$n + 5]} widgets\n";
+
+=head2 Symbolic references
+
+We said that references spring into existence as necessary if they are
+undefined, but we didn't say what happens if a value used as a
+reference is already defined, but I<ISN'T> a hard reference.  If you
+use it as a reference in this case, it'll be treated as a symbolic
+reference.  That is, the value of the scalar is taken to be the I<NAME>
+of a variable, rather than a direct link to a (possibly) anonymous
+value.
+
+People frequently expect it to work like this.  So it does.
+
+    $name = "foo";
+    $$name = 1;			# Sets $foo
+    ${$name} = 2;		# Sets $foo
+    ${$name x 2} = 3;		# Sets $foofoo
+    $name->[0] = 4;		# Sets $foo[0]
+    @$name = ();		# Clears @foo
+    &$name();			# Calls &foo() (as in Perl 4)
+    $pack = "THAT";
+    ${"${pack}::$name"} = 5;	# Sets $THAT::foo without eval
+
+This is very powerful, and slightly dangerous, in that it's possible
+to intend (with the utmost sincerity) to use a hard reference, and
+accidentally use a symbolic reference instead.  To protect against
+that, you can say
+
+    use strict 'refs';
+
+and then only hard references will be allowed for the rest of the enclosing
+block.  An inner block may countermand that with 
+
+    no strict 'refs';
+
+Only package variables are visible to symbolic references.  Lexical
+variables (declared with my()) aren't in a symbol table, and thus are
+invisible to this mechanism.  For example:
+
+    local($value) = 10;
+    $ref = \$value;
+    {
+	my $value = 20;
+	print $$ref;
+    } 
+
+This will still print 10, not 20.  Remember that local() affects package
+variables, which are all "global" to the package.
+
+=head2 Not-so-symbolic references
+
+A new feature contributing to readability in 5.001 is that the brackets
+around a symbolic reference behave more like quotes, just as they
+always have within a string.  That is,
+
+    $push = "pop on ";
+    print "${push}over";
+
+has always meant to print "pop on over", despite the fact that push is
+a reserved word.  This has been generalized to work the same outside
+of quotes, so that
+
+    print ${push} . "over";
+
+and even
+
+    print ${ push } . "over";
+
+will have the same effect.  (This would have been a syntax error in
+5.000, though Perl 4 allowed it in the spaceless form.)  Note that this
+construct is I<not> considered to be a symbolic reference when you're
+using strict refs:
+
+    use strict 'refs';
+    ${ bareword };	# Okay, means $bareword.
+    ${ "bareword" };	# Error, symbolic reference.
+
+Similarly, because of all the subscripting that is done using single
+words, we've applied the same rule to any bareword that is used for
+subscripting a hash.  So now, instead of writing
+
+    $array{ "aaa" }{ "bbb" }{ "ccc" }
+
+you can just write
+
+    $array{ aaa }{ bbb }{ ccc }
+
+and not worry about whether the subscripts are reserved words.  In the
+rare event that you do wish to do something like
+
+    $array{ shift }
+
+you can force interpretation as a reserved word by adding anything that
+makes it more than a bareword:
+
+    $array{ shift() }
+    $array{ +shift }
+    $array{ shift @_ }
+
+The B<-w> switch will warn you if it interprets a reserved word as a string.
+But it will no longer warn you about using lowercase words, since the
+string is effectively quoted.
+
+=head1 WARNING
+
+You may not (usefully) use a reference as the key to a hash.  It will be
+converted into a string:
+
+    $x{ \$a } = $a;
+
+If you try to dereference the key, it won't do a hard dereference, and 
+you won't accomplish what you're attemping.  You might want to do something
+more like
+
+    $r = \@a;
+    $x{ $r } = $r;
+
+And then at least you can use the values(), which will be
+real refs, instead of the keys(), which won't.
+
+=head1 SEE ALSO
+
+Besides the obvious documents, source code can be instructive.
+Some rather pathological examples of the use of references can be found
+in the F<t/op/ref.t> regression test in the Perl source directory.
+
+See also L<perldsc> and L<perllol> for how to use references to create
+complex data structures, and L<perlobj> for how to use them to create
+objects.
diff --git a/gnu/usr.bin/perl/pod/perlrun.pod b/gnu/usr.bin/perl/pod/perlrun.pod
new file mode 100644
index 00000000000..4f6294cc69b
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlrun.pod
@@ -0,0 +1,441 @@
+=head1 NAME
+
+perlrun - how to execute the Perl interpreter
+
+=head1 SYNOPSIS
+
+B<perl>	S<[ B<-sTuU> ]>
+	S<[ B<-hv> ] [ B<-V>[:I<configvar>] ]>
+	S<[ B<-cw> ] [ B<-d>[:I<debugger>] ] [ B<-D>[I<number/list>] ]>
+	S<[ B<-pna> ] [ B<-F>I<pattern> ] [ B<-l>[I<octal>] ] [ B<-0>[I<octal>] ]>
+	S<[ B<-I>I<dir> ] [ B<-m>[B<->]I<module> ] [ B<-M>[B<->]I<'module...'> ]>
+	S<[ B<-P> ]>
+	S<[ B<-S> ]>
+	S<[ B<-x>[I<dir>] ]>
+	S<[ B<-i>[I<extension>] ]>
+	S<[ B<-e> I<'command'> ] [ B<--> ] [ I<programfile> ] [ I<argument> ]...>
+
+=head1 DESCRIPTION
+
+Upon startup, Perl looks for your script in one of the following
+places:
+
+=over 4
+
+=item 1.
+
+Specified line by line via B<-e> switches on the command line.
+
+=item 2.
+
+Contained in the file specified by the first filename on the command line.
+(Note that systems supporting the #! notation invoke interpreters this way.)
+
+=item 3.
+
+Passed in implicitly via standard input.  This only works if there are
+no filename arguments--to pass arguments to a STDIN script you
+must explicitly specify a "-" for the script name.
+
+=back
+
+With methods 2 and 3, Perl starts parsing the input file from the
+beginning, unless you've specified a B<-x> switch, in which case it
+scans for the first line starting with #! and containing the word
+"perl", and starts there instead.  This is useful for running a script
+embedded in a larger message.  (In this case you would indicate the end
+of the script using the __END__ token.)
+
+As of Perl 5, the #! line is always examined for switches as the line is
+being parsed.  Thus, if you're on a machine that only allows one argument
+with the #! line, or worse, doesn't even recognize the #! line, you still
+can get consistent switch behavior regardless of how Perl was invoked,
+even if B<-x> was used to find the beginning of the script.
+
+Because many operating systems silently chop off kernel interpretation of
+the #! line after 32 characters, some switches may be passed in on the
+command line, and some may not; you could even get a "-" without its
+letter, if you're not careful.  You probably want to make sure that all
+your switches fall either before or after that 32 character boundary.
+Most switches don't actually care if they're processed redundantly, but
+getting a - instead of a complete switch could cause Perl to try to
+execute standard input instead of your script.  And a partial B<-I> switch
+could also cause odd results.
+
+Parsing of the #! switches starts wherever "perl" is mentioned in the line.
+The sequences "-*" and "- " are specifically ignored so that you could,
+if you were so inclined, say
+
+    #!/bin/sh -- # -*- perl -*- -p
+    eval 'exec perl $0 -S ${1+"$@"}'
+	if 0;
+
+to let Perl see the B<-p> switch.
+
+If the #! line does not contain the word "perl", the program named after
+the #! is executed instead of the Perl interpreter.  This is slightly
+bizarre, but it helps people on machines that don't do #!, because they
+can tell a program that their SHELL is /usr/bin/perl, and Perl will then
+dispatch the program to the correct interpreter for them.
+
+After locating your script, Perl compiles the entire script to an
+internal form.  If there are any compilation errors, execution of the
+script is not attempted.  (This is unlike the typical shell script,
+which might run partway through before finding a syntax error.)
+
+If the script is syntactically correct, it is executed.  If the script
+runs off the end without hitting an exit() or die() operator, an implicit
+C<exit(0)> is provided to indicate successful completion.
+
+=head2 Switches
+
+A single-character switch may be combined with the following switch, if
+any.
+
+    #!/usr/bin/perl -spi.bak	# same as -s -p -i.bak
+
+Switches include:
+
+=over 5
+
+=item B<-0>[I<digits>]
+
+specifies the record separator (C<$/>) as an octal number.  If there are
+no digits, the null character is the separator.  Other switches may
+precede or follow the digits.  For example, if you have a version of
+B<find> which can print filenames terminated by the null character, you
+can say this:
+
+    find . -name '*.bak' -print0 | perl -n0e unlink
+
+The special value 00 will cause Perl to slurp files in paragraph mode.
+The value 0777 will cause Perl to slurp files whole since there is no
+legal character with that value.
+
+=item B<-a>
+
+turns on autosplit mode when used with a B<-n> or B<-p>.  An implicit
+split command to the @F array is done as the first thing inside the
+implicit while loop produced by the B<-n> or B<-p>.
+
+    perl -ane 'print pop(@F), "\n";'
+
+is equivalent to
+
+    while (<>) {
+	@F = split(' ');
+	print pop(@F), "\n";
+    }
+
+An alternate delimiter may be specified using B<-F>.
+
+=item B<-c>
+
+causes Perl to check the syntax of the script and then exit without
+executing it.  Actually, it I<will> execute C<BEGIN>, C<END>, and C<use> blocks,
+since these are considered as occurring outside the execution of 
+your program.
+
+=item B<-d>
+
+runs the script under the Perl debugger.  See L<perldebug>.
+
+=item B<-d:>I<foo>
+
+runs the script under the control of a debugging or tracing module
+installed as Devel::foo. E.g., B<-d:DProf> executes the script using the
+Devel::DProf profiler.  See L<perldebug>.
+
+=item B<-D>I<number>
+
+=item B<-D>I<list>
+
+sets debugging flags.  To watch how it executes your script, use
+B<-D14>.  (This only works if debugging is compiled into your
+Perl.)  Another nice value is B<-D1024>, which lists your compiled
+syntax tree.  And B<-D512> displays compiled regular expressions. As an
+alternative specify a list of letters instead of numbers (e.g. B<-D14> is
+equivalent to B<-Dtls>):
+
+        1  p  Tokenizing and Parsing
+        2  s  Stack Snapshots
+        4  l  Label Stack Processing
+        8  t  Trace Execution
+       16  o  Operator Node Construction
+       32  c  String/Numeric Conversions
+       64  P  Print Preprocessor Command for -P
+      128  m  Memory Allocation
+      256  f  Format Processing
+      512  r  Regular Expression Parsing
+     1024  x  Syntax Tree Dump
+     2048  u  Tainting Checks
+     4096  L  Memory Leaks (not supported anymore)
+     8192  H  Hash Dump -- usurps values()
+    16384  X  Scratchpad Allocation
+    32768  D  Cleaning Up
+
+=item B<-e> I<commandline>
+
+may be used to enter one line of script.  
+If B<-e> is given, Perl
+will not look for a script filename in the argument list.  
+Multiple B<-e> commands may
+be given to build up a multi-line script.  
+Make sure to use semicolons where you would in a normal program.
+
+=item B<-F>I<pattern>
+
+specifies the pattern to split on if B<-a> is also in effect.  The
+pattern may be surrounded by C<//>, C<""> or C<''>, otherwise it will be
+put in single quotes.
+
+=item B<-h>
+
+prints a summary of the options.
+
+=item B<-i>[I<extension>]
+
+specifies that files processed by the C<E<lt>E<gt>> construct are to be edited
+in-place.  It does this by renaming the input file, opening the output
+file by the original name, and selecting that output file as the default
+for print() statements.  The extension, if supplied, is added to the name
+of the old file to make a backup copy.  If no extension is supplied, no
+backup is made.  From the shell, saying
+
+    $ perl -p -i.bak -e "s/foo/bar/; ... "
+
+is the same as using the script:
+
+    #!/usr/bin/perl -pi.bak
+    s/foo/bar/;
+
+which is equivalent to
+
+    #!/usr/bin/perl
+    while (<>) {
+	if ($ARGV ne $oldargv) {
+	    rename($ARGV, $ARGV . '.bak');
+	    open(ARGVOUT, ">$ARGV");
+	    select(ARGVOUT);
+	    $oldargv = $ARGV;
+	}
+	s/foo/bar/;
+    }
+    continue {
+	print;	# this prints to original filename
+    }
+    select(STDOUT);
+
+except that the B<-i> form doesn't need to compare $ARGV to $oldargv to
+know when the filename has changed.  It does, however, use ARGVOUT for
+the selected filehandle.  Note that STDOUT is restored as the
+default output filehandle after the loop.
+
+You can use C<eof> without parenthesis to locate the end of each input file, 
+in case you want to append to each file, or reset line numbering (see 
+example in L<perlfunc/eof>).
+
+=item B<-I>I<directory>
+
+Directories specified by B<-I> are prepended to the search path for
+modules (@INC), and also tells the C preprocessor where to search for
+include files.  The C preprocessor is invoked with B<-P>; by default it
+searches /usr/include and /usr/lib/perl.
+
+=item B<-l>[I<octnum>]
+
+enables automatic line-ending processing.  It has two effects:  first,
+it automatically chomps the line terminator when used with B<-n> or
+B<-p>, and second, it assigns "C<$\>" to have the value of I<octnum> so that
+any print statements will have that line terminator added back on.  If
+I<octnum> is omitted, sets "C<$\>" to the current value of "C<$/>".  For
+instance, to trim lines to 80 columns:
+
+    perl -lpe 'substr($_, 80) = ""'
+
+Note that the assignment C<$\ = $/> is done when the switch is processed,
+so the input record separator can be different than the output record
+separator if the B<-l> switch is followed by a B<-0> switch:
+
+    gnufind / -print0 | perl -ln0e 'print "found $_" if -p'
+
+This sets $\ to newline and then sets $/ to the null character.
+
+=item B<-m>[B<->]I<module>
+
+=item B<-M>[B<->]I<module>
+
+=item B<-M>[B<->]I<'module ...'>
+
+=item B<-[mM]>[B<->]I<module=arg[,arg]...>
+
+C<-m>I<module> executes C<use> I<module> C<();> before executing your
+script.
+
+C<-M>I<module> executes C<use> I<module> C<;> before executing your
+script.  You can use quotes to add extra code after the module name,
+e.g., C<-M'module qw(foo bar)'>.
+
+If the first character after the C<-M> or C<-m> is a dash (C<->)
+then the 'use' is replaced with 'no'.
+
+A little built-in syntactic sugar means you can also say
+C<-mmodule=foo,bar> or C<-Mmodule=foo,bar> as a shortcut for
+C<-M'module qw(foo bar)'>.  This avoids the need to use quotes when
+importing symbols.  The actual code generated by C<-Mmodule=foo,bar> is
+C<use module split(/,/,q{foo,bar})>.  Note that the C<=> form
+removes the distinction between C<-m> and C<-M>.
+
+=item B<-n>
+
+causes Perl to assume the following loop around your script, which
+makes it iterate over filename arguments somewhat like B<sed -n> or
+B<awk>:
+
+    while (<>) {
+	...		# your script goes here
+    }
+
+Note that the lines are not printed by default.  See B<-p> to have
+lines printed.  Here is an efficient way to delete all files older than
+a week:
+
+    find . -mtime +7 -print | perl -nle 'unlink;'
+
+This is faster than using the C<-exec> switch of B<find> because you don't
+have to start a process on every filename found.
+
+C<BEGIN> and C<END> blocks may be used to capture control before or after
+the implicit loop, just as in B<awk>.
+
+=item B<-p>
+
+causes Perl to assume the following loop around your script, which
+makes it iterate over filename arguments somewhat like B<sed>:
+
+
+    while (<>) {
+	...		# your script goes here
+    } continue {
+	print;
+    }
+
+Note that the lines are printed automatically.  To suppress printing
+use the B<-n> switch.  A B<-p> overrides a B<-n> switch.
+
+C<BEGIN> and C<END> blocks may be used to capture control before or after
+the implicit loop, just as in awk.
+
+=item B<-P>
+
+causes your script to be run through the C preprocessor before
+compilation by Perl.  (Since both comments and cpp directives begin
+with the # character, you should avoid starting comments with any words
+recognized by the C preprocessor such as "if", "else" or "define".)
+
+=item B<-s>
+
+enables some rudimentary switch parsing for switches on the command
+line after the script name but before any filename arguments (or before
+a B<-->).  Any switch found there is removed from @ARGV and sets the
+corresponding variable in the Perl script.  The following script
+prints "true" if and only if the script is invoked with a B<-xyz> switch.
+
+    #!/usr/bin/perl -s
+    if ($xyz) { print "true\n"; }
+
+=item B<-S>
+
+makes Perl use the PATH environment variable to search for the
+script (unless the name of the script starts with a slash).  Typically
+this is used to emulate #! startup on machines that don't support #!,
+in the following manner:
+
+    #!/usr/bin/perl
+    eval "exec /usr/bin/perl -S $0 $*"
+	    if $running_under_some_shell;
+
+The system ignores the first line and feeds the script to /bin/sh,
+which proceeds to try to execute the Perl script as a shell script.
+The shell executes the second line as a normal shell command, and thus
+starts up the Perl interpreter.  On some systems $0 doesn't always
+contain the full pathname, so the B<-S> tells Perl to search for the
+script if necessary.  After Perl locates the script, it parses the
+lines and ignores them because the variable $running_under_some_shell
+is never true.  A better construct than C<$*> would be C<${1+"$@"}>, which
+handles embedded spaces and such in the filenames, but doesn't work if
+the script is being interpreted by csh.  In order to start up sh rather
+than csh, some systems may have to replace the #! line with a line
+containing just a colon, which will be politely ignored by Perl.  Other
+systems can't control that, and need a totally devious construct that
+will work under any of csh, sh or Perl, such as the following:
+
+	eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+	& eval 'exec /usr/bin/perl -S $0 $argv:q'
+		if 0;
+
+=item B<-T>
+
+forces "taint" checks to be turned on so you can test them.  Ordinarily these checks are
+done only when running setuid or setgid.  It's a good idea to turn
+them on explicitly for programs run on another's behalf, such as CGI
+programs.  See L<perlsec>.
+
+=item B<-u>
+
+causes Perl to dump core after compiling your script.  You can then
+take this core dump and turn it into an executable file by using the
+B<undump> program (not supplied).  This speeds startup at the expense of
+some disk space (which you can minimize by stripping the executable).
+(Still, a "hello world" executable comes out to about 200K on my
+machine.)  If you want to execute a portion of your script before dumping,
+use the dump() operator instead.  Note: availability of B<undump> is
+platform specific and may not be available for a specific port of
+Perl.
+
+=item B<-U>
+
+allows Perl to do unsafe operations.  Currently the only "unsafe"
+operations are the unlinking of directories while running as superuser,
+and running setuid programs with fatal taint checks turned into
+warnings.
+
+=item B<-v>
+
+prints the version and patchlevel of your Perl executable.
+
+=item B<-V>
+
+prints summary of the major perl configuration values and the current
+value of @INC.
+
+=item B<-V:>I<name>
+
+Prints to STDOUT the value of the named configuration variable.
+
+=item B<-w>
+
+prints warnings about identifiers that are mentioned only once, and
+scalar variables that are used before being set.  Also warns about
+redefined subroutines, and references to undefined filehandles or
+filehandles opened readonly that you are attempting to write on.  Also
+warns you if you use values as a number that doesn't look like numbers, using
+an array as though it were a scalar, if
+your subroutines recurse more than 100 deep, and innumerable other things.
+See L<perldiag> and L<perltrap>.
+
+=item B<-x> I<directory>
+
+tells Perl that the script is embedded in a message.  Leading
+garbage will be discarded until the first line that starts with #! and
+contains the string "perl".  Any meaningful switches on that line will
+be applied (but only one group of switches, as with normal #!
+processing).  If a directory name is specified, Perl will switch to
+that directory before running the script.  The B<-x> switch only
+controls the the disposal of leading garbage.  The script must be
+terminated with C<__END__> if there is trailing garbage to be ignored (the
+script can process any or all of the trailing garbage via the DATA
+filehandle if desired).
+
+
+=back
diff --git a/gnu/usr.bin/perl/pod/perlsec.pod b/gnu/usr.bin/perl/pod/perlsec.pod
new file mode 100644
index 00000000000..ccae6e82a9d
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlsec.pod
@@ -0,0 +1,147 @@
+=head1 NAME
+
+perlsec - Perl security
+
+=head1 DESCRIPTION
+
+Perl is designed to make it easy to write secure setuid and setgid
+scripts.  Unlike shells, which are based on multiple substitution
+passes on each line of the script, Perl uses a more conventional
+evaluation scheme with fewer hidden "gotchas".  Additionally, since the
+language has more built-in functionality, it has to rely less upon
+external (and possibly untrustworthy) programs to accomplish its
+purposes.
+
+Beyond the obvious problems that stem from giving special privileges to
+such flexible systems as scripts, on many operating systems, setuid
+scripts are inherently insecure right from the start.  This is because
+that between the time that the kernel opens up the file to see what to
+run, and when the now setuid interpreter it ran turns around and reopens
+the file so it can interpret it, things may have changed, especially if
+you have symbolic links on your system.
+
+Fortunately, sometimes this kernel "feature" can be disabled.
+Unfortunately, there are two ways to disable it.  The system can simply
+outlaw scripts with the setuid bit set, which doesn't help much.
+Alternately, it can simply ignore the setuid bit on scripts.  If the
+latter is true, Perl can emulate the setuid and setgid mechanism when it
+notices the otherwise useless setuid/gid bits on Perl scripts.  It does
+this via a special executable called B<suidperl> that is automatically
+invoked for you if it's needed.
+
+If, however, the kernel setuid script feature isn't disabled, Perl will
+complain loudly that your setuid script is insecure.  You'll need to
+either disable the kernel setuid script feature, or put a C wrapper around
+the script.  See the program B<wrapsuid> in the F<eg> directory of your
+Perl distribution for how to go about doing this.
+
+There are some systems on which setuid scripts are free of this inherent
+security bug.  For example, recent releases of Solaris are like this.  On
+such systems, when the kernel passes the name of the setuid script to open
+to the interpreter, rather than using a pathname subject to mettling, it
+instead passes /dev/fd/3.  This is a special file already opened on the
+script, so that there can be no race condition for evil scripts to
+exploit.  On these systems, Perl should be compiled with
+C<-DSETUID_SCRIPTS_ARE_SECURE_NOW>.  The B<Configure> program that builds
+Perl tries to figure this out for itself.
+
+When executing a setuid script, or when you have turned on taint checking
+explicitly using the B<-T> flag, Perl takes special precautions to
+prevent you from falling into any obvious traps.  (In some ways, a Perl
+script is more secure than the corresponding C program.)  Any command line
+argument, environment variable, or input is marked as "tainted", and may
+not be used, directly or indirectly, in any command that invokes a
+subshell, or in any command that modifies files, directories, or
+processes.  Any variable that is set within an expression that has
+previously referenced a tainted value also becomes tainted (even if it is
+logically impossible for the tainted value to influence the variable).
+For example:
+
+    $foo = shift;		# $foo is tainted
+    $bar = $foo,'bar';		# $bar is also tainted
+    $xxx = <>;			# Tainted
+    $path = $ENV{'PATH'};	# Tainted, but see below
+    $abc = 'abc';		# Not tainted
+
+    system "echo $foo";		# Insecure
+    system "/bin/echo", $foo;	# Secure (doesn't use sh)
+    system "echo $bar";		# Insecure
+    system "echo $abc";		# Insecure until PATH set
+
+    $ENV{'PATH'} = '/bin:/usr/bin';
+    $ENV{'IFS'} = '' if $ENV{'IFS'} ne '';
+
+    $path = $ENV{'PATH'};	# Not tainted
+    system "echo $abc";		# Is secure now!
+
+    open(FOO,"$foo");		# OK
+    open(FOO,">$foo"); 		# Not OK
+
+    open(FOO,"echo $foo|");	# Not OK, but...
+    open(FOO,"-|") || exec 'echo', $foo;	# OK
+
+    $zzz = `echo $foo`;		# Insecure, zzz tainted
+
+    unlink $abc,$foo;		# Insecure
+    umask $foo;			# Insecure
+
+    exec "echo $foo";		# Insecure
+    exec "echo", $foo;		# Secure (doesn't use sh)
+    exec "sh", '-c', $foo;	# Considered secure, alas
+
+The taintedness is associated with each scalar value, so some elements
+of an array can be tainted, and others not.
+
+If you try to do something insecure, you will get a fatal error saying
+something like "Insecure dependency" or "Insecure PATH".  Note that you
+can still write an insecure system call or exec, but only by explicitly
+doing something like the last example above.  You can also bypass the
+tainting mechanism by referencing subpatterns--Perl presumes that if
+you reference a substring using $1, $2, etc, you knew what you were
+doing when you wrote the pattern:
+
+    $ARGV[0] =~ /^-P(\w+)$/;
+    $printer = $1;		# Not tainted
+
+This is fairly secure since C<\w+> doesn't match shell metacharacters.
+Use of C</.+/> would have been insecure, but Perl doesn't check for that,
+so you must be careful with your patterns.  This is the I<ONLY> mechanism
+for untainting user supplied filenames if you want to do file operations
+on them (unless you make C<$E<gt>> equal to C<$E<lt>> ).
+
+For "Insecure $ENV{PATH}" messages, you need to set C<$ENV{'PATH'}> to a known
+value, and each directory in the path must be non-writable by the world.
+A frequently voiced gripe is that you can get this message even
+if the pathname to an executable is fully qualified.  But Perl can't
+know that the executable in question isn't going to execute some other
+program depending on the PATH.
+
+It's also possible to get into trouble with other operations that don't
+care whether they use tainted values.  Make judicious use of the file
+tests in dealing with any user-supplied filenames.  When possible, do
+opens and such after setting C<$E<gt> = $E<lt>>.  (Remember group IDs,
+too!) Perl doesn't prevent you from opening tainted filenames for reading,
+so be careful what you print out.  The tainting mechanism is intended to
+prevent stupid mistakes, not to remove the need for thought.
+
+This gives us a reasonably safe way to open a file or pipe: just reset the
+id set to the original IDs.  Here's a way to do backticks reasonably
+safely.  Notice how the exec() is not called with a string that the shell
+could expand.  By the time we get to the exec(), tainting is turned off,
+however, so be careful what you call and what you pass it.
+
+    die unless defined $pid = open(KID, "-|");
+    if ($pid) {	          # parent
+	while (<KID>) {
+	    # do something
+	} 
+	close KID;
+    } else {
+	$> = $<; 
+	$) = $(;  # BUG: initgroups() not called
+	exec 'program', 'arg1', 'arg2';
+	die "can't exec program: $!";
+    } 
+
+For those even more concerned about safety, see the I<Safe> and I<Safe CGI> 
+modules at a CPAN site near you.  See L<perlmod> for a list of CPAN sites.
diff --git a/gnu/usr.bin/perl/pod/perlstyle.pod b/gnu/usr.bin/perl/pod/perlstyle.pod
new file mode 100644
index 00000000000..e4a5aab41fd
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlstyle.pod
@@ -0,0 +1,275 @@
+=head1 NAME
+
+perlstyle - Perl style guide
+
+=head1 DESCRIPTION
+
+Each programmer will, of course, have his or her own preferences in
+regards to formatting, but there are some general guidelines that will
+make your programs easier to read, understand, and maintain.  
+
+The most important thing is to run your programs under the B<-w>
+flag at all times.  You may turn it off explicitly for particular
+portions of code via the C<$^W> variable if you must.  You should
+also always run under C<use strict> or know the reason why not.
+The <use sigtrap> and even <use diagnostics> pragmas may also prove
+useful.
+
+Regarding aesthetics of code lay out, about the only thing Larry
+cares strongly about is that the closing curly brace of
+a multi-line BLOCK should line up with the keyword that started the construct.
+Beyond that, he has other preferences that aren't so strong:
+
+=over 4
+
+=item *
+
+4-column indent.
+
+=item *
+
+Opening curly on same line as keyword, if possible, otherwise line up.
+
+=item *
+
+Space before the opening curly of a multiline BLOCK.
+
+=item *
+
+One-line BLOCK may be put on one line, including curlies.
+
+=item *
+
+No space before the semicolon.
+
+=item *
+
+Semicolon omitted in "short" one-line BLOCK.
+
+=item *
+
+Space around most operators.
+
+=item *
+
+Space around a "complex" subscript (inside brackets).
+
+=item *
+
+Blank lines between chunks that do different things.
+
+=item *
+
+Uncuddled elses.
+
+=item *
+
+No space between function name and its opening paren.
+
+=item *
+
+Space after each comma.
+
+=item *
+
+Long lines broken after an operator (except "and" and "or").
+
+=item *
+
+Space after last paren matching on current line.
+
+=item *
+
+Line up corresponding items vertically.
+
+=item *
+
+Omit redundant punctuation as long as clarity doesn't suffer.
+
+=back
+
+Larry has his reasons for each of these things, but he doen't claim that
+everyone else's mind works the same as his does.
+
+Here are some other more substantive style issues to think about:
+
+=over 4
+
+=item *
+
+Just because you I<CAN> do something a particular way doesn't mean that
+you I<SHOULD> do it that way.  Perl is designed to give you several
+ways to do anything, so consider picking the most readable one.  For
+instance
+
+    open(FOO,$foo) || die "Can't open $foo: $!";
+
+is better than
+
+    die "Can't open $foo: $!" unless open(FOO,$foo);
+
+because the second way hides the main point of the statement in a
+modifier.  On the other hand
+
+    print "Starting analysis\n" if $verbose;
+
+is better than
+
+    $verbose && print "Starting analysis\n";
+
+since the main point isn't whether the user typed B<-v> or not.
+
+Similarly, just because an operator lets you assume default arguments
+doesn't mean that you have to make use of the defaults.  The defaults
+are there for lazy systems programmers writing one-shot programs.  If
+you want your program to be readable, consider supplying the argument.
+
+Along the same lines, just because you I<CAN> omit parentheses in many
+places doesn't mean that you ought to:
+
+    return print reverse sort num values %array;
+    return print(reverse(sort num (values(%array))));
+
+When in doubt, parenthesize.  At the very least it will let some poor
+schmuck bounce on the % key in B<vi>.
+
+Even if you aren't in doubt, consider the mental welfare of the person
+who has to maintain the code after you, and who will probably put
+parens in the wrong place.
+
+=item *
+
+Don't go through silly contortions to exit a loop at the top or the
+bottom, when Perl provides the C<last> operator so you can exit in
+the middle.  Just "outdent" it a little to make it more visible:
+
+    LINE:
+	for (;;) {
+	    statements;
+	  last LINE if $foo;
+	    next LINE if /^#/;
+	    statements;
+	}
+
+=item *
+
+Don't be afraid to use loop labels--they're there to enhance
+readability as well as to allow multi-level loop breaks.  See the
+previous example.
+
+=item *
+
+Avoid using grep() (or map()) or `backticks` in a void context, that is,
+when you just throw away their return values.  Those functions all 
+have return values, so use them.  Otherwise use a foreach() loop or
+the system() function instead.
+
+=item *
+
+For portability, when using features that may not be implemented on
+every machine, test the construct in an eval to see if it fails.  If
+you know what version or patchlevel a particular feature was
+implemented, you can test C<$]> ($PERL_VERSION in C<English>) to see if it
+will be there.  The C<Config> module will also let you interrogate values
+determined by the B<Configure> program when Perl was installed.
+
+=item *
+
+Choose mnemonic identifiers.  If you can't remember what mnemonic means,
+you've got a problem.
+
+=item * 
+
+While short identifiers like $gotit are probably ok, use underscores to
+separate words.  It is generally easier to read $var_names_like_this than
+$VarNamesLikeThis, especially for non-native speakers of English. It's
+also a simple rule that works consistently with VAR_NAMES_LIKE_THIS.
+
+Package names are sometimes an exception to this rule.  Perl informally
+reserves lowercase module names for "pragma" modules like C<integer> and
+C<strict>.  Other modules should begin with a capital letter and use mixed
+case, but probably without underscores due to limitations in primitive
+filesystems' representations of module names as files that must fit into a
+few sparse bites.
+
+=item *
+
+You may find it helpful to use letter case to indicate the scope 
+or nature of a variable. For example: 
+
+    $ALL_CAPS_HERE   constants only (beware clashes with perl vars!)  
+    $Some_Caps_Here  package-wide global/static 
+    $no_caps_here    function scope my() or local() variables 
+
+Function and method names seem to work best as all lowercase. 
+E.g., $obj->as_string(). 
+
+You can use a leading underscore to indicate that a variable or
+function should not be used outside the package that defined it.
+
+=item *
+
+If you have a really hairy regular expression, use the C</x> modifier and
+put in some whitespace to make it look a little less like line noise.
+Don't use slash as a delimiter when your regexp has slashes or backslashes.
+
+=item *
+
+Use the new "and" and "or" operators to avoid having to parenthesize
+list operators so much, and to reduce the incidence of punctuational
+operators like C<&&> and C<||>.  Call your subroutines as if they were
+functions or list operators to avoid excessive ampersands and parens.
+
+=item *
+
+Use here documents instead of repeated print() statements.
+
+=item *
+
+Line up corresponding things vertically, especially if it'd be too long
+to fit on one line anyway.  
+
+    $IDX = $ST_MTIME;       
+    $IDX = $ST_ATIME 	   if $opt_u; 
+    $IDX = $ST_CTIME 	   if $opt_c;     
+    $IDX = $ST_SIZE  	   if $opt_s;     
+
+    mkdir $tmpdir, 0700	or die "can't mkdir $tmpdir: $!";
+    chdir($tmpdir)      or die "can't chdir $tmpdir: $!";
+    mkdir 'tmp',   0777	or die "can't mkdir $tmpdir/tmp: $!";
+
+=item *
+
+Always check the return codes of system calls.  Good error messages should
+go to STDERR, include which program caused the problem, what the failed
+system call and arguments were, and VERY IMPORTANT) should contain the
+standard system error message for what went wrong.  Here's a simple but
+sufficient example:
+
+    opendir(D, $dir)	 or die "can't opendir $dir: $!";
+
+=item *
+
+Line up your translations when it makes sense:
+
+    tr [abc]
+       [xyz];
+
+=item *
+
+Think about reusability.  Why waste brainpower on a one-shot when you
+might want to do something like it again?  Consider generalizing your
+code.  Consider writing a module or object class.  Consider making your
+code run cleanly with C<use strict> and B<-w> in effect.  Consider giving away
+your code.  Consider changing your whole world view.  Consider... oh,
+never mind.
+
+=item *
+
+Be consistent.
+
+=item *
+
+Be nice.
+
+=back
diff --git a/gnu/usr.bin/perl/pod/perlsub.pod b/gnu/usr.bin/perl/pod/perlsub.pod
new file mode 100644
index 00000000000..b308298858a
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlsub.pod
@@ -0,0 +1,791 @@
+=head1 NAME
+
+perlsub - Perl subroutines
+
+=head1 SYNOPSIS
+
+To declare subroutines:
+
+    sub NAME;	      	  # A "forward" declaration.
+    sub NAME(PROTO);  	  #  ditto, but with prototypes
+
+    sub NAME BLOCK    	  # A declaration and a definition.
+    sub NAME(PROTO) BLOCK #  ditto, but with prototypes
+
+To define an anonymous subroutine at runtime:
+
+    $subref = sub BLOCK;
+
+To import subroutines:
+
+    use PACKAGE qw(NAME1 NAME2 NAME3);
+
+To call subroutines:
+
+    NAME(LIST);	   # & is optional with parens.
+    NAME LIST;	   # Parens optional if predeclared/imported.
+    &NAME;	   # Passes current @_ to subroutine.
+
+=head1 DESCRIPTION
+
+Like many languages, Perl provides for user-defined subroutines.  These
+may be located anywhere in the main program, loaded in from other files
+via the C<do>, C<require>, or C<use> keywords, or even generated on the
+fly using C<eval> or anonymous subroutines (closures).  You can even call
+a function indirectly using a variable containing its name or a CODE reference
+to it, as in C<$var = \&function>.
+
+The Perl model for function call and return values is simple: all
+functions are passed as parameters one single flat list of scalars, and
+all functions likewise return to their caller one single flat list of
+scalars.  Any arrays or hashes in these call and return lists will
+collapse, losing their identities--but you may always use
+pass-by-reference instead to avoid this.  Both call and return lists may
+contain as many or as few scalar elements as you'd like.  (Often a
+function without an explicit return statement is called a subroutine, but
+there's really no difference from the language's perspective.)
+
+Any arguments passed to the routine come in as the array @_.  Thus if you
+called a function with two arguments, those would be stored in C<$_[0]>
+and C<$_[1]>.  The array @_ is a local array, but its values are implicit
+references (predating L<perlref>) to the actual scalar parameters.  The
+return value of the subroutine is the value of the last expression
+evaluated.  Alternatively, a return statement may be used to specify the
+returned value and exit the subroutine.  If you return one or more arrays
+and/or hashes, these will be flattened together into one large
+indistinguishable list.
+
+Perl does not have named formal parameters, but in practice all you do is
+assign to a my() list of these.  Any variables you use in the function
+that aren't declared private are global variables.  For the gory details
+on creating private variables, see the sections below on L<"Private
+Variables via my()"> and L</"Temporary Values via local()">.  To create
+protected environments for a set of functions in a separate package (and
+probably a separate file), see L<perlmod/"Packages">.
+
+Example:
+
+    sub max {
+	my $max = shift(@_);
+	foreach $foo (@_) {
+	    $max = $foo if $max < $foo;
+	}
+	return $max;
+    }
+    $bestday = max($mon,$tue,$wed,$thu,$fri);
+
+Example:
+
+    # get a line, combining continuation lines
+    #  that start with whitespace
+
+    sub get_line {
+	$thisline = $lookahead;  # GLOBAL VARIABLES!!
+	LINE: while ($lookahead = <STDIN>) {
+	    if ($lookahead =~ /^[ \t]/) {
+		$thisline .= $lookahead;
+	    }
+	    else {
+		last LINE;
+	    }
+	}
+	$thisline;
+    }
+
+    $lookahead = <STDIN>;	# get first line
+    while ($_ = get_line()) {
+	...
+    }
+
+Use array assignment to a local list to name your formal arguments:
+
+    sub maybeset {
+	my($key, $value) = @_;
+	$Foo{$key} = $value unless $Foo{$key};
+    }
+
+This also has the effect of turning call-by-reference into call-by-value,
+since the assignment copies the values.  Otherwise a function is free to
+do in-place modifications of @_ and change its callers values.
+
+    upcase_in($v1, $v2);  # this changes $v1 and $v2
+    sub upcase_in {
+	for (@_) { tr/a-z/A-Z/ } 
+    } 
+
+You aren't allowed to modify constants in this way, of course.  If an
+argument were actually literal and you tried to change it, you'd take a
+(presumably fatal) exception.   For example, this won't work:
+
+    upcase_in("frederick");
+
+It would be much safer if the upcase_in() function 
+were written to return a copy of its parameters instead
+of changing them in place:
+
+    ($v3, $v4) = upcase($v1, $v2);  # this doesn't
+    sub upcase {
+	my @parms = @_;
+	for (@parms) { tr/a-z/A-Z/ } 
+	# wantarray checks if we were called in list context
+  	return wantarray ? @parms : $parms[0];
+    } 
+
+Notice how this (unprototyped) function doesn't care whether it was passed
+real scalars or arrays.  Perl will see everything as one big long flat @_
+parameter list.  This is one of the ways where Perl's simple
+argument-passing style shines.  The upcase() function would work perfectly
+well without changing the upcase() definition even if we fed it things
+like this:
+
+    @newlist   = upcase(@list1, @list2);
+    @newlist   = upcase( split /:/, $var );
+
+Do not, however, be tempted to do this:
+
+    (@a, @b)   = upcase(@list1, @list2);
+
+Because like its flat incoming parameter list, the return list is also
+flat.  So all you have managed to do here is stored everything in @a and
+made @b an empty list.  See L</"Pass by Reference"> for alternatives.
+
+A subroutine may be called using the "&" prefix.  The "&" is optional in
+Perl 5, and so are the parens if the subroutine has been predeclared.
+(Note, however, that the "&" is I<NOT> optional when you're just naming
+the subroutine, such as when it's used as an argument to defined() or
+undef().  Nor is it optional when you want to do an indirect subroutine
+call with a subroutine name or reference using the C<&$subref()> or
+C<&{$subref}()> constructs.  See L<perlref> for more on that.)
+
+Subroutines may be called recursively.  If a subroutine is called using
+the "&" form, the argument list is optional, and if omitted, no @_ array is
+set up for the subroutine: the @_ array at the time of the call is
+visible to subroutine instead.  This is an efficiency mechanism that
+new users may wish to avoid.
+
+    &foo(1,2,3);	# pass three arguments
+    foo(1,2,3);		# the same
+
+    foo();		# pass a null list
+    &foo();		# the same
+
+    &foo;		# foo() get current args, like foo(@_) !!
+    foo;		# like foo() IFF sub foo pre-declared, else "foo"
+
+Not only does the "&" form make the argument list optional, but it also
+disables any prototype checking on the arguments you do provide.  This
+is partly for historical reasons, and partly for having a convenient way
+to cheat if you know what you're doing.  See the section on Prototypes below.
+
+=head2 Private Variables via my()
+
+Synopsis:
+
+    my $foo;	    	# declare $foo lexically local
+    my (@wid, %get); 	# declare list of variables local
+    my $foo = "flurp";	# declare $foo lexical, and init it
+    my @oof = @bar;	# declare @oof lexical, and init it
+
+A "my" declares the listed variables to be confined (lexically) to the
+enclosing block, subroutine, C<eval>, or C<do/require/use>'d file.  If
+more than one value is listed, the list must be placed in parens.  All
+listed elements must be legal lvalues.  Only alphanumeric identifiers may
+be lexically scoped--magical builtins like $/ must currently be localized with
+"local" instead.  
+
+Unlike dynamic variables created by the "local" statement, lexical
+variables declared with "my" are totally hidden from the outside world,
+including any called subroutines (even if it's the same subroutine called
+from itself or elsewhere--every call gets its own copy).
+
+(An eval(), however, can see the lexical variables of the scope it is
+being evaluated in so long as the names aren't hidden by declarations within
+the eval() itself.  See L<perlref>.)
+
+The parameter list to my() may be assigned to if desired, which allows you
+to initialize your variables.  (If no initializer is given for a
+particular variable, it is created with the undefined value.)  Commonly
+this is used to name the parameters to a subroutine.  Examples:
+
+    $arg = "fred";	  # "global" variable
+    $n = cube_root(27);
+    print "$arg thinks the root is $n\n";
+ fred thinks the root is 3
+
+    sub cube_root {
+	my $arg = shift;  # name doesn't matter
+	$arg **= 1/3;
+	return $arg;
+    } 			
+
+The "my" is simply a modifier on something you might assign to.  So when
+you do assign to the variables in its argument list, the "my" doesn't
+change whether those variables is viewed as a scalar or an array.  So
+
+    my ($foo) = <STDIN>;
+    my @FOO = <STDIN>;
+
+both supply a list context to the righthand side, while
+
+    my $foo = <STDIN>;
+
+supplies a scalar context.  But the following only declares one variable:
+
+    my $foo, $bar = 1;
+
+That has the same effect as
+
+    my $foo;
+    $bar = 1;
+
+The declared variable is not introduced (is not visible) until after
+the current statement.  Thus,
+
+    my $x = $x;
+
+can be used to initialize the new $x with the value of the old $x, and 
+the expression
+
+    my $x = 123 and $x == 123
+
+is false unless the old $x happened to have the value 123.
+
+Some users may wish to encourage the use of lexically scoped variables.
+As an aid to catching implicit references to package variables,
+if you say
+
+    use strict 'vars';
+
+then any variable reference from there to the end of the enclosing
+block must either refer to a lexical variable, or must be fully
+qualified with the package name.  A compilation error results
+otherwise.  An inner block may countermand this with S<"no strict 'vars'">.
+
+A my() has both a compile-time and a run-time effect.  At compile time,
+the compiler takes notice of it; the principle usefulness of this is to
+quiet C<use strict 'vars'>.  The actual initialization doesn't happen
+until run time, so gets executed every time through a loop.
+
+Variables declared with "my" are not part of any package and are therefore
+never fully qualified with the package name.  In particular, you're not
+allowed to try to make a package variable (or other global) lexical:
+
+    my $pack::var;	# ERROR!  Illegal syntax
+    my $_;		# also illegal (currently)
+
+In fact, a dynamic variable (also known as package or global variables)
+are still accessible using the fully qualified :: notation even while a
+lexical of the same name is also visible:
+
+    package main;
+    local $x = 10;
+    my    $x = 20;
+    print "$x and $::x\n";
+
+That will print out 20 and 10.
+
+You may declare "my" variables at the outer most scope of a file to
+totally hide any such identifiers from the outside world.  This is similar
+to a C's static variables at the file level.  To do this with a subroutine
+requires the use of a closure (anonymous function).  If a block (such as
+an eval(), function, or C<package>) wants to create a private subroutine
+that cannot be called from outside that block, it can declare a lexical
+variable containing an anonymous sub reference:
+
+    my $secret_version = '1.001-beta';
+    my $secret_sub = sub { print $secret_version };
+    &$secret_sub();
+
+As long as the reference is never returned by any function within the
+module, no outside module can see the subroutine, since its name is not in
+any package's symbol table.  Remember that it's not I<REALLY> called
+$some_pack::secret_version or anything; it's just $secret_version,
+unqualified and unqualifiable.
+
+This does not work with object methods, however; all object methods have
+to be in the symbol table of some package to be found.
+
+Just because the lexical variable is lexically (also called statically)
+scoped doesn't mean that within a function it works like a C static.  It
+normally works more like a C auto.  But here's a mechanism for giving a
+function private variables with both lexical scoping and a static
+lifetime.  If you do want to create something like C's static variables,
+just enclose the whole function in an extra block, and put the
+static variable outside the function but in the block.
+
+    {
+	my $secret_val = 0; 
+	sub gimme_another {
+	    return ++$secret_val;
+	} 
+    } 
+    # $secret_val now becomes unreachable by the outside
+    # world, but retains its value between calls to gimme_another
+
+If this function is being sourced in from a separate file 
+via C<require> or C<use>, then this is probably just fine.  If it's
+all in the main program, you'll need to arrange for the my() 
+to be executed early, either by putting the whole block above
+your pain program, or more likely, merely placing a BEGIN 
+sub around it to make sure it gets executed before your program
+starts to run:
+
+    sub BEGIN {
+	my $secret_val = 0; 
+	sub gimme_another {
+	    return ++$secret_val;
+	} 
+    } 
+
+See L<perlrun> about the BEGIN function.
+
+=head2 Temporary Values via local()
+
+B<NOTE>: In general, you should be using "my" instead of "local", because
+it's faster and safer.  Execeptions to this include the global punctuation
+variables, filehandles and formats, and direct manipulation of the Perl
+symbol table itself.  Format variables often use "local" though, as do
+other variables whose current value must be visible to called
+subroutines.
+
+Synopsis:
+
+    local $foo;	    		# declare $foo dynamically local
+    local (@wid, %get); 	# declare list of variables local
+    local $foo = "flurp";	# declare $foo dynamic, and init it
+    local @oof = @bar;		# declare @oof dynamic, and init it
+
+    local *FH;			# localize $FH, @FH, %FH, &FH  ...
+    local *merlyn = *randal;	# now $merlyn is really $randal, plus
+                                #     @merlyn is really @randal, etc
+    local *merlyn = 'randal';	# SAME THING: promote 'randal' to *randal
+    local *merlyn = \$randal;   # just alias $merlyn, not @merlyn etc 
+
+A local() modifies its listed variables to be local to the enclosing
+block, (or subroutine, C<eval{}> or C<do>) and I<the any called from
+within that block>.  A local() just gives temporary values to global
+(meaning package) variables.  This is known as dynamic scoping.  Lexical
+scoping is done with "my", which works more like C's auto declarations.
+
+If more than one variable is given to local(), they must be placed in
+parens.  All listed elements must be legal lvalues.  This operator works
+by saving the current values of those variables in its argument list on a
+hidden stack and restoring them upon exiting the block, subroutine or
+eval.  This means that called subroutines can also reference the local
+variable, but not the global one.  The argument list may be assigned to if
+desired, which allows you to initialize your local variables.  (If no
+initializer is given for a particular variable, it is created with an
+undefined value.)  Commonly this is used to name the parameters to a
+subroutine.  Examples:
+
+    for $i ( 0 .. 9 ) {
+	$digits{$i} = $i;
+    } 
+    # assume this function uses global %digits hash
+    parse_num();  
+
+    # now temporarily add to %digits hash
+    if ($base12) {
+	# (NOTE: not claiming this is efficient!)
+	local %digits  = (%digits, 't' => 10, 'e' => 11);
+	parse_num();  # parse_num gets this new %digits!
+    }
+    # old %digits restored here
+
+Because local() is a run-time command, and so gets executed every time
+through a loop.  In releases of Perl previous to 5.0, this used more stack
+storage each time until the loop was exited.  Perl now reclaims the space
+each time through, but it's still more efficient to declare your variables
+outside the loop.
+
+A local is simply a modifier on an lvalue expression.  When you assign to
+a localized variable, the local doesn't change whether its list is viewed
+as a scalar or an array.  So
+
+    local($foo) = <STDIN>;
+    local @FOO = <STDIN>;
+
+both supply a list context to the righthand side, while
+
+    local $foo = <STDIN>;
+
+supplies a scalar context.
+
+=head2 Passing Symbol Table Entries (typeglobs)
+
+[Note:  The mechanism described in this section was originally the only
+way to simulate pass-by-reference in older versions of Perl.  While it
+still works fine in modern versions, the new reference mechanism is
+generally easier to work with.  See below.]
+
+Sometimes you don't want to pass the value of an array to a subroutine
+but rather the name of it, so that the subroutine can modify the global
+copy of it rather than working with a local copy.  In perl you can
+refer to all objects of a particular name by prefixing the name
+with a star: C<*foo>.  This is often known as a "type glob", since the
+star on the front can be thought of as a wildcard match for all the
+funny prefix characters on variables and subroutines and such.
+
+When evaluated, the type glob produces a scalar value that represents
+all the objects of that name, including any filehandle, format or
+subroutine.  When assigned to, it causes the name mentioned to refer to
+whatever "*" value was assigned to it.  Example:
+
+    sub doubleary {
+	local(*someary) = @_;
+	foreach $elem (@someary) {
+	    $elem *= 2;
+	}
+    }
+    doubleary(*foo);
+    doubleary(*bar);
+
+Note that scalars are already passed by reference, so you can modify
+scalar arguments without using this mechanism by referring explicitly
+to $_[0] etc.  You can modify all the elements of an array by passing
+all the elements as scalars, but you have to use the * mechanism (or
+the equivalent reference mechanism) to push, pop or change the size of
+an array.  It will certainly be faster to pass the typeglob (or reference).
+
+Even if you don't want to modify an array, this mechanism is useful for
+passing multiple arrays in a single LIST, since normally the LIST
+mechanism will merge all the array values so that you can't extract out
+the individual arrays.  For more on typeglobs, see L<perldata/"Typeglobs">.
+
+=head2 Pass by Reference
+
+If you want to pass more than one array or hash into a function--or 
+return them from it--and have them maintain their integrity,
+then you're going to have to use an explicit pass-by-reference.
+Before you do that, you need to understand references as detailed in L<perlref>.
+This section may not make much sense to you otherwise.
+
+Here are a few simple examples.  First, let's pass in several
+arrays to a function and have it pop all of then, return a new
+list of all their former last elements:
+
+    @tailings = popmany ( \@a, \@b, \@c, \@d );
+
+    sub popmany {
+	my $aref;
+	my @retlist = ();
+	foreach $aref ( @_ ) {
+	    push @retlist, pop @$aref;
+	} 
+	return @retlist;
+    } 
+
+Here's how you might write a function that returns a 
+list of keys occurring in all the hashes passed to it:
+
+    @common = inter( \%foo, \%bar, \%joe ); 
+    sub inter {
+	my ($k, $href, %seen); # locals
+	foreach $href (@_) {
+	    while ( $k = each %$href ) {
+		$seen{$k}++;
+	    } 
+	} 
+	return grep { $seen{$_} == @_ } keys %seen;
+    } 
+
+So far, we're just using the normal list return mechanism.
+What happens if you want to pass or return a hash?  Well, 
+if you're only using one of them, or you don't mind them 
+concatenating, then the normal calling convention is ok, although
+a little expensive.  
+
+Where people get into trouble is here:
+
+    (@a, @b) = func(@c, @d);
+or
+    (%a, %b) = func(%c, %d);
+
+That syntax simply won't work.  It just sets @a or %a and clears the @b or
+%b.  Plus the function didn't get passed into two separate arrays or
+hashes: it got one long list in @_, as always.
+
+If you can arrange for everyone to deal with this through references, it's
+cleaner code, although not so nice to look at.  Here's a function that
+takes two array references as arguments, returning the two array elements
+in order of how many elements they have in them:
+
+    ($aref, $bref) = func(\@c, \@d);
+    print "@$aref has more than @$bref\n";
+    sub func {
+	my ($cref, $dref) = @_;
+	if (@$cref > @$dref) {
+	    return ($cref, $dref);
+	} else {
+	    return ($dref, $cref);
+	} 
+    } 
+
+It turns out that you can actually do this also:
+
+    (*a, *b) = func(\@c, \@d);
+    print "@a has more than @b\n";
+    sub func {
+	local (*c, *d) = @_;
+	if (@c > @d) {
+	    return (\@c, \@d);
+	} else {
+	    return (\@d, \@c);
+	} 
+    } 
+
+Here we're using the typeglobs to do symbol table aliasing.  It's
+a tad subtle, though, and also won't work if you're using my()
+variables, since only globals (well, and local()s) are in the symbol table.
+
+If you're passing around filehandles, you could usually just use the bare
+typeglob, like *STDOUT, but typeglobs references would be better because
+they'll still work properly under C<use strict 'refs'>.  For example:
+
+    splutter(\*STDOUT);
+    sub splutter {
+	my $fh = shift;
+	print $fh "her um well a hmmm\n";
+    }
+
+    $rec = get_rec(\*STDIN);
+    sub get_rec {
+	my $fh = shift;
+	return scalar <$fh>;
+    }
+
+If you're planning on generating new filehandles, you could do this:
+
+    sub openit {
+	my $name = shift;
+	local *FH;
+	return open (FH, $path) ? \*FH : undef;
+    } 
+
+Although that will actually produce a small memory leak.  See the bottom
+of L<perlfunc/open()> for a somewhat cleaner way using the FileHandle
+functions supplied with the POSIX package.
+
+=head2 Prototypes
+
+As of the 5.002 release of perl, if you declare
+
+    sub mypush (\@@)
+
+then mypush() takes arguments exactly like push() does.  The declaration
+of the function to be called must be visible at compile time.  The prototype
+only affects the interpretation of new-style calls to the function, where
+new-style is defined as not using the C<&> character.  In other words,
+if you call it like a builtin function, then it behaves like a builtin
+function.  If you call it like an old-fashioned subroutine, then it
+behaves like an old-fashioned subroutine.  It naturally falls out from
+this rule that prototypes have no influence on subroutine references
+like C<\&foo> or on indirect subroutine calls like C<&{$subref}>.
+
+Method calls are not influenced by prototypes either, because the
+function to be called is indeterminate at compile time, since it depends
+on inheritance.
+
+Since the intent is primarily to let you define subroutines that work
+like builtin commands, here are the prototypes for some other functions
+that parse almost exactly like the corresponding builtins.
+
+    Declared as			Called as
+
+    sub mylink ($$)		mylink $old, $new
+    sub myvec ($$$)		myvec $var, $offset, 1
+    sub myindex ($$;$)		myindex &getstring, "substr"
+    sub mysyswrite ($$$;$)	mysyswrite $buf, 0, length($buf) - $off, $off
+    sub myreverse (@)		myreverse $a,$b,$c
+    sub myjoin ($@)		myjoin ":",$a,$b,$c
+    sub mypop (\@)		mypop @array
+    sub mysplice (\@$$@)	mysplice @array,@array,0,@pushme
+    sub mykeys (\%)		mykeys %{$hashref}
+    sub myopen (*;$)		myopen HANDLE, $name
+    sub mypipe (**)		mypipe READHANDLE, WRITEHANDLE
+    sub mygrep (&@)		mygrep { /foo/ } $a,$b,$c
+    sub myrand ($)		myrand 42
+    sub mytime ()		mytime
+
+Any backslashed prototype character represents an actual argument
+that absolutely must start with that character.  The value passed
+to the subroutine (as part of C<@_>) will be a reference to the
+actual argument given in the subroutine call, obtained by applying
+C<\> to that argument.
+
+Unbackslashed prototype characters have special meanings.  Any
+unbackslashed @ or % eats all the rest of the arguments, and forces
+list context.  An argument represented by $ forces scalar context.  An
+& requires an anonymous subroutine, which, if passed as the first
+argument, does not require the "sub" keyword or a subsequent comma.  A
+* does whatever it has to do to turn the argument into a reference to a
+symbol table entry.
+
+A semicolon separates mandatory arguments from optional arguments.
+(It is redundant before @ or %.)
+
+Note how the last three examples above are treated specially by the parser.
+mygrep() is parsed as a true list operator, myrand() is parsed as a
+true unary operator with unary precedence the same as rand(), and
+mytime() is truly argumentless, just like time().  That is, if you
+say
+
+    mytime +2;
+
+you'll get mytime() + 2, not mytime(2), which is how it would be parsed
+without the prototype.
+
+The interesting thing about & is that you can generate new syntax with it:
+
+    sub try (&$) {
+	my($try,$catch) = @_;
+	eval { &$try };
+	if ($@) {
+	    local $_ = $@;
+	    &$catch;
+	}
+    }
+    sub catch (&) { @_ }
+
+    try {
+	die "phooey";
+    } catch {
+	/phooey/ and print "unphooey\n";
+    };
+
+That prints "unphooey".  (Yes, there are still unresolved
+issues having to do with the visibility of @_.  I'm ignoring that
+question for the moment.  (But note that if we make @_ lexically
+scoped, those anonymous subroutines can act like closures... (Gee,
+is this sounding a little Lispish?  (Nevermind.))))
+
+And here's a reimplementation of grep:
+
+    sub mygrep (&@) {
+	my $code = shift;
+	my @result;
+	foreach $_ (@_) {
+	    push(@result, $_) if &$code;
+	}
+	@result;
+    }
+
+Some folks would prefer full alphanumeric prototypes.  Alphanumerics have
+been intentionally left out of prototypes for the express purpose of
+someday in the future adding named, formal parameters.  The current
+mechanism's main goal is to let module writers provide better diagnostics
+for module users.  Larry feels the notation quite understandable to Perl
+programmers, and that it will not intrude greatly upon the meat of the
+module, nor make it harder to read.  The line noise is visually
+encapsulated into a small pill that's easy to swallow.
+
+It's probably best to prototype new functions, not retrofit prototyping
+into older ones.  That's because you must be especially careful about
+silent impositions of differing list versus scalar contexts.  For example,
+if you decide that a function should take just one parameter, like this:
+
+    sub func ($) {
+	my $n = shift;
+	print "you gave me $n\n";
+    } 
+
+and someone has been calling it with an array or expression
+returning a list:
+
+    func(@foo);
+    func( split /:/ );
+
+Then you've just supplied an automatic scalar() in front of their
+argument, which can be more than a bit surprising.  The old @foo
+which used to hold one thing doesn't get passed in.  Instead,
+the func() now gets passed in 1, that is, the number of elments
+in @foo.  And the split() gets called in a scalar context and
+starts scribbling on your @_ parameter list.
+
+This is all very powerful, of course, and should only be used in moderation
+to make the world a better place.  
+
+=head2 Overriding Builtin Functions
+
+Many builtin functions may be overridden, though this should only be
+tried occasionally and for good reason.  Typically this might be
+done by a package attempting to emulate missing builtin functionality
+on a non-Unix system.
+
+Overriding may only be done by importing the name from a
+module--ordinary predeclaration isn't good enough.  However, the
+C<subs> pragma (compiler directive) lets you, in effect, predeclare subs
+via the import syntax, and these names may then override the builtin ones:
+
+    use subs 'chdir', 'chroot', 'chmod', 'chown';
+    chdir $somewhere;
+    sub chdir { ... }
+
+Library modules should not in general export builtin names like "open"
+or "chdir" as part of their default @EXPORT list, since these may
+sneak into someone else's namespace and change the semantics unexpectedly.
+Instead, if the module adds the name to the @EXPORT_OK list, then it's
+possible for a user to import the name explicitly, but not implicitly.
+That is, they could say
+
+    use Module 'open';
+
+and it would import the open override, but if they said
+
+    use Module;
+
+they would get the default imports without the overrides.
+
+=head2 Autoloading
+
+If you call a subroutine that is undefined, you would ordinarily get an
+immediate fatal error complaining that the subroutine doesn't exist.
+(Likewise for subroutines being used as methods, when the method
+doesn't exist in any of the base classes of the class package.) If,
+however, there is an C<AUTOLOAD> subroutine defined in the package or
+packages that were searched for the original subroutine, then that
+C<AUTOLOAD> subroutine is called with the arguments that would have been
+passed to the original subroutine.  The fully qualified name of the
+original subroutine magically appears in the $AUTOLOAD variable in the
+same package as the C<AUTOLOAD> routine.  The name is not passed as an
+ordinary argument because, er, well, just because, that's why...
+
+Most C<AUTOLOAD> routines will load in a definition for the subroutine in
+question using eval, and then execute that subroutine using a special
+form of "goto" that erases the stack frame of the C<AUTOLOAD> routine
+without a trace.  (See the standard C<AutoLoader> module, for example.)
+But an C<AUTOLOAD> routine can also just emulate the routine and never
+define it.   For example, let's pretend that a function that wasn't defined
+should just call system() with those arguments.  All you'd do is this:
+
+    sub AUTOLOAD {
+	my $program = $AUTOLOAD;
+	$program =~ s/.*:://;
+	system($program, @_);
+    } 
+    date();
+    who('am', i');
+    ls('-l');
+
+In fact, if you preclare the functions you want to call that way, you don't
+even need the parentheses:
+
+    use subs qw(date who ls);
+    date;
+    who "am", "i";
+    ls -l;
+
+A more complete example of this is the standard Shell module, which
+can treat undefined subroutine calls as calls to Unix programs.
+
+Mechanisms are available for modules writers to help split the modules
+up into autoloadable files.  See the standard AutoLoader module described
+in L<Autoloader>, the standard SelfLoader modules in L<SelfLoader>, and
+the document on adding C functions to perl code in L<perlxs>.
+
+=head1 SEE ALSO
+
+See L<perlref> for more on references.  See L<perlxs> if you'd
+like to learn about calling C subroutines from perl.  See 
+L<perlmod> to learn about bundling up your functions in 
+separate files.
diff --git a/gnu/usr.bin/perl/pod/perlsyn.pod b/gnu/usr.bin/perl/pod/perlsyn.pod
new file mode 100644
index 00000000000..c3ef4501dde
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlsyn.pod
@@ -0,0 +1,508 @@
+=head1 NAME
+
+perlsyn - Perl syntax
+
+=head1 DESCRIPTION
+
+A Perl script consists of a sequence of declarations and statements.
+The only things that need to be declared in Perl are report formats
+and subroutines.  See the sections below for more information on those
+declarations.  All uninitialized user-created objects are assumed to
+start with a null or 0 value until they are defined by some explicit
+operation such as assignment.  (Though you can get warnings about the
+use of undefined values if you like.)  The sequence of statements is
+executed just once, unlike in B<sed> and B<awk> scripts, where the
+sequence of statements is executed for each input line.  While this means
+that you must explicitly loop over the lines of your input file (or
+files), it also means you have much more control over which files and
+which lines you look at.  (Actually, I'm lying--it is possible to do an
+implicit loop with either the B<-n> or B<-p> switch.  It's just not the
+mandatory default like it is in B<sed> and B<awk>.)
+
+=head2 Declarations
+
+Perl is, for the most part, a free-form language.  (The only
+exception to this is format declarations, for obvious reasons.) Comments
+are indicated by the "#" character, and extend to the end of the line.  If
+you attempt to use C</* */> C-style comments, it will be interpreted
+either as division or pattern matching, depending on the context, and C++
+C<//> comments just look like a null regular expression, so don't do
+that.
+
+A declaration can be put anywhere a statement can, but has no effect on
+the execution of the primary sequence of statements--declarations all
+take effect at compile time.  Typically all the declarations are put at
+the beginning or the end of the script.  However, if you're using 
+lexically-scoped private variables created with my(), you'll have to make sure
+your format or subroutine definition is within the same block scope
+as the my if you expect to to be able to access those private variables.
+
+Declaring a subroutine allows a subroutine name to be used as if it were a
+list operator from that point forward in the program.  You can declare a
+subroutine (prototyped to take one scalar parameter) without defining it by saying just:
+
+    sub myname ($);
+    $me = myname $0 		or die "can't get myname";
+
+Note that it functions as a list operator though, not as a unary
+operator, so be careful to use C<or> instead of C<||> there.
+
+Subroutines declarations can also be loaded up with the C<require> statement
+or both loaded and imported into your namespace with a C<use> statement.
+See L<perlmod> for details on this.
+
+A statement sequence may contain declarations of lexically-scoped
+variables, but apart from declaring a variable name, the declaration acts
+like an ordinary statement, and is elaborated within the sequence of
+statements as if it were an ordinary statement.  That means it actually
+has both compile-time and run-time effects.
+
+=head2 Simple statements
+
+The only kind of simple statement is an expression evaluated for its
+side effects.  Every simple statement must be terminated with a
+semicolon, unless it is the final statement in a block, in which case
+the semicolon is optional.  (A semicolon is still encouraged there if the
+block takes up more than one line, since you may eventually add another line.)
+Note that there are some operators like C<eval {}> and C<do {}> that look
+like compound statements, but aren't (they're just TERMs in an expression), 
+and thus need an explicit termination if used as the last item in a statement.
+
+Any simple statement may optionally be followed by a I<SINGLE> modifier,
+just before the terminating semicolon (or block ending).  The possible
+modifiers are:
+
+    if EXPR
+    unless EXPR
+    while EXPR
+    until EXPR
+
+The C<if> and C<unless> modifiers have the expected semantics,
+presuming you're a speaker of English.  The C<while> and C<until>
+modifiers also have the usual "while loop" semantics (conditional
+evaluated first), except when applied to a do-BLOCK (or to the
+now-deprecated do-SUBROUTINE statement), in which case the block
+executes once before the conditional is evaluated.  This is so that you
+can write loops like:
+
+    do {
+	$line = <STDIN>;
+	...
+    } until $line  eq ".\n";
+
+See L<perlfunc/do>.  Note also that the loop control
+statements described later will I<NOT> work in this construct, since
+modifiers don't take loop labels.  Sorry.  You can always wrap
+another block around it to do that sort of thing.
+
+=head2 Compound statements
+
+In Perl, a sequence of statements that defines a scope is called a block.
+Sometimes a block is delimited by the file containing it (in the case
+of a required file, or the program as a whole), and sometimes a block
+is delimited by the extent of a string (in the case of an eval).
+
+But generally, a block is delimited by curly brackets, also known as braces.
+We will call this syntactic construct a BLOCK.
+
+The following compound statements may be used to control flow:
+
+    if (EXPR) BLOCK
+    if (EXPR) BLOCK else BLOCK
+    if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
+    LABEL while (EXPR) BLOCK
+    LABEL while (EXPR) BLOCK continue BLOCK
+    LABEL for (EXPR; EXPR; EXPR) BLOCK
+    LABEL foreach VAR (LIST) BLOCK
+    LABEL BLOCK continue BLOCK
+
+Note that, unlike C and Pascal, these are defined in terms of BLOCKs,
+not statements.  This means that the curly brackets are I<required>--no
+dangling statements allowed.  If you want to write conditionals without
+curly brackets there are several other ways to do it.  The following
+all do the same thing:
+
+    if (!open(FOO)) { die "Can't open $FOO: $!"; }
+    die "Can't open $FOO: $!" unless open(FOO);
+    open(FOO) or die "Can't open $FOO: $!";	# FOO or bust!
+    open(FOO) ? 'hi mom' : die "Can't open $FOO: $!";
+			# a bit exotic, that last one
+
+The C<if> statement is straightforward.  Since BLOCKs are always
+bounded by curly brackets, there is never any ambiguity about which
+C<if> an C<else> goes with.  If you use C<unless> in place of C<if>,
+the sense of the test is reversed.
+
+The C<while> statement executes the block as long as the expression is
+true (does not evaluate to the null string or 0 or "0").  The LABEL is
+optional, and if present, consists of an identifier followed by a colon.
+The LABEL identifies the loop for the loop control statements C<next>,
+C<last>, and C<redo>.  If the LABEL is omitted, the loop control statement
+refers to the innermost enclosing loop.  This may include dynamically
+looking back your call-stack at run time to find the LABEL.  Such
+desperate behavior triggers a warning if you use the B<-w> flag.
+
+If there is a C<continue> BLOCK, it is always executed just before the
+conditional is about to be evaluated again, just like the third part of a
+C<for> loop in C.  Thus it can be used to increment a loop variable, even
+when the loop has been continued via the C<next> statement (which is
+similar to the C C<continue> statement).
+
+=head2 Loop Control
+
+The C<next> command is like the C<continue> statement in C; it starts
+the next iteration of the loop:
+
+    LINE: while (<STDIN>) {
+	next LINE if /^#/;	# discard comments
+	...
+    }
+
+The C<last> command is like the C<break> statement in C (as used in
+loops); it immediately exits the loop in question.  The
+C<continue> block, if any, is not executed:
+
+    LINE: while (<STDIN>) {
+	last LINE if /^$/;	# exit when done with header
+	...
+    }
+
+The C<redo> command restarts the loop block without evaluating the
+conditional again.  The C<continue> block, if any, is I<not> executed.
+This command is normally used by programs that want to lie to themselves
+about what was just input.
+
+For example, when processing a file like F</etc/termcap>.
+If your input lines might end in backslashes to indicate continuation, you
+want to skip ahead and get the next record.
+
+    while (<>) {
+	chomp;
+	if (s/\\$//) { 
+	    $_ .= <>; 
+	    redo unless eof();
+	}
+	# now process $_
+    } 
+
+which is Perl short-hand for the more explicitly written version:
+
+    LINE: while ($line = <ARGV>) {
+	chomp($line);
+	if ($line =~ s/\\$//) { 
+	    $line .= <ARGV>; 
+	    redo LINE unless eof(); # not eof(ARGV)!
+	}
+	# now process $line
+    } 
+
+Or here's a a simpleminded Pascal comment stripper (warning: assumes no { or } in strings)
+
+    LINE: while (<STDIN>) {
+	while (s|({.*}.*){.*}|$1 |) {}
+	s|{.*}| |;
+	if (s|{.*| |) {
+	    $front = $_;
+	    while (<STDIN>) {
+		if (/}/) {	# end of comment?
+		    s|^|$front{|;
+		    redo LINE;
+		}
+	    }
+	}
+	print;
+    }
+
+Note that if there were a C<continue> block on the above code, it would get
+executed even on discarded lines.
+
+If the word C<while> is replaced by the word C<until>, the sense of the
+test is reversed, but the conditional is still tested before the first
+iteration.
+
+In either the C<if> or the C<while> statement, you may replace "(EXPR)"
+with a BLOCK, and the conditional is true if the value of the last
+statement in that block is true.  While this "feature" continues to work in 
+version 5, it has been deprecated, so please change any occurrences of "if BLOCK" to
+"if (do BLOCK)".
+
+=head2 For Loops
+
+Perl's C-style C<for> loop works exactly like the corresponding C<while> loop;
+that means that this:
+
+    for ($i = 1; $i < 10; $i++) {
+	...
+    }
+
+is the same as this:
+
+    $i = 1;
+    while ($i < 10) {
+	...
+    } continue {
+	$i++;
+    }
+
+Besides the normal array index looping, C<for> can lend itself
+to many other interesting applications.  Here's one that avoids the
+problem you get into if you explicitly test for end-of-file on 
+an interactive file descriptor causing your program to appear to 
+hang.
+
+    $on_a_tty = -t STDIN && -t STDOUT;
+    sub prompt { print "yes? " if $on_a_tty }
+    for ( prompt(); <STDIN>; prompt() ) {
+	# do something
+    } 
+
+=head2 Foreach Loops
+
+The C<foreach> loop iterates over a normal list value and sets the
+variable VAR to be each element of the list in turn.  The variable is
+implicitly local to the loop and regains its former value upon exiting the
+loop.  If the variable was previously declared with C<my>, it uses that
+variable instead of the global one, but it's still localized to the loop.
+This can cause problems if you have subroutine or format declarations
+within that block's scope.
+
+The C<foreach> keyword is actually a synonym for the C<for> keyword, so
+you can use C<foreach> for readability or C<for> for brevity.  If VAR is
+omitted, $_ is set to each value.  If LIST is an actual array (as opposed
+to an expression returning a list value), you can modify each element of
+the array by modifying VAR inside the loop.  That's because the C<foreach>
+loop index variable is an implicit alias for each item in the list that
+you're looping over.
+
+Examples:
+
+    for (@ary) { s/foo/bar/ }
+
+    foreach $elem (@elements) {
+	$elem *= 2;
+    }
+
+    for $count (10,9,8,7,6,5,4,3,2,1,'BOOM') {
+	print $count, "\n"; sleep(1);
+    }
+
+    for (1..15) { print "Merry Christmas\n"; }
+
+    foreach $item (split(/:[\\\n:]*/, $ENV{TERMCAP})) {
+	print "Item: $item\n";
+    }
+
+Here's how a C programmer might code up a particular algorithm in Perl:
+
+    for ($i = 0; $i < @ary1; $i++) {
+	for ($j = 0; $j < @ary2; $j++) {
+	    if ($ary1[$i] > $ary2[$j]) {
+		last; # can't go to outer :-(
+	    }
+	    $ary1[$i] += $ary2[$j];
+	}
+	# this is where that last takes me
+    }
+
+Whereas here's how a Perl programmer more confortable with the idiom might
+do it:
+
+    OUTER: foreach $wid (@ary1) { 
+    INNER:   foreach $jet (@ary2) {
+		next OUTER if $wid > $jet;
+		$wid += $jet;
+	     } 
+	  } 
+
+See how much easier this is?  It's cleaner, safer, and faster.  It's
+cleaner because it's less noisy.  It's safer because if code gets added
+between the inner and outer loops later on, the new code won't be
+accidentally executed, the C<next> explicitly iterates the other loop
+rather than merely terminating the inner one.  And it's faster because
+Perl executes a C<foreach> statement more rapidly than it would the
+equivalent C<for> loop.
+
+=head2 Basic BLOCKs and Switch Statements
+
+A BLOCK by itself (labeled or not) is semantically equivalent to a loop
+that executes once.  Thus you can use any of the loop control
+statements in it to leave or restart the block.  (Note that this
+is I<NOT> true in C<eval{}>, C<sub{}>, or contrary to popular belief C<do{}> blocks,
+which do I<NOT> count as loops.)  The C<continue> block
+is optional.  
+
+The BLOCK construct is particularly nice for doing case
+structures.
+
+    SWITCH: {
+	if (/^abc/) { $abc = 1; last SWITCH; }
+	if (/^def/) { $def = 1; last SWITCH; }
+	if (/^xyz/) { $xyz = 1; last SWITCH; }
+	$nothing = 1;
+    }
+
+There is no official switch statement in Perl, because there are
+already several ways to write the equivalent.  In addition to the
+above, you could write
+
+    SWITCH: {
+	$abc = 1, last SWITCH  if /^abc/;
+	$def = 1, last SWITCH  if /^def/;
+	$xyz = 1, last SWITCH  if /^xyz/;
+	$nothing = 1;
+    }
+
+(That's actually not as strange as it looks once you realize that you can
+use loop control "operators" within an expression,  That's just the normal
+C comma operator.)
+
+or
+
+    SWITCH: {
+	/^abc/ && do { $abc = 1; last SWITCH; };
+	/^def/ && do { $def = 1; last SWITCH; };
+	/^xyz/ && do { $xyz = 1; last SWITCH; };
+	$nothing = 1;
+    }
+
+or formatted so it stands out more as a "proper" switch statement:
+
+    SWITCH: {
+	/^abc/ 	    && do { 
+			    $abc = 1; 
+			    last SWITCH; 
+		       };
+
+	/^def/ 	    && do { 
+			    $def = 1; 
+			    last SWITCH; 
+		       };
+
+	/^xyz/ 	    && do { 
+			    $xyz = 1; 
+			    last SWITCH; 
+		        };
+	$nothing = 1;
+    }
+
+or
+
+    SWITCH: {
+	/^abc/ and $abc = 1, last SWITCH;
+	/^def/ and $def = 1, last SWITCH;
+	/^xyz/ and $xyz = 1, last SWITCH;
+	$nothing = 1;
+    }
+
+or even, horrors,
+
+    if (/^abc/)
+	{ $abc = 1 }
+    elsif (/^def/)
+	{ $def = 1 }
+    elsif (/^xyz/)
+	{ $xyz = 1 }
+    else
+	{ $nothing = 1 }
+
+
+A common idiom for a switch statement is to use C<foreach>'s aliasing to make
+a temporary assignment to $_ for convenient matching:
+
+    SWITCH: for ($where) {
+		/In Card Names/     && do { push @flags, '-e'; last; };
+		/Anywhere/          && do { push @flags, '-h'; last; };
+		/In Rulings/        && do {                    last; };
+		die "unknown value for form variable where: `$where'";
+	    } 
+
+Another interesting approach to a switch statement is arrange
+for a C<do> block to return the proper value:
+
+    $amode = do {
+	if     ($flag & O_RDONLY) { "r" } 
+	elsif  ($flag & O_WRONLY) { ($flag & O_APPEND) ? "a" : "w" } 
+	elsif  ($flag & O_RDWR)   {
+	    if ($flag & O_CREAT)  { "w+" }
+	    else                  { ($flag & O_APPEND) ? "a+" : "r+" }
+	}
+    };
+
+=head2 Goto
+
+Although not for the faint of heart, Perl does support a C<goto> statement.
+A loop's LABEL is not actually a valid target for a C<goto>;
+it's just the name of the loop.  There are three forms: goto-LABEL,
+goto-EXPR, and goto-&NAME.
+
+The goto-LABEL form finds the statement labeled with LABEL and resumes
+execution there.  It may not be used to go into any construct that
+requires initialization, such as a subroutine or a foreach loop.  It
+also can't be used to go into a construct that is optimized away.  It
+can be used to go almost anywhere else within the dynamic scope,
+including out of subroutines, but it's usually better to use some other
+construct such as last or die.  The author of Perl has never felt the
+need to use this form of goto (in Perl, that is--C is another matter).
+
+The goto-EXPR form expects a label name, whose scope will be resolved
+dynamically.  This allows for computed gotos per FORTRAN, but isn't
+necessarily recommended if you're optimizing for maintainability:
+
+    goto ("FOO", "BAR", "GLARCH")[$i];
+
+The goto-&NAME form is highly magical, and substitutes a call to the
+named subroutine for the currently running subroutine.  This is used by
+AUTOLOAD() subroutines that wish to load another subroutine and then
+pretend that the other subroutine had been called in the first place
+(except that any modifications to @_ in the current subroutine are
+propagated to the other subroutine.)  After the C<goto>, not even caller()
+will be able to tell that this routine was called first.
+
+In almost all cases like this, it's usually a far, far better idea to use the
+structured control flow mechanisms of C<next>, C<last>, or C<redo> instead of
+resorting to a C<goto>.  For certain applications, the catch and throw pair of
+C<eval{}> and die() for exception processing can also be a prudent approach.
+
+=head2 PODs: Embedded Documentation
+
+Perl has a mechanism for intermixing documentation with source code.
+While it's expecting the beginning of a new statement, if the compiler
+encounters a line that begins with an equal sign and a word, like this
+
+    =head1 Here There Be Pods!
+
+Then that text and all remaining text up through and including a line
+beginning with C<=cut> will be ignored.  The format of the intervening
+text is described in L<perlpod>. 
+
+This allows you to intermix your source code
+and your documentation text freely, as in
+
+    =item snazzle($)
+
+    The snazzle() function will behave in the most spectacular 
+    form that you can possibly imagine, not even excepting
+    cybernetic pyrotechnics.
+
+    =cut back to the compiler, nuff of this pod stuff!
+
+    sub snazzle($) {
+	my $thingie = shift;
+	.........
+    } 
+
+Note that pod translators should only look at paragraphs beginning 
+with a pod diretive (it makes parsing easier), whereas the compiler
+actually knows to look for pod escapes even in the middle of a 
+paragraph.  This means that the following secret stuff will be
+ignored by both the compiler and the translators.
+
+    $a=3;
+    =secret stuff
+     warn "Neither POD nor CODE!?"
+    =cut back
+    print "got $a\n";
+
+You probably shouldn't rely upon the warn() being podded out forever.
+Not all pod translators are well-behaved in this regard, and perhaps
+the compiler will become pickier.
diff --git a/gnu/usr.bin/perl/pod/perltie.pod b/gnu/usr.bin/perl/pod/perltie.pod
new file mode 100644
index 00000000000..96f61eb4360
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perltie.pod
@@ -0,0 +1,626 @@
+=head1 NAME
+
+perltie - how to hide an object class in a simple variable
+
+=head1 SYNOPSIS
+
+ tie VARIABLE, CLASSNAME, LIST
+
+ $object = tied VARIABLE
+
+ untie VARIABLE
+
+=head1 DESCRIPTION
+
+Prior to release 5.0 of Perl, a programmer could use dbmopen()
+to magically connect an on-disk database in the standard Unix dbm(3x)
+format to a %HASH in their program.  However, their Perl was either
+built with one particular dbm library or another, but not both, and
+you couldn't extend this mechanism to other packages or types of variables.
+
+Now you can.
+
+The tie() function binds a variable to a class (package) that will provide
+the implementation for access methods for that variable.  Once this magic
+has been performed, accessing a tied variable automatically triggers
+method calls in the proper class.  All of the complexity of the class is
+hidden behind magic methods calls.  The method names are in ALL CAPS,
+which is a convention that Perl uses to indicate that they're called
+implicitly rather than explicitly--just like the BEGIN() and END()
+functions.
+
+In the tie() call, C<VARIABLE> is the name of the variable to be
+enchanted.  C<CLASSNAME> is the name of a class implementing objects of
+the correct type.  Any additional arguments in the C<LIST> are passed to
+the appropriate constructor method for that class--meaning TIESCALAR(),
+TIEARRAY(), or TIEHASH().  (Typically these are arguments such as might be
+passed to the dbminit() function of C.) The object returned by the "new"
+method is also returned by the tie() function, which would be useful if
+you wanted to access other methods in C<CLASSNAME>. (You don't actually
+have to return a reference to a right "type" (e.g. HASH or C<CLASSNAME>)
+so long as it's a properly blessed object.)  You can also retrieve
+a reference to the underlying object using the tied() function.
+
+Unlike dbmopen(), the tie() function will not C<use> or C<require> a module
+for you--you need to do that explicitly yourself.
+
+=head2 Tying Scalars
+
+A class implementing a tied scalar should define the following methods:
+TIESCALAR, FETCH, STORE, and possibly DESTROY.
+
+Let's look at each in turn, using as an example a tie class for
+scalars that allows the user to do something like:
+
+    tie $his_speed, 'Nice', getppid();
+    tie $my_speed,  'Nice', $$;
+
+And now whenever either of those variables is accessed, its current
+system priority is retrieved and returned.  If those variables are set,
+then the process's priority is changed!
+
+We'll use Jarkko Hietaniemi F<E<lt>Jarkko.Hietaniemi@hut.fiE<gt>>'s
+BSD::Resource class (not included) to access the PRIO_PROCESS, PRIO_MIN,
+and PRIO_MAX constants from your system, as well as the getpriority() and
+setpriority() system calls.  Here's the preamble of the class.
+
+    package Nice;
+    use Carp;
+    use BSD::Resource;
+    use strict;
+    $Nice::DEBUG = 0 unless defined $Nice::DEBUG;
+
+=over
+
+=item TIESCALAR classname, LIST
+
+This is the constructor for the class.  That means it is
+expected to return a blessed reference to a new scalar
+(probably anonymous) that it's creating.  For example:
+
+    sub TIESCALAR {
+        my $class = shift;
+        my $pid = shift || $$; # 0 means me
+
+        if ($pid !~ /^\d+$/) {
+            carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
+            return undef;
+        }
+
+        unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
+            carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
+            return undef;
+        }
+
+        return bless \$pid, $class;
+    }
+
+This tie class has chosen to return an error rather than raising an
+exception if its constructor should fail.  While this is how dbmopen() works,
+other classes may well not wish to be so forgiving.  It checks the global
+variable C<$^W> to see whether to emit a bit of noise anyway.
+
+=item FETCH this
+
+This method will be triggered every time the tied variable is accessed
+(read).  It takes no arguments beyond its self reference, which is the
+object representing the scalar we're dealing with.  Since in this case
+we're just using a SCALAR ref for the tied scalar object, a simple $$self
+allows the method to get at the real value stored there.  In our example
+below, that real value is the process ID to which we've tied our variable.
+
+    sub FETCH {
+        my $self = shift;
+        confess "wrong type" unless ref $self;
+        croak "usage error" if @_;
+        my $nicety;
+        local($!) = 0;
+        $nicety = getpriority(PRIO_PROCESS, $$self);
+        if ($!) { croak "getpriority failed: $!" }
+        return $nicety;
+    }
+
+This time we've decided to blow up (raise an exception) if the renice
+fails--there's no place for us to return an error otherwise, and it's
+probably the right thing to do.
+
+=item STORE this, value
+
+This method will be triggered every time the tied variable is set
+(assigned).  Beyond its self reference, it also expects one (and only one)
+argument--the new value the user is trying to assign.
+
+    sub STORE {
+        my $self = shift;
+        confess "wrong type" unless ref $self;
+        my $new_nicety = shift;
+        croak "usage error" if @_;
+
+        if ($new_nicety < PRIO_MIN) {
+            carp sprintf
+              "WARNING: priority %d less than minimum system priority %d",
+                  $new_nicety, PRIO_MIN if $^W;
+            $new_nicety = PRIO_MIN;
+        }
+
+        if ($new_nicety > PRIO_MAX) {
+            carp sprintf
+              "WARNING: priority %d greater than maximum system priority %d",
+                  $new_nicety, PRIO_MAX if $^W;
+            $new_nicety = PRIO_MAX;
+        }
+
+        unless (defined setpriority(PRIO_PROCESS, $$self, $new_nicety)) {
+            confess "setpriority failed: $!";
+        }
+        return $new_nicety;
+    }
+
+=item DESTROY this
+
+This method will be triggered when the tied variable needs to be destructed.
+As with other object classes, such a method is seldom ncessary, since Perl
+deallocates its moribund object's memory for you automatically--this isn't
+C++, you know.  We'll use a DESTROY method here for debugging purposes only.
+
+    sub DESTROY {
+        my $self = shift;
+        confess "wrong type" unless ref $self;
+        carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
+    }
+
+=back
+
+That's about all there is to it.  Actually, it's more than all there
+is to it, since we've done a few nice things here for the sake
+of completeness, robustness, and general aesthetics.  Simpler
+TIESCALAR classes are certainly possible.
+
+=head2 Tying Arrays
+
+A class implementing a tied ordinary array should define the following
+methods: TIEARRAY, FETCH, STORE, and perhaps DESTROY.
+
+B<WARNING>: Tied arrays are I<incomplete>.  They are also distinctly lacking
+something for the C<$#ARRAY> access (which is hard, as it's an lvalue), as
+well as the other obvious array functions, like push(), pop(), shift(),
+unshift(), and splice().
+
+For this discussion, we'll implement an array whose indices are fixed at
+its creation.  If you try to access anything beyond those bounds, you'll
+take an exception.  (Well, if you access an individual element; an
+aggregate assignment would be missed.) For example:
+
+    require Bounded_Array;
+    tie @ary, Bounded_Array, 2;
+    $| = 1;
+    for $i (0 .. 10) {
+        print "setting index $i: ";
+        $ary[$i] = 10 * $i;
+        $ary[$i] = 10 * $i;
+        print "value of elt $i now $ary[$i]\n";
+    }
+
+The preamble code for the class is as follows:
+
+    package Bounded_Array;
+    use Carp;
+    use strict;
+
+=over
+
+=item TIEARRAY classname, LIST
+
+This is the constructor for the class.  That means it is expected to
+return a blessed reference through which the new array (probably an
+anonymous ARRAY ref) will be accessed.
+
+In our example, just to show you that you don't I<really> have to return an
+ARRAY reference, we'll choose a HASH reference to represent our object.
+A HASH works out well as a generic record type: the C<{BOUND}> field will
+store the maximum bound allowed, and the C<{ARRAY}> field will hold the
+true ARRAY ref.  If someone outside the class tries to dereference the
+object returned (doubtless thinking it an ARRAY ref), they'll blow up.
+This just goes to show you that you should respect an object's privacy.
+
+    sub TIEARRAY {
+	my $class = shift;
+	my $bound = shift;
+	confess "usage: tie(\@ary, 'Bounded_Array', max_subscript)"
+	    if @_ || $bound =~ /\D/;
+	return bless {
+	    BOUND => $bound,
+	    ARRAY => [],
+	}, $class;
+    }
+
+=item FETCH this, index
+
+This method will be triggered every time an individual element the tied array
+is accessed (read).  It takes one argument beyond its self reference: the
+index whose value we're trying to fetch.
+
+    sub FETCH {
+      my($self,$idx) = @_;
+      if ($idx > $self->{BOUND}) {
+	confess "Array OOB: $idx > $self->{BOUND}";
+      }
+      return $self->{ARRAY}[$idx];
+    }
+
+As you may have noticed, the name of the FETCH method (et al.) is the same
+for all accesses, even though the constructors differ in names (TIESCALAR
+vs TIEARRAY).  While in theory you could have the same class servicing
+several tied types, in practice this becomes cumbersome, and it's easiest
+to simply keep them at one tie type per class.
+
+=item STORE this, index, value
+
+This method will be triggered every time an element in the tied array is set
+(written).  It takes two arguments beyond its self reference: the index at
+which we're trying to store something and the value we're trying to put
+there.  For example:
+
+    sub STORE {
+      my($self, $idx, $value) = @_;
+      print "[STORE $value at $idx]\n" if _debug;
+      if ($idx > $self->{BOUND} ) {
+        confess "Array OOB: $idx > $self->{BOUND}";
+      }
+      return $self->{ARRAY}[$idx] = $value;
+    }
+
+=item DESTROY this
+
+This method will be triggered when the tied variable needs to be destructed.
+As with the sclar tie class, this is almost never needed in a
+language that does its own garbage collection, so this time we'll
+just leave it out.
+
+=back
+
+The code we presented at the top of the tied array class accesses many
+elements of the array, far more than we've set the bounds to.  Therefore,
+it will blow up once they try to access beyond the 2nd element of @ary, as
+the following output demonstrates:
+
+    setting index 0: value of elt 0 now 0
+    setting index 1: value of elt 1 now 10
+    setting index 2: value of elt 2 now 20
+    setting index 3: Array OOB: 3 > 2 at Bounded_Array.pm line 39
+            Bounded_Array::FETCH called at testba line 12
+
+=head2 Tying Hashes
+
+As the first Perl data type to be tied (see dbmopen()), associative arrays
+have the most complete and useful tie() implementation.  A class
+implementing a tied associative array should define the following
+methods:  TIEHASH is the constructor.  FETCH and STORE access the key and
+value pairs.  EXISTS reports whether a key is present in the hash, and
+DELETE deletes one.  CLEAR empties the hash by deleting all the key and
+value pairs.  FIRSTKEY and NEXTKEY implement the keys() and each()
+functions to iterate over all the keys.  And DESTROY is called when the
+tied variable is garbage collected.
+
+If this seems like a lot, then feel free to merely inherit
+from the standard Tie::Hash module for most of your methods, redefining only
+the interesting ones.  See L<Tie::Hash> for details.
+
+Remember that Perl distinguishes between a key not existing in the hash,
+and the key existing in the hash but having a corresponding value of
+C<undef>.  The two possibilities can be tested with the C<exists()> and
+C<defined()> functions.
+
+Here's an example of a somewhat interesting tied hash class:  it gives you
+a hash representing a particular user's dotfiles.  You index into the hash
+with the name of the file (minus the dot) and you get back that dotfile's
+contents.  For example:
+
+    use DotFiles;
+    tie %dot, DotFiles;
+    if ( $dot{profile} =~ /MANPATH/ ||
+         $dot{login}   =~ /MANPATH/ ||
+         $dot{cshrc}   =~ /MANPATH/    )
+    {
+	print "you seem to set your manpath\n";
+    }
+
+Or here's another sample of using our tied class:
+
+    tie %him, DotFiles, 'daemon';
+    foreach $f ( keys %him ) {
+	printf "daemon dot file %s is size %d\n",
+	    $f, length $him{$f};
+    }
+
+In our tied hash DotFiles example, we use a regular
+hash for the object containing several important
+fields, of which only the C<{LIST}> field will be what the
+user thinks of as the real hash.
+
+=over 5
+
+=item USER
+
+whose dot files this object represents
+
+=item HOME
+
+where those dotfiles live
+
+=item CLOBBER
+
+whether we should try to change or remove those dot files
+
+=item LIST
+
+the hash of dotfile names and content mappings
+
+=back
+
+Here's the start of F<Dotfiles.pm>:
+
+    package DotFiles;
+    use Carp;
+    sub whowasi { (caller(1))[3] . '()' }
+    my $DEBUG = 0;
+    sub debug { $DEBUG = @_ ? shift : 1 }
+
+For our example, we want to able to emit debugging info to help in tracing
+during development.  We keep also one convenience function around
+internally to help print out warnings; whowasi() returns the function name
+that calls it.
+
+Here are the methods for the DotFiles tied hash.
+
+=over
+
+=item TIEHASH classname, LIST
+
+This is the constructor for the class.  That means it is expected to
+return a blessed reference through which the new object (probably but not
+necessarily an anonymous hash) will be accessed.
+
+Here's the constructor:
+
+    sub TIEHASH {
+	my $self = shift;
+	my $user = shift || $>;
+	my $dotdir = shift || '';
+	croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
+	$user = getpwuid($user) if $user =~ /^\d+$/;
+	my $dir = (getpwnam($user))[7]
+		|| croak "@{[&whowasi]}: no user $user";
+	$dir .= "/$dotdir" if $dotdir;
+
+	my $node = {
+	    USER    => $user,
+	    HOME    => $dir,
+	    LIST    => {},
+	    CLOBBER => 0,
+	};
+
+	opendir(DIR, $dir)
+		|| croak "@{[&whowasi]}: can't opendir $dir: $!";
+	foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
+	    $dot =~ s/^\.//;
+	    $node->{LIST}{$dot} = undef;
+	}
+	closedir DIR;
+	return bless $node, $self;
+    }
+
+It's probably worth mentioning that if you're going to filetest the
+return values out of a readdir, you'd better prepend the directory
+in question.  Otherwise, since we didn't chdir() there, it would
+have been testing the wrong file.  
+
+=item FETCH this, key
+
+This method will be triggered every time an element in the tied hash is
+accessed (read).  It takes one argument beyond its self reference: the key
+whose value we're trying to fetch.
+
+Here's the fetch for our DotFiles example.
+
+    sub FETCH {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	my $dot = shift;
+	my $dir = $self->{HOME};
+	my $file = "$dir/.$dot";
+
+	unless (exists $self->{LIST}->{$dot} || -f $file) {
+	    carp "@{[&whowasi]}: no $dot file" if $DEBUG;
+	    return undef;
+	}
+
+	if (defined $self->{LIST}->{$dot}) {
+	    return $self->{LIST}->{$dot};
+	} else {
+	    return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
+	}
+    }
+
+It was easy to write by having it call the Unix cat(1) command, but it
+would probably be more portable to open the file manually (and somewhat
+more efficient).  Of course, since dot files are a Unixy concept, we're
+not that concerned.
+
+=item STORE this, key, value
+
+This method will be triggered every time an element in the tied hash is set
+(written).  It takes two arguments beyond its self reference: the index at
+which we're trying to store something, and the value we're trying to put
+there.
+
+Here in our DotFiles example, we'll be careful not to let
+them try to overwrite the file unless they've called the clobber()
+method on the original object reference returned by tie().
+
+    sub STORE {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	my $dot = shift;
+	my $value = shift;
+	my $file = $self->{HOME} . "/.$dot";
+	my $user = $self->{USER};
+
+	croak "@{[&whowasi]}: $file not clobberable"
+	    unless $self->{CLOBBER};
+
+	open(F, "> $file") || croak "can't open $file: $!";
+	print F $value;
+	close(F);
+    }
+
+If they wanted to clobber something, they might say:
+
+    $ob = tie %daemon_dots, 'daemon';
+    $ob->clobber(1);
+    $daemon_dots{signature} = "A true daemon\n";
+
+Another way to lay hands on a reference to the underlying object is to
+use the tied() function, so they might alternately have set clobber
+using:
+
+    tie %daemon_dots, 'daemon';
+    tied(%daemon_dots)->clobber(1);
+
+The clobber method is simply:
+
+    sub clobber {
+	my $self = shift;
+	$self->{CLOBBER} = @_ ? shift : 1;
+    }
+
+=item DELETE this, key
+
+This method is triggered when we remove an element from the hash,
+typically by using the delete() function.  Again, we'll
+be careful to check whether they really want to clobber files.
+
+    sub DELETE   {
+	carp &whowasi if $DEBUG;
+
+	my $self = shift;
+	my $dot = shift;
+	my $file = $self->{HOME} . "/.$dot";
+	croak "@{[&whowasi]}: won't remove file $file"
+	    unless $self->{CLOBBER};
+	delete $self->{LIST}->{$dot};
+	unlink($file) || carp "@{[&whowasi]}: can't unlink $file: $!";
+    }
+
+=item CLEAR this
+
+This method is triggered when the whole hash is to be cleared, usually by
+assigning the empty list to it.
+
+In our example, that would remove all the user's dotfiles!  It's such a
+dangerous thing that they'll have to set CLOBBER to something higher than
+1 to make it happen.
+
+    sub CLEAR    {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	croak "@{[&whowasi]}: won't remove all dotfiles for $self->{USER}"
+	    unless $self->{CLOBBER} > 1;
+	my $dot;
+	foreach $dot ( keys %{$self->{LIST}}) {
+	    $self->DELETE($dot);
+	}
+    }
+
+=item EXISTS this, key
+
+This method is triggered when the user uses the exists() function
+on a particular hash.  In our example, we'll look at the C<{LIST}>
+hash element for this:
+
+    sub EXISTS   {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	my $dot = shift;
+	return exists $self->{LIST}->{$dot};
+    }
+
+=item FIRSTKEY this
+
+This method will be triggered when the user is going
+to iterate through the hash, such as via a keys() or each()
+call.
+
+    sub FIRSTKEY {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	my $a = keys %{$self->{LIST}};		# reset each() iterator
+	each %{$self->{LIST}}
+    }
+
+=item NEXTKEY this, lastkey
+
+This method gets triggered during a keys() or each() iteration.  It has a
+second argument which is the last key that had been accessed.  This is
+useful if you're carrying about ordering or calling the iterator from more
+than one sequence, or not really storing things in a hash anywhere.
+
+For our example, we our using a real hash so we'll just do the simple
+thing, but we'll have to indirect through the LIST field.
+
+    sub NEXTKEY  {
+	carp &whowasi if $DEBUG;
+	my $self = shift;
+	return each %{ $self->{LIST} }
+    }
+
+=item DESTROY this
+
+This method is triggered when a tied hash is about to go out of
+scope.  You don't really need it unless you're trying to add debugging
+or have auxiliary state to clean up.  Here's a very simple function:
+
+    sub DESTROY  {
+	carp &whowasi if $DEBUG;
+    }
+
+=back
+
+Note that functions such as keys() and values() may return huge array
+values when used on large objects, like DBM files.  You may prefer to
+use the each() function to iterate over such.  Example:
+
+    # print out history file offsets
+    use NDBM_File;
+    tie(%HIST, NDBM_File, '/usr/lib/news/history', 1, 0);
+    while (($key,$val) = each %HIST) {
+        print $key, ' = ', unpack('L',$val), "\n";
+    }
+    untie(%HIST);
+
+=head2 Tying FileHandles
+
+This isn't implemented yet.  Sorry; maybe someday.
+
+=head1 SEE ALSO
+
+See L<DB_File> or L<Config> for some interesting tie() implementations.
+
+=head1 BUGS
+
+Tied arrays are I<incomplete>.  They are also distinctly lacking something
+for the C<$#ARRAY> access (which is hard, as it's an lvalue), as well as
+the other obvious array functions, like push(), pop(), shift(), unshift(),
+and splice().
+
+You cannot easily tie a multilevel data structure (such as a hash of
+hashes) to a dbm file.  The first problem is that all but GDBM and
+Berkeley DB have size limitations, but beyond that, you also have problems
+with how references are to be represented on disk.  One experimental
+module that does attempt to partially address this need is the MLDBM
+module.  Check your nearest CPAN site as described in L<perlmod> for
+source code to MLDBM.
+
+=head1 AUTHOR
+
+Tom Christiansen
diff --git a/gnu/usr.bin/perl/pod/perltoc.pod b/gnu/usr.bin/perl/pod/perltoc.pod
new file mode 100644
index 00000000000..d761fcb1505
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perltoc.pod
@@ -0,0 +1,3153 @@
+
+=head1 NAME
+
+perltoc - perl documentation table of contents
+
+=head1 DESCRIPTION
+
+This page provides a brief table of contents for the rest of the Perl
+documentation set.  It is meant to be be quickly scanned or grepped
+through to locate the proper section you're looking for.
+
+=head1 BASIC DOCUMENTATION
+
+
+
+
+=head2 perl - Practical Extraction and Report Language
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+Many usability enhancements, Simplified grammar, Lexical scoping,
+Arbitrarily nested data structures, Modularity and reusability,
+Object-oriented programming, Embeddable and Extensible, POSIX
+compliant, Package constructors and destructors, Multiple simultaneous
+DBM implementations, Subroutine definitions may now be autoloaded,
+Regular expression enhancements
+
+=item ENVIRONMENT
+
+
+HOME, LOGDIR, PATH, PERL5LIB, PERL5DB, PERLLIB
+
+=item AUTHOR
+
+
+=item FILES
+
+
+=item SEE ALSO
+
+
+=item DIAGNOSTICS
+
+
+=item BUGS
+
+
+=item NOTES
+
+
+
+
+
+=head2 perldata - Perl data types
+
+=item DESCRIPTION
+
+
+=over
+
+=item Variable names
+
+
+=item Context
+
+
+=item Scalar values
+
+
+=item Scalar value constructors
+
+
+=item List value constructors
+
+
+=item Typeglobs and FileHandles
+
+
+
+
+=back
+
+
+
+
+=head2 perlsyn - Perl syntax
+
+=item DESCRIPTION
+
+
+=over
+
+=item Declarations
+
+
+=item Simple statements
+
+
+=item Compound statements
+
+
+=item Loop Control
+
+
+=item For Loops
+
+
+=item Foreach Loops
+
+
+=item Basic BLOCKs and Switch Statements
+
+
+=item Goto
+
+
+=item PODs: Embedded Documentation
+
+
+
+
+=back
+
+
+
+
+=head2 perlop - Perl operators and precedence
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Terms and List Operators (Leftward)
+
+
+=item The Arrow Operator
+
+
+=item Autoincrement and Autodecrement
+
+
+=item Exponentiation
+
+
+=item Symbolic Unary Operators
+
+
+=item Binding Operators
+
+
+=item Multiplicative Operators
+
+
+=item Additive Operators
+
+
+=item Shift Operators
+
+
+=item Named Unary Operators
+
+
+=item Relational Operators
+
+
+=item Equality Operators
+
+
+=item Bitwise And
+
+
+=item Bitwise Or and Exclusive Or
+
+
+=item C-style Logical And
+
+
+=item C-style Logical Or
+
+
+=item Range Operator
+
+
+=item Conditional Operator
+
+
+=item Assignment Operators
+
+
+=item Comma Operator
+
+
+=item List Operators (Rightward)
+
+
+=item Logical Not
+
+
+=item Logical And
+
+
+=item Logical or and Exclusive Or
+
+
+=item C Operators Missing From Perl
+
+
+unary &, unary *, (TYPE)
+
+=item Quote and Quotelike Operators
+
+
+=item Regexp Quotelike Operators
+
+
+?PATTERN?, m/PATTERN/gimosx, /PATTERN/gimosx, q/STRING/, C<'STRING'>,
+qq/STRING/, "STRING", qx/STRING/, `STRING`, qw/STRING/,
+s/PATTERN/REPLACEMENT/egimosx, tr/SEARCHLIST/REPLACEMENTLIST/cds,
+y/SEARCHLIST/REPLACEMENTLIST/cds
+
+=item I/O Operators
+
+
+=item Constant Folding
+
+
+=item Integer arithmetic
+
+
+
+
+=back
+
+
+
+
+=head2 perlre - Perl regular expressions
+
+=item DESCRIPTION
+
+
+=over
+
+=item Regular Expressions
+
+
+(?#text), (?:regexp), (?=regexp), (?!regexp), (?imsx)
+
+=item Backtracking
+
+
+=item Version 8 Regular Expressions
+
+
+=item WARNING on \1 vs $1
+
+
+
+
+=back
+
+
+
+
+=head2 perlrun - how to execute the Perl interpreter
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Switches
+
+
+B<-0>I<digits>, B<-a>, B<-c>, B<-d>, B<-d:foo>, B<-D>I<number>,
+B<-D>I<list>, B<-e> I<commandline>, B<-F>I<regexp>, B<-i>I<extension>,
+B<-I>I<directory>, B<-l>I<octnum>, B<-m>I<module>, B<-M>I<module>,
+B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, B<-T>, B<-u>, B<-U>, B<-v>, B<-V>,
+B<-V:name>, B<-w>, B<-x> I<directory>
+
+
+
+=back
+
+
+
+
+=head2 perlfunc - Perl builtin functions
+
+=item DESCRIPTION
+
+
+
+
+=over
+
+=item Perl Functions by Category
+
+
+Functions for SCALARs or strings, Regular expressions and pattern
+matching, Numeric functions, Functions for real @ARRAYs, Functions for
+list data, Functions for real %HASHes, Input and output functions,
+Functions for fixed length data or records, Functions for filehandles,
+files, or directories, Keywords related to the control flow of your
+perl program, Keywords related to scoping, Miscellaneous functions,
+Functions for processes and process groups, Keywords related to perl
+modules, Keywords related to classes and object-orientedness, Low-level
+socket functions, System V interprocess communication functions,
+Fetching user and group info, Fetching network info, Time-related
+functions
+
+=item Alphabetical Listing of Perl Functions
+
+
+-X FILEHANDLE, -X EXPR, -X, abs VALUE, accept NEWSOCKET,GENERICSOCKET,
+alarm SECONDS, atan2 Y,X, bind SOCKET,NAME, binmode FILEHANDLE, bless
+REF,CLASSNAME, bless REF, caller EXPR, caller, chdir EXPR, chmod LIST,
+chomp VARIABLE, chomp LIST, chomp, chop VARIABLE, chop LIST, chop,
+chown LIST, chr NUMBER, chroot FILENAME, close FILEHANDLE, closedir
+DIRHANDLE, connect SOCKET,NAME, continue BLOCK, cos EXPR, crypt
+PLAINTEXT,SALT, dbmclose ASSOC_ARRAY, dbmopen ASSOC,DBNAME,MODE,
+defined EXPR, delete EXPR, die LIST, do BLOCK, do SUBROUTINE(LIST), do
+EXPR, dump LABEL, each ASSOC_ARRAY, eof FILEHANDLE, eof (), eof, eval
+EXPR, eval BLOCK, exec LIST, exists EXPR, exit EXPR, exp EXPR, fcntl
+FILEHANDLE,FUNCTION,SCALAR, fileno FILEHANDLE, flock
+FILEHANDLE,OPERATION, fork, format, formline PICTURE, LIST, getc
+FILEHANDLE, getc, getlogin, getpeername SOCKET, getpgrp PID, getppid,
+getpriority WHICH,WHO, getpwnam NAME, getgrnam NAME, gethostbyname
+NAME, getnetbyname NAME, getprotobyname NAME, getpwuid UID, getgrgid
+GID, getservb
+
+
+
+=back
+
+
+
+
+=head2 perlvar - Perl predefined variables
+
+=item DESCRIPTION
+
+
+=over
+
+=item Predefined Names
+
+
+$ARG, $_, $<I<digit>>, $MATCH, $&, $PREMATCH, $`, $POSTMATCH, $',
+$LAST_PAREN_MATCH, $+, $MULTILINE_MATCHING, $*, input_line_number
+HANDLE EXPR, $INPUT_LINE_NUMBER, $NR, $, input_record_separator HANDLE
+EXPR, $INPUT_RECORD_SEPARATOR, $RS, $/, autoflush HANDLE EXPR,
+$OUTPUT_AUTOFLUSH, $|, output_field_separator HANDLE EXPR,
+$OUTPUT_FIELD_SEPARATOR, $OFS, $,, output_record_separator HANDLE EXPR,
+$OUTPUT_RECORD_SEPARATOR, $ORS, $\, $LIST_SEPARATOR, $",
+$SUBSCRIPT_SEPARATOR, $SUBSEP, $;, $OFMT, $#, format_page_number HANDLE
+EXPR, $FORMAT_PAGE_NUMBER, $%, format_lines_per_page HANDLE EXPR,
+$FORMAT_LINES_PER_PAGE, $=, format_lines_left HANDLE EXPR,
+$FORMAT_LINES_LEFT, $-, format_name HANDLE EXPR, $FORMAT_NAME, $~,
+format_top_name HANDLE EXPR, $FORMAT_TOP_NAME, $^,
+format_line_break_characters HANDLE EXPR,
+$FORMAT_LINE_BREAK_CHARACTERS, $:, format_formfeed HANDLE EXPR,
+$FORMAT_FORMFEED, $^L, $ACCUMULATOR, $^A, $CHILD_ERROR, $?, $OS_ERROR,
+$ERRNO, $!, $EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID,
+$UID, $<,
+
+
+
+=back
+
+
+
+
+=head2 perlsub - Perl subroutines
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Private Variables via my()
+
+
+=item Temporary Values via local()
+
+
+=item Passing Symbol Table Entries (typeglobs)
+
+
+=item Pass by Reference
+
+
+=item Prototypes
+
+
+=item Overriding Builtin Functions
+
+
+=item Autoloading
+
+
+
+
+=back
+
+=item SEE ALSO
+
+
+
+
+
+=head2 perlmod - Perl modules (packages)
+
+=item DESCRIPTION
+
+
+=over
+
+=item Packages
+
+
+=item Symbol Tables
+
+
+=item Package Constructors and Destructors
+
+
+=item Perl Classes
+
+
+=item Perl Modules
+
+
+
+
+=back
+
+=item NOTE
+
+
+=item THE PERL MODULE LIBRARY
+
+
+=over
+
+=item Pragmatic Modules
+
+
+diagnostics, integer, less, overload, sigtrap, strict, subs
+
+=item Standard Modules
+
+
+AnyDBM_File, AutoLoader, AutoSplit, Benchmark, Carp, Config, Cwd,
+DB_File, Devel::SelfStubber, DynaLoader, English, Env, Exporter,
+ExtUtils::Liblist, ExtUtils::MakeMaker, ExtUtils::Manifest,
+ExtUtils::Mkbootstrap, ExtUtils::Miniperl, Fcntl, File::Basename,
+File::CheckTree, File::Find, FileHandle, File::Path, Getopt::Long,
+Getopt::Std, I18N::Collate, IPC::Open2, IPC::Open3, Net::Ping, POSIX,
+SelfLoader, Safe, Socket, Test::Harness, Text::Abbrev
+
+=item Extension Modules
+
+
+
+
+=back
+
+=item CPAN
+
+
+Language Extensions and Documentation Tools, Development Support,
+Operating System Interfaces, Networking, Device Control (modems) and
+InterProcess Communication, Data Types and Data Type Utilities,
+Database Interfaces, User Interfaces, Interfaces to / Emulations of
+Other Programming Languages, File Names, File Systems and File Locking
+(see also File Handles), String Processing, Language Text Processing,
+Parsing and Searching, Option, Argument, Parameter and Configuration
+File Processing, Internationalization and Locale, Authentication,
+Security and Encryption, World Wide Web, HTML, HTTP, CGI, MIME, Server
+and Daemon Utilities, Archiving and Compression, Images, Pixmap and
+Bitmap Manipulation, Drawing and Graphing, Mail and Usenet News,
+Control Flow Utilities (callbacks and exceptions etc), File Handle and
+Input/Output Stream Utilities, Miscellaneous Modules
+
+=item Modules: Creation, Use and Abuse
+
+
+=over
+
+=item Guidelines for Module Creation
+
+
+Do similar modules already exist in some form?, Try to design the new
+module to be easy to extend and reuse, Some simple style guidelines,
+Select what to export, Select a name for the module, Have you got it
+right?, README and other Additional Files, A description of the
+module/package/extension etc, A copyright notice - see below,
+Prerequisites - what else you may need to have, How to build it -
+possible changes to Makefile.PL etc, How to install it, Recent changes
+in this release, especially incompatibilities, Changes / enhancements
+you plan to make in the future, Adding a Copyright Notice, Give the
+module a version/issue/release number, How to release and distribute a
+module, Take care when changing a released module
+
+=item Guidelines for Converting Perl 4 Library Scripts into Modules
+
+
+There is no requirement to convert anything, Consider the implications,
+Make the most of the opportunity, The pl2pm utility will get you
+started, Adds the standard Module prologue lines, Converts package
+specifiers from ' to ::, Converts die(...) to croak(...), Several other
+minor changes
+
+=item Guidelines for Reusing Application Code
+
+
+Complete applications rarely belong in the Perl Module Library, Many
+applications contain some perl code which could be reused, Break-out
+the reusable code into one or more separate module files, Take the
+opportunity to reconsider and redesign the interfaces, In some cases
+the 'application' can then be reduced to a small
+
+
+
+=back
+
+
+
+
+=head2 perlref - Perl references and nested data structures
+
+=item DESCRIPTION
+
+
+=over
+
+=item Symbolic references
+
+
+=item Not-so-symbolic references
+
+
+
+
+=back
+
+=item WARNING
+
+
+=item SEE ALSO
+
+
+
+
+
+=head2 perldsc - Perl Data Structures Cookbook
+
+=item DESCRIPTION
+
+
+arrays of arrays, hashes of arrays, arrays of hashes, hashes of hashes,
+more elaborate constructs, recursive and self-referential data
+structures, objects
+
+=item REFERENCES
+
+
+=item COMMON MISTAKES
+
+
+=item CAVEAT ON PRECEDENCE
+
+
+=item WHY YOU SHOULD ALWAYS C<use strict>
+
+
+=item DEBUGGING
+
+
+=item CODE EXAMPLES
+
+
+=item LISTS OF LISTS
+
+
+=over
+
+=item Declaration of a LIST OF LISTS
+
+
+=item Generation of a LIST OF LISTS
+
+
+=item Access and Printing of a LIST OF LISTS
+
+
+
+
+=back
+
+=item HASHES OF LISTS
+
+
+=over
+
+=item Declaration of a HASH OF LISTS
+
+
+=item Generation of a HASH OF LISTS
+
+
+=item Access and Printing of a HASH OF LISTS
+
+
+
+
+=back
+
+=item LISTS OF HASHES
+
+
+=over
+
+=item Declaration of a LIST OF HASHES
+
+
+=item Generation of a LIST OF HASHES
+
+
+=item Access and Printing of a LIST OF HASHES
+
+
+
+
+=back
+
+=item HASHES OF HASHES
+
+
+=over
+
+=item Declaration of a HASH OF HASHES
+
+
+=item Generation of a HASH OF HASHES
+
+
+=item Access and Printing of a HASH OF HASHES
+
+
+
+
+=back
+
+=item MORE ELABORATE RECORDS
+
+
+=over
+
+=item Declaration of MORE ELABORATE RECORDS
+
+
+=item Declaration of a HASH OF COMPLEX RECORDS
+
+
+=item Generation of a HASH OF COMPLEX RECORDS
+
+
+
+
+=back
+
+=item Database Ties
+
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perllol, perlLoL - Manipulating Lists of Lists in Perl
+
+=item DESCRIPTION
+
+
+=item Declaration and Access of Lists of Lists
+
+
+=item Growing Your Own
+
+
+=item Access and Printing
+
+
+=item Slices
+
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perlobj - Perl objects
+
+=item DESCRIPTION
+
+
+=over
+
+=item An Object is Simply a Reference
+
+
+=item A Class is Simply a Package
+
+
+=item A Method is Simply a Subroutine
+
+
+=item Method Invocation
+
+
+=item Destructors
+
+
+=item WARNING
+
+
+=item Summary
+
+
+=item Two-Phased Garbage Collection
+
+
+
+
+=back
+
+=item SEE ALSO
+
+
+
+
+
+=head2 perltie - how to hide an object class in a simple variable
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Tying Scalars
+
+
+TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this
+
+=item Tying Arrays
+
+
+TIEARRAY classname, LIST, FETCH this, index, STORE this, index, value,
+DESTROY this
+
+=item Tying Hashes
+
+
+USER, HOME, CLOBBER, LIST, TIEHASH classname, LIST, FETCH this, key,
+STORE this, key, value, DELETE this, key, CLEAR this, EXISTS this, key,
+FIRSTKEY this, NEXTKEY this, lastkey, DESTROY this
+
+=item Tying FileHandles
+
+
+
+
+=back
+
+=item SEE ALSO
+
+
+=item BUGS
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perlbot - Bag'o Object Tricks (the BOT)
+
+=item DESCRIPTION
+
+
+=item OO SCALING TIPS
+
+
+=item INSTANCE VARIABLES
+
+
+=item SCALAR INSTANCE VARIABLES
+
+
+=item INSTANCE VARIABLE INHERITANCE
+
+
+=item OBJECT RELATIONSHIPS
+
+
+=item OVERRIDING SUPERCLASS METHODS
+
+
+=item USING RELATIONSHIP WITH SDBM
+
+
+=item THINKING OF CODE REUSE
+
+
+=item CLASS CONTEXT AND THE OBJECT
+
+
+=item INHERITING A CONSTRUCTOR
+
+
+=item DELEGATION
+
+
+
+
+
+=head2 perldebug - Perl debugging
+
+=item DESCRIPTION
+
+
+=over
+
+=item Debugging
+
+
+h, T, s, n, f, c, c line, <CR>, l min+incr, l min-max, l line, l, -, w
+line, l subname, /pattern/, ?pattern?, L, S, t, b line [ condition ], b
+subname [ condition ], d line, D, a line command, A, < command, >
+command, V package [symbols], X [symbols], ! number, ! -number, H
+-number, q or ^D, command, p expr
+
+=item Customization
+
+
+=item Other resources
+
+
+
+
+=back
+
+=item BUGS
+
+
+
+
+
+=head2 perldiag - various Perl diagnostics
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 perlform - Perl formats
+
+=item DESCRIPTION
+
+
+=over
+
+=item Format Variables
+
+
+
+
+=back
+
+=item NOTES
+
+
+=over
+
+=item Footers
+
+
+=item Accessing Formatting Internals
+
+
+
+
+=back
+
+=item WARNING
+
+
+
+
+
+=head2 perlipc - Perl interprocess communication (signals, fifos,
+pipes, safe subprocceses, sockets, and semaphores)
+
+=item DESCRIPTION
+
+
+=item Signals
+
+
+=item Named Pipes
+
+
+=item Using open() for IPC
+
+
+=over
+
+=item Safe Pipe Opens
+
+
+=item Bidirectional Communication
+
+
+
+
+=back
+
+=item Sockets: Client/Server Communication
+
+
+=over
+
+=item Internet TCP Clients and Servers
+
+
+=item Unix-Domain TCP Clients and Servers
+
+
+=item UDP: Message Passing
+
+
+
+
+=back
+
+=item SysV IPC
+
+
+=item WARNING
+
+
+=item NOTES
+
+
+=item BUGS
+
+
+=item AUTHOR
+
+
+=item SEE ALSO
+
+
+
+
+
+=head2 perlsec - Perl security
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 perltrap - Perl traps for the unwary
+
+=item DESCRIPTION
+
+
+=over
+
+=item Awk Traps
+
+
+=item C Traps
+
+
+=item Sed Traps
+
+
+=item Shell Traps
+
+
+=item Perl Traps
+
+
+=item Perl4 Traps
+
+
+
+
+=back
+
+
+
+
+=head2 perlstyle - Perl style guide
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 perlxs - XS language reference manual
+
+=item DESCRIPTION
+
+
+=over
+
+=item Introduction
+
+
+=item On The Road
+
+
+=item The Anatomy of an XSUB
+
+
+=item The Argument Stack
+
+
+=item The RETVAL Variable
+
+
+=item The MODULE Keyword
+
+
+=item The PACKAGE Keyword
+
+
+=item The PREFIX Keyword
+
+
+=item The OUTPUT: Keyword
+
+
+=item The CODE: Keyword
+
+
+=item The INIT: Keyword
+
+
+=item The NO_INIT Keyword
+
+
+=item Initializing Function Parameters
+
+
+=item Default Parameter Values
+
+
+=item The PREINIT: Keyword
+
+
+=item The INPUT: Keyword
+
+
+=item Variable-length Parameter Lists
+
+
+=item The PPCODE: Keyword
+
+
+=item Returning Undef And Empty Lists
+
+
+=item The REQUIRE: Keyword
+
+
+=item The CLEANUP: Keyword
+
+
+=item The BOOT: Keyword
+
+
+=item The VERSIONCHECK: Keyword
+
+
+=item The PROTOTYPES: Keyword
+
+
+=item The PROTOTYPE: Keyword
+
+
+=item The ALIAS: Keyword
+
+
+=item The INCLUDE: Keyword
+
+
+=item The CASE: Keyword
+
+
+=item The & Unary Operator
+
+
+=item Inserting Comments and C Preprocessor Directives
+
+
+=item Using XS With C++
+
+
+=item Interface Strategy
+
+
+=item Perl Objects And C Structures
+
+
+=item The Typemap
+
+
+
+
+=back
+
+=item EXAMPLES
+
+
+=item XS VERSION
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perlxstut, perlXStut - Tutorial for XSUB's
+
+=item DESCRIPTION
+
+
+=over
+
+=item VERSION CAVEAT
+
+
+=item DYNAMIC VERSUS STATIC
+
+
+=item EXAMPLE 1
+
+
+=item EXAMPLE 2
+
+
+=item WHAT HAS GONE ON?
+
+
+=item EXAMPLE 3
+
+
+=item WHAT'S NEW HERE?
+
+
+=item INPUT AND OUTPUT PARAMETERS
+
+
+=item THE XSUBPP COMPILER
+
+
+=item THE TYPEMAP FILE
+
+
+=item WARNING
+
+
+=item SPECIFYING ARGUMENTS TO XSUBPP
+
+
+=item THE ARGUMENT STACK
+
+
+=item EXTENDING YOUR EXTENSION
+
+
+=item DOCUMENTING YOUR EXTENSION
+
+
+=item INSTALLING YOUR EXTENSION
+
+
+=item SEE ALSO
+
+
+=item Author
+
+
+=item Last Changed
+
+
+
+
+=back
+
+
+
+
+=head2 perlguts - Perl's Internal Functions
+
+=item DESCRIPTION
+
+
+=item Datatypes
+
+
+=over
+
+=item What is an "IV"?
+
+
+=item Working with SV's
+
+
+=item What's Really Stored in an SV?
+
+
+=item Working with AV's
+
+
+=item Working with HV's
+
+
+=item References
+
+
+=item Blessed References and Class Objects
+
+
+
+
+=back
+
+=item Creating New Variables
+
+
+=item XSUB's and the Argument Stack
+
+
+=item Mortality
+
+
+=item Stashes
+
+
+=item Magic
+
+
+=over
+
+=item Assigning Magic
+
+
+=item Magic Virtual Tables
+
+
+=item Finding Magic
+
+
+
+
+=back
+
+=item Double-Typed SV's
+
+
+=item Calling Perl Routines from within C Programs
+
+
+=item Memory Allocation
+
+
+=item API LISTING
+
+
+AvFILL, av_clear, av_extend, av_fetch, av_len, av_make, av_pop,
+av_push, av_shift, av_store, av_undef, av_unshift, CLASS, Copy, croak,
+CvSTASH, DBsingle, DBsub, dMARK, dORIGMARK, dSP, dXSARGS, ENTER,
+EXTEND, FREETMPS, G_ARRAY, G_DISCARD, G_EVAL, GIMME, G_NOARGS,
+G_SCALAR, gv_stashpv, gv_stashsv, GvSV, he_free, hv_clear, hv_delete,
+hv_exists, hv_fetch, hv_iterinit, hv_iterkey, hv_iternext,
+hv_iternextsv, hv_iterval, hv_magic, HvNAME, hv_store, hv_undef,
+isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE, isUPPER, items, LEAVE,
+MARK, mg_clear, mg_copy, mg_find, mg_free, mg_get, mg_len, mg_magical,
+mg_set, Move, na, New, Newc, Newz, newAV, newHV, newRV, newSV, newSViv,
+newSVnv, newSVpv, newSVrv, newSVsv, newXS, newXSproto, Nullav, Nullch,
+Nullcv, Nullhv, Nullsv, ORIGMARK, perl_alloc, perl_call_argv,
+perl_call_method, perl_call_pv, perl_call_sv, perl_construct,
+perl_destruct, perl_eval_sv, perl_free, perl_get_av, perl_get_cv,
+perl_get_hv, perl_get_sv, perl_parse, perl_require_pv, perl_run, POPi,
+POPl, POPp, POPn, POPs,
+
+=item AUTHOR
+
+
+=item DATE
+
+
+
+
+
+=head2 perlcall - Perl calling conventions from C
+
+=item DESCRIPTION
+
+
+An Error Handler, An Event Driven Program
+
+=item THE PERL_CALL FUNCTIONS
+
+
+B<perl_call_sv>, B<perl_call_pv>, B<perl_call_method>,
+B<perl_call_argv>
+
+=item FLAG VALUES
+
+
+=over
+
+=item  G_SCALAR
+
+
+=item G_ARRAY
+
+
+=item G_DISCARD
+
+
+=item G_NOARGS
+
+
+=item G_EVAL
+
+
+=item G_KEEPERR
+
+
+=item Determining the Context
+
+
+
+
+=back
+
+=item KNOWN PROBLEMS
+
+
+=item EXAMPLES
+
+
+=over
+
+=item No Parameters, Nothing returned
+
+
+=item Passing Parameters
+
+
+=item Returning a Scalar
+
+
+=item Returning a list of values
+
+
+=item Returning a list in a scalar context
+
+
+=item Returning Data from Perl via the parameter list
+
+
+=item Using G_EVAL
+
+
+=item Using G_KEEPERR
+
+
+=item Using perl_call_sv
+
+
+=item Using perl_call_argv
+
+
+=item Using perl_call_method
+
+
+=item Using GIMME
+
+
+=item Using Perl to dispose of temporaries
+
+
+=item Strategies for storing Callback Context Information
+
+
+1. Ignore the problem - Allow only 1 callback, 2. Create a sequence of
+callbacks - hard wired limit, 3. Use a parameter to map to the Perl
+callback
+
+=item Alternate Stack Manipulation
+
+
+
+
+=back
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+=item DATE
+
+
+
+
+
+=head2 perlembed - how to embed perl in your C program
+
+=item DESCRIPTION
+
+
+=over
+
+=item PREAMBLE
+
+
+B<Use C from Perl?>, B<Use a UNIX program from Perl?>, B<Use Perl from
+Perl?>, B<Use C from C?>, B<Use Perl from C?>
+
+=item ROADMAP
+
+
+=item Compiling your C program
+
+
+=item Adding a Perl interpreter to your C program
+
+
+=item Calling a Perl subroutine from your C program
+
+
+=item Evaluating a Perl statement from your C program
+
+
+=item Performing Perl pattern matches and substitutions from your C
+program
+
+
+
+
+=back
+
+=item MORAL
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perlpod - plain old documentation
+
+=item DESCRIPTION
+
+
+=item Embedding Pods in Perl Modules
+
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 perlbook - Perl book information
+
+=item DESCRIPTION
+
+
+
+
+
+=head1 PRAGMA DOCUMENTATION
+
+
+
+
+=head2 diagnostics - Perl compiler pragma to force verbose warning
+diagnostics
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item The C<diagnostics> Pragma
+
+
+=item The I<splain> Program
+
+
+
+
+=back
+
+=item EXAMPLES
+
+
+=item INTERNALS
+
+
+=item BUGS
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 integer - Perl pragma to compute arithmetic in integer instead
+of double
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 less - perl pragma to request less of something from the
+compiler
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 lib - manipulate @INC at compile time
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item ADDING DIRECTORIES TO @INC
+
+
+=item DELETING DIRECTORIES FROM @INC
+
+
+=item RESTORING ORIGINAL @INC
+
+
+
+
+=back
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 overload - Package for overloading perl operations
+
+=item SYNOPSIS
+
+
+=item CAVEAT SCRIPTOR
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Declaration of overloaded functions
+
+
+=item Calling Conventions for Binary Operations
+
+
+FALSE, TRUE, C<undef>
+
+=item Calling Conventions for Unary Operations
+
+
+=item Overloadable Operations
+
+
+I<Arithmetic operations>, I<Comparison operations>, I<Bit operations>,
+I<Increment and decrement>, I<Transcendental functions>, I<Boolean,
+string and numeric conversion>, I<Special>
+
+
+
+=back
+
+=item SPECIAL SYMBOLS FOR C<use overload>
+
+
+=over
+
+=item  Last Resort
+
+
+=item Fallback
+
+
+C<undef>, TRUE, defined, but FALSE
+
+=item Copy Constructor
+
+
+B<Example>
+
+
+
+=back
+
+=item MAGIC AUTOGENERATION
+
+
+I<Assignment forms of arithmetic operations>, I<Conversion operations>,
+I<Increment and decrement>, C<abs($a)>, I<Unary minus>,
+I<Concatenation>, I<Comparison operations>, I<Copy operator>
+
+=item WARNING
+
+
+=item Run-time Overloading
+
+
+=item Public functions
+
+
+overload::StrVal(arg), overload::Overloaded(arg),
+overload::Method(obj,op)
+
+=item IMPLEMENTATION
+
+
+=item AUTHOR
+
+
+=item DIAGNOSTICS
+
+
+=item BUGS
+
+
+
+
+
+=head2 sigtrap - Perl pragma to enable stack backtrace on unexpected
+signals
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 strict - Perl pragma to restrict unsafe constructs
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+C<strict refs>, C<strict vars>, C<strict subs>
+
+
+
+
+=head2 subs - Perl pragma to predeclare sub names
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 vars - Perl pragma to predeclare global variable names
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head1 MODULE DOCUMENTATION
+
+
+
+
+=head2 AnyDBM_File - provide framework for multiple DBMs
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item DBM Comparisons
+
+
+[0], [1], [2], [3]
+
+
+
+=back
+
+=item SEE ALSO
+
+
+
+
+
+=head2 AutoLoader - load functions only on demand
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 AutoSplit - split a package for autoloading
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 Benchmark - benchmark running times of code
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Methods
+
+
+new, debug
+
+=item Standard Exports
+
+
+timeit(COUNT, CODE), timethis, timethese, timediff, timestr
+
+=item Optional Exports
+
+
+
+
+=back
+
+=item NOTES
+
+
+=item INHERITANCE
+
+
+=item CAVEATS
+
+
+=item AUTHORS
+
+
+=item MODIFICATION HISTORY
+
+
+
+
+
+=head2 Carp, carp - warn of errors (from perspective of caller)
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 Cwd, getcwd - get pathname of current working directory
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 DB_File - Perl5 access to Berkeley DB
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+DB_HASH, DB_BTREE, DB_RECNO
+
+=over
+
+=item How does DB_File interface to Berkeley DB?
+
+
+=item Differences with Berkeley DB
+
+
+=item RECNO
+
+
+=item In Memory Databases
+
+
+=item Using the Berkeley DB Interface Directly
+
+
+get, put, del, fd, seq, sync
+
+
+
+=back
+
+=item EXAMPLES
+
+
+=over
+
+=item Using HASH
+
+
+=item Using BTREE
+
+
+=item Using RECNO
+
+
+=item Locking Databases
+
+
+
+
+=back
+
+=item HISTORY
+
+
+=item WARNINGS
+
+
+=item BUGS
+
+
+=item AVAILABILITY
+
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Devel::SelfStubber - generate stubs for a SelfLoading module
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 DirHandle - supply object methods for directory handles
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 DynaLoader - Dynamically load C libraries into Perl code
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+@dl_library_path, @dl_resolve_using, @dl_require_symbols, dl_error(),
+$dl_debug, dl_findfile(), dl_expandspec(), dl_load_file(),
+dl_find_symbol(), dl_undef_symbols(), dl_install_xsub(), boostrap()
+
+=item AUTHOR
+
+
+
+
+
+=head2 English - use nice English (or awk) names for ugly punctuation
+variables
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 Env - perl module that imports environment variables
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Exporter - Implements default import method for modules
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Selecting What To Export
+
+
+=item Specialised Import Lists
+
+
+=item Module Version Checking
+
+
+=item Managing Unknown Symbols
+
+
+=item Tag Handling Utility Functions
+
+
+
+
+=back
+
+
+
+
+=head2 ExtUtils::Install - install files from here to there
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 ExtUtils::Liblist - determine libraries to use and how to use
+them
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+For static extensions, For dynamic extensions, For dynamic extensions
+
+=over
+
+=item EXTRALIBS
+
+
+=item LDLOADLIBS and LD_RUN_PATH
+
+
+=item BSLOADLIBS
+
+
+
+
+=back
+
+=item PORTABILITY
+
+
+=item SEE ALSO
+
+
+
+
+
+=head2 ExtUtils::MM_OS2 - methods to override UN*X behaviour in
+ExtUtils::MakeMaker
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 ExtUtils::MM_Unix - methods used by ExtUtils::MakeMaker
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item METHODS
+
+
+=over
+
+=item Preloaded methods
+
+
+catdir, catfile, nicetext, libscan, exescan, lsdir, path,
+replace_manpage_separator, file_name_is_absolute, prefixify,
+maybe_command_in_dirs, maybe_command, perl_script
+
+=item SelfLoaded methods
+
+
+guess_name, init_main, init_dirscan, init_others, find_perl
+
+=item Methods to actually produce chunks of text for the Makefile
+
+
+post_initialize, const_config, constants, const_loadlibs, const_cccmd,
+tool_autosplit, tool_xsubpp, tools_other, dist, macro, depend,
+post_constants, pasthru, c_o, xs_c, xs_o, top_targets, linkext, dlsyms,
+dynamic, dynamic_bs, dynamic_lib, static, static_lib, installpm,
+installpm_x, manifypods, processPL, installbin, subdirs, subdir_x,
+clean, realclean, dist_basics, dist_core, dist_dir, dist_test, dist_ci,
+install, force, perldepend, makefile, staticmake, test,
+test_via_harness, test_via_script, postamble, makeaperl, extliblist,
+dir_target, needs_linking, has_link_code, writedoc
+
+
+
+=back
+
+=item SEE ALSO
+
+
+
+
+
+=head2 ExtUtils::MM_VMS - methods to override UN*X behaviour in
+ExtUtils::MakeMaker
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 ExtUtils::MakeMaker - create an extension Makefile
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Hintsfile support
+
+
+=item What's new in version 5 of MakeMaker
+
+
+=item Incompatibilities between MakeMaker 5.00 and 4.23
+
+
+=item Default Makefile Behaviour
+
+
+=item make test
+
+
+=item make install
+
+
+=item PREFIX attribute
+
+
+=item AFS users
+
+
+=item Static Linking of a new Perl Binary
+
+
+=item Determination of Perl Library and Installation Locations
+
+
+=item Useful Default Makefile Macros
+
+
+=item Using Attributes and Parameters
+
+
+C, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS,
+EXE_FILES, FIRST_MAKEFILE, FULLPERL, H, INC, INSTALLARCHLIB,
+INSTALLBIN, INSTALLDIRS, INSTALLMAN1DIR, INSTALLMAN3DIR,
+INSTALLPRIVLIB, INSTALLSITELIB, INSTALLSITEARCH, INST_ARCHLIB,
+INST_EXE, INST_LIB, INST_MAN1DIR, INST_MAN3DIR, LDFROM, LIBPERL_A,
+LIBS, LINKTYPE, MAKEAPERL, MAKEFILE, MAN1PODS, MAN3PODS, MAP_TARGET,
+MYEXTLIB, NAME, NEEDS_LINKING, NOECHO, NORECURS, OBJECT, PERL,
+PERLMAINCC, PERL_ARCHLIB, PERL_LIB, PERL_SRC, PL_FILES, PM, PMLIBDIRS,
+PREFIX, PREREQ, SKIP, TYPEMAPS, VERSION, VERSION_FROM, XS, XSOPT,
+XSPROTOARG, XS_VERSION
+
+=item Additional lowercase attributes
+
+
+clean, depend, dist, dynamic_lib, installpm, linkext, macro, realclean,
+tool_autosplit
+
+=item Overriding MakeMaker Methods
+
+
+=item Distribution Support
+
+
+   make distcheck,    make skipcheck,    make distclean,    make
+   manifest,    make distdir,    make tardist,    make dist,    make
+   uutardist,    make shdist,    make ci
+
+
+
+=back
+
+=item AUTHORS
+
+
+=item MODIFICATION HISTORY
+
+
+=item TODO
+
+
+
+
+
+=head2 ExtUtils::Manifest - utilities to write and check a MANIFEST
+file
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item MANIFEST.SKIP
+
+
+=item EXPORT_OK
+
+
+=item GLOBAL VARIABLES
+
+
+=item DIAGNOSTICS
+
+
+C<Not in MANIFEST:> I<file>, C<No such file:> I<file>, C<MANIFEST:>
+I<$!>, C<Added to MANIFEST:> I<file>
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 ExtUtils::Mkbootstrap - make a bootstrap file for use by
+DynaLoader
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 ExtUtils::Mksymlists - write linker options files for dynamic
+extension
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+NAME, DL_FUNCS, DL_VARS, FILE, FUNCLIST, DLBASE
+
+=item AUTHOR
+
+
+=item REVISION
+
+
+
+
+
+=head2 Fcntl - load the C Fcntl.h defines
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item NOTE
+
+
+
+
+
+=head2 File::Basename, Basename - parse file specifications
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+fileparse_set_fstype, fileparse
+
+=item EXAMPLES
+
+
+C<basename>, C<dirname>
+
+
+
+
+=head2 File::CheckTree, validate - run many filetest checks on a tree
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 File::Find, find - traverse a file tree
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 File::Path - create or remove a series of directories
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHORS
+
+
+=item REVISION
+
+
+
+
+
+=head2 FileCache - keep more files open than the system permits
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item BUGS
+
+
+
+
+
+=head2 FileHandle - supply object methods for filehandles
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+  $fh->print, $fh->printf, $fh->getline, $fh->getlines
+
+=item SEE ALSO
+
+
+=item BUGS
+
+
+
+
+
+=head2 GDBM_File - Perl5 access to the gdbm library.
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AVAILABILITY
+
+
+=item BUGS
+
+
+=item SEE ALSO
+
+
+
+
+
+=head2 Getopt::Long, GetOptions - extended processing of command line
+options
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+<none>, !, =s, :s, =i, :i, =f, :f
+
+=over
+
+=item Linkage specification
+
+
+=item Aliases and abbreviations
+
+
+=item Non-option call-back routine
+
+
+=item Option starters
+
+
+=item Return value
+
+
+
+
+=back
+
+=item COMPATIBILITY
+
+
+=item EXAMPLES
+
+
+=item CONFIGURATION VARIABLES
+
+
+$Getopt::Long::autoabbrev, $Getopt::Long::getopt_compat,
+$Getopt::Long::order, $Getopt::Long::ignorecase,
+$Getopt::Long::VERSION, $Getopt::Long::error, $Getopt::Long::debug
+
+
+
+
+=head2 Getopt::Std, getopt - Process single-character switches with
+switch clustering
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 I18N::Collate - compare 8-bit scalar data according to the
+current locale
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 IPC::Open2, open2 - open a process for both reading and writing
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item WARNING
+
+
+=item SEE ALSO
+
+
+
+
+
+=head2 IPC::Open3, open3 - open a process for reading, writing, and
+error handling
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 Net::Ping, pingecho - check a host for upness
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item Parameters
+
+
+hostname, timeout
+
+
+
+=back
+
+=item WARNING
+
+
+
+
+
+=head2 POSIX - Perl interface to IEEE Std 1003.1
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item NOTE
+
+
+=item CAVEATS
+
+
+=item FUNCTIONS
+
+
+_exit, abort, abs, access, acos, alarm, asctime, asin, assert, atan,
+atan2, atexit, atof, atoi, atol, bsearch, calloc, ceil, chdir, chmod,
+chown, clearerr, clock, close, closedir, cos, cosh, creat, ctermid,
+ctime, cuserid, difftime, div, dup, dup2, errno, execl, execle, execlp,
+execv, execve, execvp, exit, exp, fabs, fclose, fcntl, fdopen, feof,
+ferror, fflush, fgetc, fgetpos, fgets, fileno, floor, fmod, fopen,
+fork, fpathconf, fprintf, fputc, fputs, fread, free, freopen, frexp,
+fscanf, fseek, fsetpos, fstat, ftell, fwrite, getc, getchar, getcwd,
+getegid, getenv, geteuid, getgid, getgrgid, getgrnam, getgroups,
+getlogin, getpgrp, getpid, getppid, getpwnam, getpwuid, gets, getuid,
+gmtime, isalnum, isalpha, isatty, iscntrl, isdigit, isgraph, islower,
+isprint, ispunct, isspace, isupper, isxdigit, kill, labs, ldexp, ldiv,
+link, localeconv, localtime, log, log10, longjmp, lseek, malloc, mblen,
+mbstowcs, mbtowc, memchr, memcmp, memcpy, memmove, memset, mkdir,
+mkfifo, mktime, modf, nice, offsetof, open, opendir, pat
+
+=item CLASSES
+
+
+=over
+
+=item POSIX::SigAction
+
+
+new
+
+=item POSIX::SigSet
+
+
+new, addset, delset, emptyset, fillset, ismember
+
+=item POSIX::Termios
+
+
+new, getattr, getcc, getcflag, getiflag, getispeed, getlflag, getoflag,
+getospeed, setattr, setcc, setcflag, setiflag, setispeed, setlflag,
+setoflag, setospeed, Baud rate values, Terminal interface values, c_cc
+field values, c_cflag field values, c_iflag field values, c_lflag field
+values, c_oflag field values
+
+
+
+=back
+
+=item PATHNAME CONSTANTS
+
+
+Constants
+
+=item POSIX CONSTANTS
+
+
+Constants
+
+=item SYSTEM CONFIGURATION
+
+
+Constants
+
+=item ERRNO
+
+
+Constants
+
+=item FCNTL
+
+
+Constants
+
+=item FLOAT
+
+
+Constants
+
+=item LIMITS
+
+
+Constants
+
+=item LOCALE
+
+
+Constants
+
+=item MATH
+
+
+Constants
+
+=item SIGNAL
+
+
+Constants
+
+=item STAT
+
+
+Constants, Macros
+
+=item STDLIB
+
+
+Constants
+
+=item STDIO
+
+
+Constants
+
+=item TIME
+
+
+Constants
+
+=item UNISTD
+
+
+Constants
+
+=item WAIT
+
+
+Constants, Macros
+
+=item CREATION
+
+
+
+
+
+=head2 Pod::Text - convert POD data to formatted ASCII text
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHOR
+
+
+=item TODO
+
+
+
+
+
+=head2 Safe - Safe extension module for Perl
+
+=item DESCRIPTION
+
+
+a new namespace, an operator mask
+
+=over
+
+=item Operator masks
+
+
+=item Methods in class Safe
+
+
+NAMESPACE, MASK, root (NAMESPACE), mask (MASK), trap (OP, ...), untrap
+(OP, ...), share (VARNAME, ...), varglob (VARNAME), reval (STRING), rdo
+(FILENAME)
+
+=item Subroutines in package Safe
+
+
+ops_to_mask (OP, ...), mask_to_ops (MASK), opcode (OP, ...), opname
+(OP, ...), fullmask, emptymask, MAXO, op_mask
+
+=item AUTHOR
+
+
+
+
+=back
+
+
+
+
+=head2 Search::Dict, look - search for key in dictionary file
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 SelectSaver - save and restore selected file handle
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 SelfLoader - load functions only on demand
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item The __DATA__ token
+
+
+=item SelfLoader autoloading
+
+
+=item Autoloading and package lexicals
+
+
+=item SelfLoader and AutoLoader
+
+
+=item __DATA__, __END__, and the FOOBAR::DATA filehandle.
+
+
+=item Classes and inherited methods.
+
+
+
+
+=back
+
+=item Multiple packages and fully qualified subroutine names
+
+
+
+
+
+=head2 Socket, sockaddr_in, sockaddr_un, inet_aton, inet_ntoa - load
+the C socket.h defines and structure manipulators
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+inet_aton HOSTNAME, inet_ntoa IP_ADDRESS, INADDR_ANY, INADDR_LOOPBACK,
+INADDR_NONE, sockaddr_in PORT, ADDRESS, sockaddr_in SOCKADDR_IN,
+pack_sockaddr_in PORT, IP_ADDRESS, unpack_sockaddr_in SOCKADDR_IN,
+sockaddr_un PATHNAME, sockaddr_un SOCKADDR_UN, pack_sockaddr_un PATH,
+unpack_sockaddr_un SOCKADDR_UN
+
+
+
+
+=head2 Symbol - manipulate Perl symbols and their names
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+
+=head2 Sys::Hostname - Try every conceivable way to get hostname
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Syslog, Sys::Syslog, openlog, closelog, setlogmask, syslog -
+Perl interface to the UNIX syslog(3) calls
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+openlog $ident, $logopt, $facility, syslog $priority, $mask, $format,
+@args, setlogmask $mask_priority, closelog
+
+=item EXAMPLES
+
+
+=item DEPENDENCIES
+
+
+=item SEE ALSO
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Term::Cap - Perl termcap interface
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item EXAMPLES
+
+
+
+
+
+=head2 Term::Complete - Perl word completion module
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+<tab>Attempts word completion.  Cannot be changed, ^D, ^U, <del>, <bs>
+
+=item DIAGNOSTICS
+
+
+=item BUGS
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Term::ReadLine - Perl interface to various C<readline> packages.
+If no real package is found, substitutes stubs instead of basic
+functions.
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item Minimal set of supported functions
+
+
+C<ReadLine>, C<new>, C<readline>, C<addhistory>, C<IN>, $C<OUT>,
+C<MinLine>, C<findConsole>, C<Features>
+
+=item EXPORTS
+
+
+
+
+
+=head2 Test::Harness - run perl standard test scripts with statistics
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=over
+
+=item The test script output
+
+
+
+
+=back
+
+=item EXPORT
+
+
+=item DIAGNOSTICS
+
+
+C<All tests successful.\nFiles=%d,  Tests=%d, %s>, C<FAILED tests
+%s\n\tFailed %d/%d tests, %.2f%% okay.>, C<Test returned status %d
+(wstat %d)>, C<Failed 1 test, %.2f%% okay. %s>, C<Failed %d/%d tests,
+%.2f%% okay. %s>
+
+=item SEE ALSO
+
+
+=item AUTHORS
+
+
+=item BUGS
+
+
+
+
+
+=head2 Text::Abbrev, abbrev - create an abbreviation table from a list
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item EXAMPLE
+
+
+
+
+
+=head2 Text::Soundex - Implementation of the Soundex Algorithm as
+Described by Knuth
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item EXAMPLES
+
+
+=item LIMITATIONS
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Text::Tabs -- expand and unexpand tabs
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Text::Wrap -- wrap text into a paragraph
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item AUTHOR
+
+
+
+
+
+=head2 Tie::Hash, Tie::StdHash - base class definitions for tied hashes
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+TIEHASH classname, LIST, STORE this, key, value, FETCH this, key,
+FIRSTKEY this, NEXTKEY this, lastkey, EXISTS this, key, DELETE this,
+key, CLEAR this
+
+=item CAVEATS
+
+
+=item MORE INFORMATION
+
+
+
+
+
+=head2 Tie::Scalar, Tie::StdScalar - base class definitions for tied
+scalars
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+TIESCALAR classname, LIST, FETCH this, STORE this, value, DESTROY this
+
+=item MORE INFORMATION
+
+
+
+
+
+=head2 Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+=item CAVEATS
+
+
+
+
+
+=head2 Time::Local - efficiently compute tome from local and GMT time
+
+=item SYNOPSIS
+
+
+=item DESCRIPTION
+
+
+
+
+=head1 AUXILIARY DOCUMENTATION
+
+Here should be listed all the extra program's docs, but they don't all
+have man pages yet:
+
+=item a2p
+
+=item s2p
+
+=item find2perl
+
+=item h2ph
+
+=item c2ph
+
+=item h2xs
+
+=item xsubpp
+
+=item pod2man
+
+=item wrapsuid
+
+
+=head1 AUTHOR
+
+Larry Wall E<lt><F<lwall@sems.com>E<gt>, with the help of oodles of
+other folks.
+
+
diff --git a/gnu/usr.bin/perl/pod/perltrap.pod b/gnu/usr.bin/perl/pod/perltrap.pod
new file mode 100644
index 00000000000..dd219c064bc
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perltrap.pod
@@ -0,0 +1,522 @@
+=head1 NAME
+
+perltrap - Perl traps for the unwary
+
+=head1 DESCRIPTION
+
+The biggest trap of all is forgetting to use the B<-w> switch; see
+L<perlrun>.  The second biggest trap is not making your entire program
+runnable under C<use strict>.
+
+=head2 Awk Traps
+
+Accustomed B<awk> users should take special note of the following:
+
+=over 4
+
+=item *
+
+The English module, loaded via
+
+    use English;
+
+allows you to refer to special variables (like $RS) as 
+though they were in B<awk>; see L<perlvar> for details.
+
+=item *
+
+Semicolons are required after all simple statements in Perl (except
+at the end of a block).  Newline is not a statement delimiter.
+
+=item *
+
+Curly brackets are required on C<if>s and C<while>s.
+
+=item *
+
+Variables begin with "$" or "@" in Perl.
+
+=item *
+
+Arrays index from 0.  Likewise string positions in substr() and
+index().
+
+=item *
+
+You have to decide whether your array has numeric or string indices.
+
+=item *
+
+Associative array values do not spring into existence upon mere
+reference.
+
+=item *
+
+You have to decide whether you want to use string or numeric
+comparisons.
+
+=item *
+
+Reading an input line does not split it for you.  You get to split it
+yourself to an array.  And split() operator has different
+arguments.
+
+=item *
+
+The current input line is normally in $_, not $0.  It generally does
+not have the newline stripped.  ($0 is the name of the program
+executed.)  See L<perlvar>.
+
+=item *
+
+$<I<digit>> does not refer to fields--it refers to substrings matched by
+the last match pattern.
+
+=item *
+
+The print() statement does not add field and record separators unless
+you set C<$,> and C<$.>.  You can set $OFS and $ORS if you're using
+the English module.
+
+=item *
+
+You must open your files before you print to them.
+
+=item *
+
+The range operator is "..", not comma.  The comma operator works as in
+C.
+
+=item *
+
+The match operator is "=~", not "~".  ("~" is the one's complement
+operator, as in C.)
+
+=item *
+
+The exponentiation operator is "**", not "^".  "^" is the XOR
+operator, as in C.  (You know, one could get the feeling that B<awk> is
+basically incompatible with C.)
+
+=item *
+
+The concatenation operator is ".", not the null string.  (Using the
+null string would render C</pat/ /pat/> unparsable, since the third slash
+would be interpreted as a division operator--the tokener is in fact
+slightly context sensitive for operators like "/", "?", and ">".
+And in fact, "." itself can be the beginning of a number.)
+
+=item *
+
+The C<next>, C<exit>, and C<continue> keywords work differently.
+
+=item *
+
+
+The following variables work differently:
+
+      Awk	Perl
+      ARGC	$#ARGV or scalar @ARGV
+      ARGV[0]	$0
+      FILENAME	$ARGV
+      FNR	$. - something
+      FS	(whatever you like)
+      NF	$#Fld, or some such
+      NR	$.
+      OFMT	$#
+      OFS	$,
+      ORS	$\
+      RLENGTH	length($&)
+      RS	$/
+      RSTART	length($`)
+      SUBSEP	$;
+
+=item *
+
+You cannot set $RS to a pattern, only a string.
+
+=item *
+
+When in doubt, run the B<awk> construct through B<a2p> and see what it
+gives you.
+
+=back
+
+=head2 C Traps
+
+Cerebral C programmers should take note of the following:
+
+=over 4
+
+=item *
+
+Curly brackets are required on C<if>'s and C<while>'s.
+
+=item *
+
+You must use C<elsif> rather than C<else if>.
+
+=item *
+
+The C<break> and C<continue> keywords from C become in 
+Perl C<last> and C<next>, respectively.
+Unlike in C, these do I<NOT> work within a C<do { } while> construct.
+
+=item *
+
+There's no switch statement.  (But it's easy to build one on the fly.)
+
+=item *
+
+Variables begin with "$" or "@" in Perl.
+
+=item *
+
+printf() does not implement the "*" format for interpolating
+field widths, but it's trivial to use interpolation of double-quoted
+strings to achieve the same effect.
+
+=item *
+
+Comments begin with "#", not "/*".
+
+=item *
+
+You can't take the address of anything, although a similar operator
+in Perl 5 is the backslash, which creates a reference.
+
+=item *
+
+C<ARGV> must be capitalized.  C<$ARGV[0]> is C's C<argv[1]>, and C<argv[0]>
+ends up in C<$0>.
+
+=item *
+
+System calls such as link(), unlink(), rename(), etc. return nonzero for
+success, not 0.
+
+=item *
+
+Signal handlers deal with signal names, not numbers.  Use C<kill -l>
+to find their names on your system.
+
+=back
+
+=head2 Sed Traps
+
+Seasoned B<sed> programmers should take note of the following:
+
+=over 4
+
+=item *
+
+Backreferences in substitutions use "$" rather than "\".
+
+=item *
+
+The pattern matching metacharacters "(", ")", and "|" do not have backslashes
+in front.
+
+=item *
+
+The range operator is C<...>, rather than comma.
+
+=back
+
+=head2 Shell Traps
+
+Sharp shell programmers should take note of the following:
+
+=over 4
+
+=item *
+
+The backtick operator does variable interpretation without regard to
+the presence of single quotes in the command.
+
+=item *
+
+The backtick operator does no translation of the return value, unlike B<csh>.
+
+=item *
+
+Shells (especially B<csh>) do several levels of substitution on each
+command line.  Perl does substitution only in certain constructs
+such as double quotes, backticks, angle brackets, and search patterns.
+
+=item *
+
+Shells interpret scripts a little bit at a time.  Perl compiles the
+entire program before executing it (except for C<BEGIN> blocks, which
+execute at compile time).
+
+=item *
+
+The arguments are available via @ARGV, not $1, $2, etc.
+
+=item *
+
+The environment is not automatically made available as separate scalar
+variables.
+
+=back
+
+=head2 Perl Traps
+
+Practicing Perl Programmers should take note of the following:
+
+=over 4
+
+=item *
+
+Remember that many operations behave differently in a list
+context than they do in a scalar one.  See L<perldata> for details.
+
+=item *
+
+Avoid barewords if you can, especially all lower-case ones.
+You can't tell just by looking at it whether a bareword is 
+a function or a string.  By using quotes on strings and 
+parens on function calls, you won't ever get them confused.
+
+=item *
+
+You cannot discern from mere inspection which built-ins
+are unary operators (like chop() and chdir()) 
+and which are list operators (like print() and unlink()).
+(User-defined subroutines can B<only> be list operators, never
+unary ones.)  See L<perlop>.
+
+=item *
+
+People have a hard time remembering that some functions
+default to $_, or @ARGV, or whatever, but that others which
+you might expect to do not.  
+
+=item * 
+
+The <FH> construct is not the name of the filehandle, it is a readline
+operation on that handle.  The data read is only assigned to $_ if the
+file read is the sole condition in a while loop:
+
+    while (<FH>)      { }
+    while ($_ = <FH>) { }..
+    <FH>;  # data discarded!
+
+=item * 
+
+Remember not to use "C<=>" when you need "C<=~>";
+these two constructs are quite different:
+
+    $x =  /foo/;
+    $x =~ /foo/;
+
+=item *
+
+The C<do {}> construct isn't a real loop that you can use 
+loop control on.
+
+=item *
+
+Use my() for local variables whenever you can get away with 
+it (but see L<perlform> for where you can't).  
+Using local() actually gives a local value to a global 
+variable, which leaves you open to unforeseen side-effects
+of dynamic scoping.
+
+=item *
+
+If you localize an exported variable in a module, its exported value will
+not change.  The local name becomes an alias to a new value but the
+external name is still an alias for the original.
+
+=back
+
+=head2 Perl4 Traps
+
+Penitent Perl 4 Programmers should take note of the following
+incompatible changes that occurred between release 4 and release 5:
+
+=over 4
+
+=item *
+
+C<@> now always interpolates an array in double-quotish strings.  Some programs
+may now need to use backslash to protect any C<@> that shouldn't interpolate.
+
+=item *
+
+Barewords that used to look like strings to Perl will now look like subroutine
+calls if a subroutine by that name is defined before the compiler sees them.
+For example:
+
+    sub SeeYa { die "Hasta la vista, baby!" }
+    $SIG{'QUIT'} = SeeYa;
+
+In Perl 4, that set the signal handler; in Perl 5, it actually calls the
+function!  You may use the B<-w> switch to find such places.
+
+=item *
+
+Symbols starting with C<_> are no longer forced into package C<main>, except
+for $_ itself (and @_, etc.).
+
+=item *
+
+Double-colon is now a valid package separator in an identifier.  Thus these
+behave differently in perl4 vs. perl5:
+
+    print "$a::$b::$c\n";
+    print "$var::abc::xyz\n";
+
+=item *
+
+C<s'$lhs'$rhs'> now does no interpolation on either side.  It used to
+interpolate C<$lhs> but not C<$rhs>.
+
+=item *
+
+The second and third arguments of splice() are now evaluated in scalar
+context (as the book says) rather than list context.
+
+=item *
+
+These are now semantic errors because of precedence:
+
+    shift @list + 20;	
+    $n = keys %map + 20; 
+
+Because if that were to work, then this couldn't:
+
+    sleep $dormancy + 20;
+
+=item *
+
+The precedence of assignment operators is now the same as the precedence
+of assignment.  Perl 4 mistakenly gave them the precedence of the associated
+operator.  So you now must parenthesize them in expressions like
+
+    /foo/ ? ($a += 2) : ($a -= 2);
+
+Otherwise
+
+    /foo/ ? $a += 2 : $a -= 2;
+
+would be erroneously parsed as
+
+    (/foo/ ? $a += 2 : $a) -= 2;
+
+On the other hand,
+
+    $a += /foo/ ? 1 : 2;
+
+now works as a C programmer would expect.
+
+=item *
+
+C<open FOO || die> is now incorrect.  You need parens around the filehandle.
+While temporarily supported, using such a construct will 
+generate a non-fatal (but non-suppressible) warning.
+
+=item *
+
+The elements of argument lists for formats are now evaluated in list
+context.  This means you can interpolate list values now.
+
+=item *
+
+You can't do a C<goto> into a block that is optimized away.  Darn.
+
+=item *
+
+It is no longer syntactically legal to use whitespace as the name
+of a variable, or as a delimiter for any kind of quote construct.
+Double darn.
+
+=item *
+
+The caller() function now returns a false value in a scalar context if there
+is no caller.  This lets library files determine if they're being required.
+
+=item *
+
+C<m//g> now attaches its state to the searched string rather than the
+regular expression.
+
+=item *
+
+C<reverse> is no longer allowed as the name of a sort subroutine.
+
+=item *
+
+B<taintperl> is no longer a separate executable.  There is now a B<-T>
+switch to turn on tainting when it isn't turned on automatically.
+
+=item *
+
+Double-quoted strings may no longer end with an unescaped C<$> or C<@>.
+
+=item *
+
+The archaic C<while/if> BLOCK BLOCK syntax is no longer supported.
+
+
+=item *
+
+Negative array subscripts now count from the end of the array.
+
+=item *
+
+The comma operator in a scalar context is now guaranteed to give a
+scalar context to its arguments.
+
+=item *
+
+The C<**> operator now binds more tightly than unary minus.  
+It was documented to work this way before, but didn't.
+
+=item *
+
+Setting C<$#array> lower now discards array elements.
+
+=item *
+
+delete() is not guaranteed to return the old value for tie()d arrays,
+since this capability may be onerous for some modules to implement.
+
+=item *
+
+The construct "this is $$x" used to interpolate the pid at that
+point, but now tries to dereference $x.  C<$$> by itself still
+works fine, however.
+
+=item *
+
+The meaning of foreach has changed slightly when it is iterating over a
+list which is not an array.  This used to assign the list to a
+temporary array, but no longer does so (for efficiency).  This means
+that you'll now be iterating over the actual values, not over copies of
+the values.  Modifications to the loop variable can change the original
+values.  To retain Perl 4 semantics you need to assign your list
+explicitly to a temporary array and then iterate over that.  For
+example, you might need to change
+
+    foreach $var (grep /x/, @list) { ... }
+
+to
+
+    foreach $var (my @tmp = grep /x/, @list) { ... }
+
+Otherwise changing C<$var> will clobber the values of @list.  (This most often
+happens when you use C<$_> for the loop variable, and call subroutines in
+the loop that don't properly localize C<$_>.)
+
+=item *
+
+Some error messages will be different.
+
+=item *
+
+Some bugs may have been inadvertently removed.
+
+=back
diff --git a/gnu/usr.bin/perl/pod/perlvar.pod b/gnu/usr.bin/perl/pod/perlvar.pod
new file mode 100644
index 00000000000..3d1c195007b
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlvar.pod
@@ -0,0 +1,695 @@
+=head1 NAME
+
+perlvar - Perl predefined variables
+
+=head1 DESCRIPTION
+
+=head2 Predefined Names
+
+The following names have special meaning to Perl.  Most of the
+punctuational names have reasonable mnemonics, or analogues in one of
+the shells.  Nevertheless, if you wish to use the long variable names,
+you just need to say
+
+    use English;
+
+at the top of your program.  This will alias all the short names to the
+long names in the current package.  Some of them even have medium names,
+generally borrowed from B<awk>.
+
+To go a step further, those variables that depend on the currently
+selected filehandle may instead be set by calling an object method on
+the FileHandle object.  (Summary lines below for this contain the word
+HANDLE.)  First you must say
+
+    use FileHandle;
+
+after which you may use either
+
+    method HANDLE EXPR
+
+or
+
+    HANDLE->method(EXPR)
+
+Each of the methods returns the old value of the FileHandle attribute.
+The methods each take an optional EXPR, which if supplied specifies the
+new value for the FileHandle attribute in question.  If not supplied,
+most of the methods do nothing to the current value, except for
+autoflush(), which will assume a 1 for you, just to be different.
+
+A few of these variables are considered "read-only".  This means that if
+you try to assign to this variable, either directly or indirectly through
+a reference, you'll raise a run-time exception.
+
+=over 8
+
+=item $ARG
+
+=item $_
+
+The default input and pattern-searching space.  The following pairs are
+equivalent:
+
+    while (<>) {...}	# only equivalent in while!
+    while ($_ = <>) {...}
+
+    /^Subject:/
+    $_ =~ /^Subject:/
+
+    tr/a-z/A-Z/
+    $_ =~ tr/a-z/A-Z/
+
+    chop
+    chop($_)
+
+Here are the places where Perl will assume $_ even if you 
+don't use it:
+
+=over 3
+
+=item *
+
+Various unary functions, including functions like ord() and int(), as well
+as the all file tests (C<-f>, C<-d>) except for C<-t>, which defaults to
+STDIN.
+
+=item *
+
+Various list functions like print() and unlink().
+
+=item *
+
+The pattern matching operations C<m//>, C<s///>, and C<tr///> when used
+without an C<=~> operator.
+
+=item * 
+
+The default iterator variable in a C<foreach> loop if no other
+variable is supplied.
+
+=item * 
+
+The implicit iterator variable in the grep() and map() functions.
+
+=item * 
+
+The default place to put an input record when a C<E<lt>FHE<gt>>
+operation's result is tested by itself as the sole criterion of a C<while>
+test.  Note that outside of a C<while> test, this will not happen.
+
+=back
+
+(Mnemonic: underline is understood in certain operations.)
+
+=item $<I<digit>>
+
+Contains the subpattern from the corresponding set of parentheses in
+the last pattern matched, not counting patterns matched in nested
+blocks that have been exited already.  (Mnemonic: like \digit.)
+These variables are all read-only.
+
+=item $MATCH
+
+=item $&
+
+The string matched by the last successful pattern match (not counting
+any matches hidden within a BLOCK or eval() enclosed by the current
+BLOCK).  (Mnemonic: like & in some editors.)  This variable is read-only.
+
+=item $PREMATCH
+
+=item $`
+
+The string preceding whatever was matched by the last successful
+pattern match (not counting any matches hidden within a BLOCK or eval
+enclosed by the current BLOCK).  (Mnemonic: ` often precedes a quoted
+string.)  This variable is read-only.
+
+=item $POSTMATCH
+
+=item $'
+
+The string following whatever was matched by the last successful
+pattern match (not counting any matches hidden within a BLOCK or eval()
+enclosed by the current BLOCK).  (Mnemonic: ' often follows a quoted
+string.)  Example:
+
+    $_ = 'abcdefghi';
+    /def/;
+    print "$`:$&:$'\n";  	# prints abc:def:ghi
+
+This variable is read-only.
+
+=item $LAST_PAREN_MATCH
+
+=item $+
+
+The last bracket matched by the last search pattern.  This is useful if
+you don't know which of a set of alternative patterns matched.  For
+example:
+
+    /Version: (.*)|Revision: (.*)/ && ($rev = $+);
+
+(Mnemonic: be positive and forward looking.)
+This variable is read-only.
+
+=item $MULTILINE_MATCHING
+
+=item $*
+
+Set to 1 to do multiline matching within a string, 0 to tell Perl
+that it can assume that strings contain a single line, for the purpose
+of optimizing pattern matches.  Pattern matches on strings containing
+multiple newlines can produce confusing results when "C<$*>" is 0.  Default
+is 0.  (Mnemonic: * matches multiple things.)  Note that this variable
+only influences the interpretation of "C<^>" and "C<$>".  A literal newline can
+be searched for even when C<$* == 0>.
+
+Use of "C<$*>" is deprecated in Perl 5.
+
+=item input_line_number HANDLE EXPR
+
+=item $INPUT_LINE_NUMBER
+
+=item $NR
+
+=item $.
+
+The current input line number of the last filehandle that was read.  An
+explicit close on the filehandle resets the line number.  Since
+"C<E<lt>E<gt>>" never does an explicit close, line numbers increase
+across ARGV files (but see examples under eof()).  Localizing C<$.> has
+the effect of also localizing Perl's notion of "the last read
+filehandle".  (Mnemonic: many programs use "." to mean the current line
+number.)
+
+=item input_record_separator HANDLE EXPR
+
+=item $INPUT_RECORD_SEPARATOR
+
+=item $RS
+
+=item $/
+
+The input record separator, newline by default.  Works like B<awk>'s RS
+variable, including treating blank lines as delimiters if set to the
+null string.  You may set it to a multicharacter string to match a
+multi-character delimiter.  Note that setting it to C<"\n\n"> means
+something slightly different than setting it to C<"">, if the file
+contains consecutive blank lines.  Setting it to C<""> will treat two or
+more consecutive blank lines as a single blank line.  Setting it to
+C<"\n\n"> will blindly assume that the next input character belongs to the
+next paragraph, even if it's a newline.  (Mnemonic: / is used to
+delimit line boundaries when quoting poetry.)
+
+    undef $/;
+    $_ = <FH>; 		# whole file now here
+    s/\n[ \t]+/ /g;
+
+=item autoflush HANDLE EXPR
+
+=item $OUTPUT_AUTOFLUSH
+
+=item $|
+
+If set to nonzero, forces a flush after every write or print on the
+currently selected output channel.  Default is 0.  Note that STDOUT
+will typically be line buffered if output is to the terminal and block
+buffered otherwise.  Setting this variable is useful primarily when you
+are outputting to a pipe, such as when you are running a Perl script
+under rsh and want to see the output as it's happening.  This has no
+effect on input buffering.  
+(Mnemonic: when you want your pipes to be piping hot.)
+
+=item output_field_separator HANDLE EXPR
+
+=item $OUTPUT_FIELD_SEPARATOR
+
+=item $OFS
+
+=item $,
+
+The output field separator for the print operator.  Ordinarily the
+print operator simply prints out the comma separated fields you
+specify.  In order to get behavior more like B<awk>, set this variable
+as you would set B<awk>'s OFS variable to specify what is printed
+between fields.  (Mnemonic: what is printed when there is a , in your
+print statement.)
+
+=item output_record_separator HANDLE EXPR
+
+=item $OUTPUT_RECORD_SEPARATOR
+
+=item $ORS
+
+=item $\
+
+The output record separator for the print operator.  Ordinarily the
+print operator simply prints out the comma separated fields you
+specify, with no trailing newline or record separator assumed.  In
+order to get behavior more like B<awk>, set this variable as you would
+set B<awk>'s ORS variable to specify what is printed at the end of the
+print.  (Mnemonic: you set "C<$\>" instead of adding \n at the end of the
+print.  Also, it's just like /, but it's what you get "back" from
+Perl.)
+
+=item $LIST_SEPARATOR
+
+=item $"
+
+This is like "C<$,>" except that it applies to array values interpolated
+into a double-quoted string (or similar interpreted string).  Default
+is a space.  (Mnemonic: obvious, I think.)
+
+=item $SUBSCRIPT_SEPARATOR
+
+=item $SUBSEP
+
+=item $;
+
+The subscript separator for multi-dimensional array emulation.  If you
+refer to a hash element as
+
+    $foo{$a,$b,$c}
+
+it really means
+
+    $foo{join($;, $a, $b, $c)}
+
+But don't put
+
+    @foo{$a,$b,$c}	# a slice--note the @
+
+which means
+
+    ($foo{$a},$foo{$b},$foo{$c})
+
+Default is "\034", the same as SUBSEP in B<awk>.  Note that if your
+keys contain binary data there might not be any safe value for "C<$;>".
+(Mnemonic: comma (the syntactic subscript separator) is a
+semi-semicolon.  Yeah, I know, it's pretty lame, but "C<$,>" is already
+taken for something more important.)
+
+Consider using "real" multi-dimensional arrays in Perl 5.
+
+=item $OFMT
+
+=item $#
+
+The output format for printed numbers.  This variable is a half-hearted
+attempt to emulate B<awk>'s OFMT variable.  There are times, however,
+when B<awk> and Perl have differing notions of what is in fact
+numeric.  Also, the initial value is %.20g rather than %.6g, so you
+need to set "C<$#>" explicitly to get B<awk>'s value.  (Mnemonic: # is the
+number sign.)
+
+Use of "C<$#>" is deprecated in Perl 5.
+
+=item format_page_number HANDLE EXPR
+
+=item $FORMAT_PAGE_NUMBER
+
+=item $%
+
+The current page number of the currently selected output channel.
+(Mnemonic: % is page number in B<nroff>.)
+
+=item format_lines_per_page HANDLE EXPR
+
+=item $FORMAT_LINES_PER_PAGE
+
+=item $=
+
+The current page length (printable lines) of the currently selected
+output channel.  Default is 60.  (Mnemonic: = has horizontal lines.)
+
+=item format_lines_left HANDLE EXPR
+
+=item $FORMAT_LINES_LEFT
+
+=item $-
+
+The number of lines left on the page of the currently selected output
+channel.  (Mnemonic: lines_on_page - lines_printed.)
+
+=item format_name HANDLE EXPR
+
+=item $FORMAT_NAME
+
+=item $~
+
+The name of the current report format for the currently selected output
+channel.  Default is name of the filehandle.  (Mnemonic: brother to
+"C<$^>".)
+
+=item format_top_name HANDLE EXPR
+
+=item $FORMAT_TOP_NAME
+
+=item $^
+
+The name of the current top-of-page format for the currently selected
+output channel.  Default is name of the filehandle with _TOP
+appended.  (Mnemonic: points to top of page.)
+
+=item format_line_break_characters HANDLE EXPR
+
+=item $FORMAT_LINE_BREAK_CHARACTERS
+
+=item $:
+
+The current set of characters after which a string may be broken to
+fill continuation fields (starting with ^) in a format.  Default is 
+S<" \n-">, to break on whitespace or hyphens.  (Mnemonic: a "colon" in
+poetry is a part of a line.)
+
+=item format_formfeed HANDLE EXPR
+
+=item $FORMAT_FORMFEED
+
+=item $^L
+
+What formats output to perform a formfeed.  Default is \f.
+
+=item $ACCUMULATOR
+
+=item $^A
+
+The current value of the write() accumulator for format() lines.  A format
+contains formline() commands that put their result into C<$^A>.  After
+calling its format, write() prints out the contents of C<$^A> and empties.
+So you never actually see the contents of C<$^A> unless you call
+formline() yourself and then look at it.  See L<perlform> and
+L<perlfunc/formline()>.
+
+=item $CHILD_ERROR
+
+=item $?
+
+The status returned by the last pipe close, backtick (C<``>) command,
+or system() operator.  Note that this is the status word returned by
+the wait() system call, so the exit value of the subprocess is actually
+(C<$? E<gt>E<gt> 8>).  Thus on many systems, C<$? & 255> gives which signal,
+if any, the process died from, and whether there was a core dump.
+(Mnemonic: similar to B<sh> and B<ksh>.)
+
+=item $OS_ERROR
+
+=item $ERRNO
+
+=item $!
+
+If used in a numeric context, yields the current value of errno, with
+all the usual caveats.  (This means that you shouldn't depend on the
+value of "C<$!>" to be anything in particular unless you've gotten a
+specific error return indicating a system error.)  If used in a string
+context, yields the corresponding system error string.  You can assign
+to "C<$!>" in order to set I<errno> if, for instance, you want "C<$!>" to return the
+string for error I<n>, or you want to set the exit value for the die()
+operator.  (Mnemonic: What just went bang?)
+
+=item $EXTENDED_OS_ERROR
+
+=item $^E
+
+More specific information about the last system error than that
+provided by C<$!>, if available.  (If not, it's just C<$!> again.)
+At the moment, this differs from C<$!> only under VMS, where it
+provides the VMS status value from the last system error.  The
+caveats mentioned in the description of C<$!> apply here, too.
+(Mnemonic: Extra error explanation.)
+
+
+=item $EVAL_ERROR
+
+=item $@
+
+The Perl syntax error message from the last eval() command.  If null, the
+last eval() parsed and executed correctly (although the operations you
+invoked may have failed in the normal fashion).  (Mnemonic: Where was
+the syntax error "at"?)
+
+Note that warning messages are not collected in this variable.  You can,
+however, set up a routine to process warnings by setting $SIG{__WARN__} below.
+
+=item $PROCESS_ID
+
+=item $PID
+
+=item $$
+
+The process number of the Perl running this script.  (Mnemonic: same
+as shells.)
+
+=item $REAL_USER_ID
+
+=item $UID
+
+=item $<
+
+The real uid of this process.  (Mnemonic: it's the uid you came I<FROM>,
+if you're running setuid.)
+
+=item $EFFECTIVE_USER_ID
+
+=item $EUID
+
+=item $>
+
+The effective uid of this process.  Example:
+
+    $< = $>;		# set real to effective uid
+    ($<,$>) = ($>,$<);	# swap real and effective uid
+
+(Mnemonic: it's the uid you went I<TO>, if you're running setuid.)  Note:
+"C<$E<lt>>" and "C<$E<gt>>" can only be swapped on machines supporting setreuid().
+
+=item $REAL_GROUP_ID
+
+=item $GID
+
+=item $(
+
+The real gid of this process.  If you are on a machine that supports
+membership in multiple groups simultaneously, gives a space separated
+list of groups you are in.  The first number is the one returned by
+getgid(), and the subsequent ones by getgroups(), one of which may be
+the same as the first number.  (Mnemonic: parentheses are used to I<GROUP>
+things.  The real gid is the group you I<LEFT>, if you're running setgid.)
+
+=item $EFFECTIVE_GROUP_ID
+
+=item $EGID
+
+=item $)
+
+The effective gid of this process.  If you are on a machine that
+supports membership in multiple groups simultaneously, gives a space
+separated list of groups you are in.  The first number is the one
+returned by getegid(), and the subsequent ones by getgroups(), one of
+which may be the same as the first number.  (Mnemonic: parentheses are
+used to I<GROUP> things.  The effective gid is the group that's I<RIGHT> for
+you, if you're running setgid.)
+
+Note: "C<$E<lt>>", "C<$E<gt>>", "C<$(>" and "C<$)>" can only be set on machines
+that support the corresponding I<set[re][ug]id()> routine.  "C<$(>" and "C<$)>" 
+can only be swapped on machines supporting setregid().   Because Perl doesn't
+currently use initgroups(), you can't set your group vector to multiple groups.
+
+=item $PROGRAM_NAME
+
+=item $0
+
+Contains the name of the file containing the Perl script being
+executed.  Assigning to "C<$0>" modifies the argument area that the ps(1)
+program sees.  This is more useful as a way of indicating the
+current program state than it is for hiding the program you're running.
+(Mnemonic: same as B<sh> and B<ksh>.)
+
+=item $[
+
+The index of the first element in an array, and of the first character
+in a substring.  Default is 0, but you could set it to 1 to make
+Perl behave more like B<awk> (or Fortran) when subscripting and when
+evaluating the index() and substr() functions.  (Mnemonic: [ begins
+subscripts.)
+
+As of Perl 5, assignment to "C<$[>" is treated as a compiler directive,
+and cannot influence the behavior of any other file.  Its use is
+discouraged.
+
+=item $PERL_VERSION
+
+=item $]
+
+The string printed out when you say C<perl -v>.
+(This is currently I<BROKEN>).
+It can be used to
+determine at the beginning of a script whether the perl interpreter
+executing the script is in the right range of versions.  If used in a
+numeric context, returns the version + patchlevel / 1000.  Example:
+
+    # see if getc is available
+    ($version,$patchlevel) =
+	     $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/;
+    print STDERR "(No filename completion available.)\n"
+	     if $version * 1000 + $patchlevel < 2016;
+
+or, used numerically,
+
+    warn "No checksumming!\n" if $] < 3.019;
+
+(Mnemonic: Is this version of perl in the right bracket?)
+
+=item $DEBUGGING
+
+=item $^D
+
+The current value of the debugging flags.  (Mnemonic: value of B<-D>
+switch.)
+
+=item $SYSTEM_FD_MAX
+
+=item $^F
+
+The maximum system file descriptor, ordinarily 2.  System file
+descriptors are passed to exec()ed processes, while higher file
+descriptors are not.  Also, during an open(), system file descriptors are
+preserved even if the open() fails.  (Ordinary file descriptors are
+closed before the open() is attempted.)  Note that the close-on-exec
+status of a file descriptor will be decided according to the value of
+C<$^F> at the time of the open, not the time of the exec.
+
+=item $INPLACE_EDIT
+
+=item $^I
+
+The current value of the inplace-edit extension.  Use C<undef> to disable
+inplace editing.  (Mnemonic: value of B<-i> switch.)
+
+=item $OSNAME
+=item $^O
+
+The name of the operating system under which this copy of Perl was
+built, as determined during the configuration process.  The value
+is identical to C<$Config{'osname'}>.
+
+=item $PERLDB
+
+=item $^P
+
+The internal flag that the debugger clears so that it doesn't debug
+itself.  You could conceivably disable debugging yourself by clearing
+it.
+
+=item $BASETIME
+
+=item $^T
+
+The time at which the script began running, in seconds since the
+epoch (beginning of 1970).  The values returned by the B<-M>, B<-A> 
+and B<-C> filetests are
+based on this value.
+
+=item $WARNING
+
+=item $^W
+
+The current value of the warning switch, either TRUE or FALSE.  (Mnemonic: related to the
+B<-w> switch.)
+
+=item $EXECUTABLE_NAME
+
+=item $^X
+
+The name that the Perl binary itself was executed as, from C's C<argv[0]>.
+
+=item $ARGV
+
+contains the name of the current file when reading from <>.
+
+=item @ARGV
+
+The array @ARGV contains the command line arguments intended for the
+script.  Note that C<$#ARGV> is the generally number of arguments minus
+one, since C<$ARGV[0]> is the first argument, I<NOT> the command name.  See
+"C<$0>" for the command name.
+
+=item @INC
+
+The array @INC contains the list of places to look for Perl scripts to
+be evaluated by the C<do EXPR>, C<require>, or C<use> constructs.  It
+initially consists of the arguments to any B<-I> command line switches,
+followed by the default Perl library, probably "/usr/local/lib/perl",
+followed by ".", to represent the current directory.  If you need to
+modify this at runtime, you should use the C<use lib> pragma in order
+to also get the machine-dependent library properly loaded:
+
+    use lib '/mypath/libdir/';
+    use SomeMod;
+  
+=item %INC
+
+The hash %INC contains entries for each filename that has
+been included via C<do> or C<require>.  The key is the filename you
+specified, and the value is the location of the file actually found.
+The C<require> command uses this array to determine whether a given file
+has already been included.
+
+=item $ENV{expr}
+
+The hash %ENV contains your current environment.  Setting a
+value in C<ENV> changes the environment for child processes.
+
+=item $SIG{expr}
+
+The hash %SIG is used to set signal handlers for various
+signals.  Example:
+
+    sub handler {	# 1st argument is signal name
+	local($sig) = @_;
+	print "Caught a SIG$sig--shutting down\n";
+	close(LOG);
+	exit(0);
+    }
+
+    $SIG{'INT'} = 'handler';
+    $SIG{'QUIT'} = 'handler';
+    ...
+    $SIG{'INT'} = 'DEFAULT';	# restore default action
+    $SIG{'QUIT'} = 'IGNORE';	# ignore SIGQUIT
+
+The %SIG array only contains values for the signals actually set within
+the Perl script.  Here are some other examples:
+
+    $SIG{PIPE} = Plumber;       # SCARY!!
+    $SIG{"PIPE"} = "Plumber";   # just fine, assumes main::Plumber
+    $SIG{"PIPE"} = \&Plumber;   # just fine; assume current Plumber
+    $SIG{"PIPE"} = Plumber();   # oops, what did Plumber() return??
+
+The one marked scary is problematic because it's a bareword, which means
+sometimes it's a string representing the function, and sometimes it's 
+going to call the subroutine call right then and there!  Best to be sure
+and quote it or take a reference to it.  *Plumber works too.  See L<perlsubs>.
+
+Certain internal hooks can be also set using the %SIG hash.  The
+routine indicated by $SIG{__WARN__} is called when a warning message is
+about to be printed.  The warning message is passed as the first
+argument.  The presence of a __WARN__ hook causes the ordinary printing
+of warnings to STDERR to be suppressed.  You can use this to save warnings
+in a variable, or turn warnings into fatal errors, like this:
+
+    local $SIG{__WARN__} = sub { die $_[0] };
+    eval $proggie;
+
+The routine indicated by $SIG{__DIE__} is called when a fatal exception
+is about to be thrown.  The error message is passed as the first
+argument.  When a __DIE__ hook routine returns, the exception
+processing continues as it would have in the absence of the hook,
+unless the hook routine itself exits via a C<goto>, a loop exit, or a die().
+The __DIE__ handler is explicitly disabled during the call, so that you
+can die from a __DIE__ handler.  Similarly for __WARN__.
+
+=back
+
diff --git a/gnu/usr.bin/perl/pod/perlxs.pod b/gnu/usr.bin/perl/pod/perlxs.pod
new file mode 100644
index 00000000000..191a78fe891
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlxs.pod
@@ -0,0 +1,1150 @@
+=head1 NAME
+
+perlxs - XS language reference manual
+
+=head1 DESCRIPTION
+
+=head2 Introduction
+
+XS is a language used to create an extension interface
+between Perl and some C library which one wishes to use with
+Perl.  The XS interface is combined with the library to
+create a new library which can be linked to Perl.  An B<XSUB>
+is a function in the XS language and is the core component
+of the Perl application interface.
+
+The XS compiler is called B<xsubpp>.  This compiler will embed
+the constructs necessary to let an XSUB, which is really a C
+function in disguise, manipulate Perl values and creates the
+glue necessary to let Perl access the XSUB.  The compiler
+uses B<typemaps> to determine how to map C function parameters
+and variables to Perl values.  The default typemap handles
+many common C types.  A supplement typemap must be created
+to handle special structures and types for the library being
+linked.
+
+See L<perlxstut> for a tutorial on the whole extension creation process.
+
+=head2 On The Road
+
+Many of the examples which follow will concentrate on creating an interface
+between Perl and the ONC+ RPC bind library functions.  The rpcb_gettime()
+function is used to demonstrate many features of the XS language.  This
+function has two parameters; the first is an input parameter and the second
+is an output parameter.  The function also returns a status value.
+
+	bool_t rpcb_gettime(const char *host, time_t *timep);
+
+From C this function will be called with the following
+statements.
+
+     #include <rpc/rpc.h>
+     bool_t status;
+     time_t timep;
+     status = rpcb_gettime( "localhost", &timep );
+
+If an XSUB is created to offer a direct translation between this function
+and Perl, then this XSUB will be used from Perl with the following code.
+The $status and $timep variables will contain the output of the function.
+
+     use RPC;
+     $status = rpcb_gettime( "localhost", $timep );
+
+The following XS file shows an XS subroutine, or XSUB, which
+demonstrates one possible interface to the rpcb_gettime()
+function.  This XSUB represents a direct translation between
+C and Perl and so preserves the interface even from Perl.
+This XSUB will be invoked from Perl with the usage shown
+above.  Note that the first three #include statements, for
+C<EXTERN.h>, C<perl.h>, and C<XSUB.h>, will always be present at the
+beginning of an XS file.  This approach and others will be
+expanded later in this document.
+
+     #include "EXTERN.h"
+     #include "perl.h"
+     #include "XSUB.h"
+     #include <rpc/rpc.h>
+
+     MODULE = RPC  PACKAGE = RPC
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+          OUTPUT:
+          timep
+
+Any extension to Perl, including those containing XSUBs,
+should have a Perl module to serve as the bootstrap which
+pulls the extension into Perl.  This module will export the
+extension's functions and variables to the Perl program and
+will cause the extension's XSUBs to be linked into Perl.
+The following module will be used for most of the examples
+in this document and should be used from Perl with the C<use>
+command as shown earlier.  Perl modules are explained in
+more detail later in this document.
+
+     package RPC;
+
+     require Exporter;
+     require DynaLoader;
+     @ISA = qw(Exporter DynaLoader);
+     @EXPORT = qw( rpcb_gettime );
+
+     bootstrap RPC;
+     1;
+
+Throughout this document a variety of interfaces to the rpcb_gettime()
+XSUB will be explored.  The XSUBs will take their parameters in different
+orders or will take different numbers of parameters.  In each case the
+XSUB is an abstraction between Perl and the real C rpcb_gettime()
+function, and the XSUB must always ensure that the real rpcb_gettime()
+function is called with the correct parameters.  This abstraction will
+allow the programmer to create a more Perl-like interface to the C
+function.
+
+=head2 The Anatomy of an XSUB
+
+The following XSUB allows a Perl program to access a C library function
+called sin().  The XSUB will imitate the C function which takes a single
+argument and returns a single value.
+
+     double
+     sin(x)
+       double x
+
+When using C pointers the indirection operator C<*> should be considered
+part of the type and the address operator C<&> should be considered part of
+the variable, as is demonstrated in the rpcb_gettime() function above.  See
+the section on typemaps for more about handling qualifiers and unary
+operators in C types.
+
+The function name and the return type must be placed on
+separate lines.
+
+  INCORRECT                        CORRECT
+
+  double sin(x)                    double
+    double x                       sin(x)
+				     double x
+
+The function body may be indented or left-adjusted.  The following example
+shows a function with its body left-adjusted.  Most examples in this
+document will indent the body.
+
+  CORRECT
+
+  double
+  sin(x)
+  double x
+
+=head2 The Argument Stack
+
+The argument stack is used to store the values which are
+sent as parameters to the XSUB and to store the XSUB's
+return value.  In reality all Perl functions keep their
+values on this stack at the same time, each limited to its
+own range of positions on the stack.  In this document the
+first position on that stack which belongs to the active
+function will be referred to as position 0 for that function.
+
+XSUBs refer to their stack arguments with the macro B<ST(x)>, where I<x>
+refers to a position in this XSUB's part of the stack.  Position 0 for that
+function would be known to the XSUB as ST(0).  The XSUB's incoming
+parameters and outgoing return values always begin at ST(0).  For many
+simple cases the B<xsubpp> compiler will generate the code necessary to
+handle the argument stack by embedding code fragments found in the
+typemaps.  In more complex cases the programmer must supply the code.
+
+=head2 The RETVAL Variable
+
+The RETVAL variable is a magic variable which always matches
+the return type of the C library function.  The B<xsubpp> compiler will
+supply this variable in each XSUB and by default will use it to hold the
+return value of the C library function being called.  In simple cases the
+value of RETVAL will be placed in ST(0) of the argument stack where it can
+be received by Perl as the return value of the XSUB.
+
+If the XSUB has a return type of C<void> then the compiler will
+not supply a RETVAL variable for that function.  When using
+the PPCODE: directive the RETVAL variable may not be needed.
+
+=head2 The MODULE Keyword
+
+The MODULE keyword is used to start the XS code and to
+specify the package of the functions which are being
+defined.  All text preceding the first MODULE keyword is
+considered C code and is passed through to the output
+untouched.  Every XS module will have a bootstrap function
+which is used to hook the XSUBs into Perl.  The package name
+of this bootstrap function will match the value of the last
+MODULE statement in the XS source files.  The value of
+MODULE should always remain constant within the same XS
+file, though this is not required.
+
+The following example will start the XS code and will place
+all functions in a package named RPC.
+
+     MODULE = RPC
+
+=head2 The PACKAGE Keyword
+
+When functions within an XS source file must be separated into packages
+the PACKAGE keyword should be used.  This keyword is used with the MODULE
+keyword and must follow immediately after it when used.
+
+     MODULE = RPC  PACKAGE = RPC
+
+     [ XS code in package RPC ]
+
+     MODULE = RPC  PACKAGE = RPCB
+
+     [ XS code in package RPCB ]
+
+     MODULE = RPC  PACKAGE = RPC
+
+     [ XS code in package RPC ]
+
+Although this keyword is optional and in some cases provides redundant
+information it should always be used.  This keyword will ensure that the
+XSUBs appear in the desired package.
+
+=head2 The PREFIX Keyword
+
+The PREFIX keyword designates prefixes which should be
+removed from the Perl function names.  If the C function is
+C<rpcb_gettime()> and the PREFIX value is C<rpcb_> then Perl will
+see this function as C<gettime()>.
+
+This keyword should follow the PACKAGE keyword when used.
+If PACKAGE is not used then PREFIX should follow the MODULE
+keyword.
+
+     MODULE = RPC  PREFIX = rpc_
+
+     MODULE = RPC  PACKAGE = RPCB  PREFIX = rpcb_
+
+=head2 The OUTPUT: Keyword
+
+The OUTPUT: keyword indicates that certain function parameters should be
+updated (new values made visible to Perl) when the XSUB terminates or that
+certain values should be returned to the calling Perl function.  For
+simple functions, such as the sin() function above, the RETVAL variable is
+automatically designated as an output value.  In more complex functions
+the B<xsubpp> compiler will need help to determine which variables are output
+variables.
+
+This keyword will normally be used to complement the CODE:  keyword.
+The RETVAL variable is not recognized as an output variable when the
+CODE: keyword is present.  The OUTPUT:  keyword is used in this
+situation to tell the compiler that RETVAL really is an output
+variable.
+
+The OUTPUT: keyword can also be used to indicate that function parameters
+are output variables.  This may be necessary when a parameter has been
+modified within the function and the programmer would like the update to
+be seen by Perl.
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+          OUTPUT:
+          timep
+
+The OUTPUT: keyword will also allow an output parameter to
+be mapped to a matching piece of code rather than to a
+typemap.
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+          OUTPUT:
+          timep sv_setnv(ST(1), (double)timep);
+
+=head2 The CODE: Keyword
+
+This keyword is used in more complicated XSUBs which require
+special handling for the C function.  The RETVAL variable is
+available but will not be returned unless it is specified
+under the OUTPUT: keyword.
+
+The following XSUB is for a C function which requires special handling of
+its parameters.  The Perl usage is given first.
+
+     $status = rpcb_gettime( "localhost", $timep );
+
+The XSUB follows. 
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host
+          time_t timep
+          CODE:
+               RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 The INIT: Keyword
+
+The INIT: keyword allows initialization to be inserted into the XSUB before
+the compiler generates the call to the C function.  Unlike the CODE: keyword
+above, this keyword does not affect the way the compiler handles RETVAL.
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+	  INIT:
+	  printf("# Host is %s\n", host );
+          OUTPUT:
+          timep
+
+=head2 The NO_INIT Keyword
+
+The NO_INIT keyword is used to indicate that a function
+parameter is being used as only an output value.  The B<xsubpp>
+compiler will normally generate code to read the values of
+all function parameters from the argument stack and assign
+them to C variables upon entry to the function.  NO_INIT
+will tell the compiler that some parameters will be used for
+output rather than for input and that they will be handled
+before the function terminates.
+
+The following example shows a variation of the rpcb_gettime() function.
+This function uses the timep variable as only an output variable and does
+not care about its initial contents.
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host
+          time_t &timep = NO_INIT
+          OUTPUT:
+          timep
+
+=head2 Initializing Function Parameters
+
+Function parameters are normally initialized with their
+values from the argument stack.  The typemaps contain the
+code segments which are used to transfer the Perl values to
+the C parameters.  The programmer, however, is allowed to
+override the typemaps and supply alternate initialization
+code.
+
+The following code demonstrates how to supply initialization code for
+function parameters.  The initialization code is eval'd by the compiler
+before it is added to the output so anything which should be interpreted
+literally, such as double quotes, must be protected with backslashes.
+
+     bool_t
+     rpcb_gettime(host,timep)
+          char *host = (char *)SvPV(ST(0),na);
+          time_t &timep = 0;
+          OUTPUT:
+          timep
+
+This should not be used to supply default values for parameters.  One
+would normally use this when a function parameter must be processed by
+another library function before it can be used.  Default parameters are
+covered in the next section.
+
+=head2 Default Parameter Values
+
+Default values can be specified for function parameters by
+placing an assignment statement in the parameter list.  The
+default value may be a number or a string.  Defaults should
+always be used on the right-most parameters only.
+
+To allow the XSUB for rpcb_gettime() to have a default host
+value the parameters to the XSUB could be rearranged.  The
+XSUB will then call the real rpcb_gettime() function with
+the parameters in the correct order.  Perl will call this
+XSUB with either of the following statements.
+
+     $status = rpcb_gettime( $timep, $host );
+
+     $status = rpcb_gettime( $timep );
+
+The XSUB will look like the code  which  follows.   A  CODE:
+block  is used to call the real rpcb_gettime() function with
+the parameters in the correct order for that function.
+
+     bool_t
+     rpcb_gettime(timep,host="localhost")
+          char *host
+          time_t timep = NO_INIT
+          CODE:
+               RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 The PREINIT: Keyword
+
+The PREINIT: keyword allows extra variables to be declared before the
+typemaps are expanded.  If a variable is declared in a CODE: block then that
+variable will follow any typemap code.  This may result in a C syntax
+error.  To force the variable to be declared before the typemap code, place
+it into a PREINIT: block.  The PREINIT: keyword may be used one or more
+times within an XSUB.
+
+The following examples are equivalent, but if the code is using complex
+typemaps then the first example is safer.
+
+     bool_t
+     rpcb_gettime(timep)
+          time_t timep = NO_INIT
+	  PREINIT:
+          char *host = "localhost";
+          CODE:
+	  RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+A correct, but error-prone example.
+
+     bool_t
+     rpcb_gettime(timep)
+          time_t timep = NO_INIT
+	  CODE:
+          char *host = "localhost";
+	  RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 The INPUT: Keyword
+
+The XSUB's parameters are usually evaluated immediately after entering the
+XSUB.  The INPUT: keyword can be used to force those parameters to be
+evaluated a little later.  The INPUT: keyword can be used multiple times
+within an XSUB and can be used to list one or more input variables.  This
+keyword is used with the PREINIT: keyword.
+
+The following example shows how the input parameter C<timep> can be
+evaluated late, after a PREINIT.
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+	  PREINIT:
+	  time_t tt;
+	  INPUT:
+          time_t timep
+          CODE:
+               RETVAL = rpcb_gettime( host, &tt );
+	       timep = tt;
+          OUTPUT:
+          timep
+          RETVAL
+
+The next example shows each input parameter evaluated late.
+
+    bool_t
+    rpcb_gettime(host,timep)
+	  PREINIT:
+	  time_t tt;
+	  INPUT:
+          char *host
+	  PREINIT:
+	  char *h;
+	  INPUT:
+          time_t timep
+          CODE:
+	       h = host;
+	       RETVAL = rpcb_gettime( h, &tt );
+	       timep = tt;
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 Variable-length Parameter Lists
+
+XSUBs can have variable-length parameter lists by specifying an ellipsis
+C<(...)> in the parameter list.  This use of the ellipsis is similar to that
+found in ANSI C.  The programmer is able to determine the number of
+arguments passed to the XSUB by examining the C<items> variable which the
+B<xsubpp> compiler supplies for all XSUBs.  By using this mechanism one can
+create an XSUB which accepts a list of parameters of unknown length.
+
+The I<host> parameter for the rpcb_gettime() XSUB can be
+optional so the ellipsis can be used to indicate that the
+XSUB will take a variable number of parameters.  Perl should
+be able to call this XSUB with either of the following statements.
+
+     $status = rpcb_gettime( $timep, $host );
+
+     $status = rpcb_gettime( $timep );
+
+The XS code, with ellipsis, follows.
+
+     bool_t
+     rpcb_gettime(timep, ...)
+          time_t timep = NO_INIT
+	  PREINIT:
+          char *host = "localhost";
+          CODE:
+		  if( items > 1 )
+		       host = (char *)SvPV(ST(1), na);
+		  RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 The PPCODE: Keyword
+
+The PPCODE: keyword is an alternate form of the CODE: keyword and is used
+to tell the B<xsubpp> compiler that the programmer is supplying the code to
+control the argument stack for the XSUBs return values.  Occasionally one
+will want an XSUB to return a list of values rather than a single value.
+In these cases one must use PPCODE: and then explicitly push the list of
+values on the stack.  The PPCODE: and CODE:  keywords are not used
+together within the same XSUB.
+
+The following XSUB will call the C rpcb_gettime() function
+and will return its two output values, timep and status, to
+Perl as a single list.
+
+     void
+     rpcb_gettime(host)
+          char *host
+	  PREINIT:
+          time_t  timep;
+          bool_t  status;
+          PPCODE:
+          status = rpcb_gettime( host, &timep );
+          EXTEND(sp, 2);
+          PUSHs(sv_2mortal(newSViv(status)));
+          PUSHs(sv_2mortal(newSViv(timep)));
+
+Notice that the programmer must supply the C code necessary
+to have the real rpcb_gettime() function called and to have
+the return values properly placed on the argument stack.
+
+The C<void> return type for this function tells the B<xsubpp> compiler that
+the RETVAL variable is not needed or used and that it should not be created.
+In most scenarios the void return type should be used with the PPCODE:
+directive.
+
+The EXTEND() macro is used to make room on the argument
+stack for 2 return values.  The PPCODE: directive causes the
+B<xsubpp> compiler to create a stack pointer called C<sp>, and it
+is this pointer which is being used in the EXTEND() macro.
+The values are then pushed onto the stack with the PUSHs()
+macro.
+
+Now the rpcb_gettime() function can be used from Perl with
+the following statement.
+
+     ($status, $timep) = rpcb_gettime("localhost");
+
+=head2 Returning Undef And Empty Lists
+
+Occasionally the programmer will want to simply return
+C<undef> or an empty list if a function fails rather than a
+separate status value.  The rpcb_gettime() function offers
+just this situation.  If the function succeeds we would like
+to have it return the time and if it fails we would like to
+have undef returned.  In the following Perl code the value
+of $timep will either be undef or it will be a valid time.
+
+     $timep = rpcb_gettime( "localhost" );
+
+The following XSUB uses the C<void> return type to disable the generation of
+the RETVAL variable and uses a CODE: block to indicate to the compiler
+that the programmer has supplied all the necessary code.  The
+sv_newmortal() call will initialize the return value to undef, making that
+the default return value.
+
+     void
+     rpcb_gettime(host)
+          char *  host
+	  PREINIT:
+          time_t  timep;
+          bool_t x;
+          CODE:
+          ST(0) = sv_newmortal();
+          if( rpcb_gettime( host, &timep ) )
+               sv_setnv( ST(0), (double)timep);
+
+The next example demonstrates how one would place an explicit undef in the
+return value, should the need arise.
+
+     void
+     rpcb_gettime(host)
+          char *  host
+	  PREINIT:
+          time_t  timep;
+          bool_t x;
+          CODE:
+          ST(0) = sv_newmortal();
+          if( rpcb_gettime( host, &timep ) ){
+               sv_setnv( ST(0), (double)timep);
+          }
+          else{
+               ST(0) = &sv_undef;
+          }
+
+To return an empty list one must use a PPCODE: block and
+then not push return values on the stack.
+
+     void
+     rpcb_gettime(host)
+          char *host
+	  PREINIT:
+          time_t  timep;
+          PPCODE:
+          if( rpcb_gettime( host, &timep ) )
+               PUSHs(sv_2mortal(newSViv(timep)));
+          else{
+          /* Nothing pushed on stack, so an empty */
+          /* list is implicitly returned. */
+          }
+
+Some people may be inclined to include an explicit C<return> in the above
+XSUB, rather than letting control fall through to the end.  In those
+situations C<XSRETURN_EMPTY> should be used, instead.  This will ensure that
+the XSUB stack is properly adjusted.  Consult L<perlguts/"API LISTING"> for
+other C<XSRETURN> macros.
+
+=head2 The REQUIRE: Keyword
+
+The REQUIRE: keyword is used to indicate the minimum version of the
+B<xsubpp> compiler needed to compile the XS module.  An XS module which
+contains the following statement will only compile with B<xsubpp> version
+1.922 or greater:
+
+	REQUIRE: 1.922
+
+=head2 The CLEANUP: Keyword
+
+This keyword can be used when an XSUB requires special cleanup procedures
+before it terminates.  When the CLEANUP:  keyword is used it must follow
+any CODE:, PPCODE:, or OUTPUT: blocks which are present in the XSUB.  The
+code specified for the cleanup block will be added as the last statements
+in the XSUB.
+
+=head2 The BOOT: Keyword
+
+The BOOT: keyword is used to add code to the extension's bootstrap
+function.  The bootstrap function is generated by the B<xsubpp> compiler and
+normally holds the statements necessary to register any XSUBs with Perl.
+With the BOOT: keyword the programmer can tell the compiler to add extra
+statements to the bootstrap function.
+
+This keyword may be used any time after the first MODULE keyword and should
+appear on a line by itself.  The first blank line after the keyword will
+terminate the code block.
+
+     BOOT:
+     # The following message will be printed when the
+     # bootstrap function executes.
+     printf("Hello from the bootstrap!\n");
+
+=head2 The VERSIONCHECK: Keyword
+
+The VERSIONCHECK: keyword corresponds to B<xsubpp>'s C<-versioncheck> and
+C<-noversioncheck> options.  This keyword overrides the commandline
+options.  Version checking is enabled by default.  When version checking is
+enabled the XS module will attempt to verify that its version matches the
+version of the PM module.
+
+To enable version checking:
+
+    VERSIONCHECK: ENABLE
+
+To disable version checking:
+
+    VERSIONCHECK: DISABLE
+
+=head2 The PROTOTYPES: Keyword
+
+The PROTOTYPES: keyword corresponds to B<xsubpp>'s C<-prototypes> and
+C<-noprototypes> options.  This keyword overrides the commandline options.
+Prototypes are enabled by default.  When prototypes are enabled XSUBs will
+be given Perl prototypes.  This keyword may be used multiple times in an XS
+module to enable and disable prototypes for different parts of the module.
+
+To enable prototypes:
+
+    PROTOTYPES: ENABLE
+
+To disable prototypes:
+
+    PROTOTYPES: DISABLE
+
+=head2 The PROTOTYPE: Keyword
+
+This keyword is similar to the PROTOTYPES: keyword above but can be used to
+force B<xsubpp> to use a specific prototype for the XSUB.  This keyword
+overrides all other prototype options and keywords but affects only the
+current XSUB.  Consult L<perlsub/Prototypes> for information about Perl
+prototypes.
+
+    bool_t
+    rpcb_gettime(timep, ...)
+          time_t timep = NO_INIT
+	  PROTOTYPE: $;$
+	  PREINIT:
+          char *host = "localhost";
+          CODE:
+		  if( items > 1 )
+		       host = (char *)SvPV(ST(1), na);
+		  RETVAL = rpcb_gettime( host, &timep );
+          OUTPUT:
+          timep
+          RETVAL
+
+=head2 The ALIAS: Keyword
+
+The ALIAS: keyword allows an XSUB to have two more more unique Perl names
+and to know which of those names was used when it was invoked.  The Perl
+names may be fully-qualified with package names.  Each alias is given an
+index.  The compiler will setup a variable called C<ix> which contain the
+index of the alias which was used.  When the XSUB is called with its
+declared name C<ix> will be 0.
+
+The following example will create aliases C<FOO::gettime()> and
+C<BAR::getit()> for this function.
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+	  ALIAS:
+	    FOO::gettime = 1
+	    BAR::getit = 2
+	  INIT:
+	  printf("# ix = %d\n", ix );
+          OUTPUT:
+          timep
+
+=head2 The INCLUDE: Keyword
+
+This keyword can be used to pull other files into the XS module.  The other
+files may have XS code.  INCLUDE: can also be used to run a command to
+generate the XS code to be pulled into the module.
+
+The file F<Rpcb1.xsh> contains our C<rpcb_gettime()> function:
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+          OUTPUT:
+          timep
+
+The XS module can use INCLUDE: to pull that file into it.
+
+    INCLUDE: Rpcb1.xsh
+
+If the parameters to the INCLUDE: keyword are followed by a pipe (C<|>) then
+the compiler will interpret the parameters as a command.
+
+    INCLUDE: cat Rpcb1.xsh |
+
+=head2 The CASE: Keyword
+
+The CASE: keyword allows an XSUB to have multiple distinct parts with each
+part acting as a virtual XSUB.  CASE: is greedy and if it is used then all
+other XS keywords must be contained within a CASE:.  This means nothing may
+precede the first CASE: in the XSUB and anything following the last CASE: is
+included in that case.
+
+A CASE: might switch via a parameter of the XSUB, via the C<ix> ALIAS:
+variable (see L<"The ALIAS: Keyword">), or maybe via the C<items> variable
+(see L<"Variable-length Parameter Lists">).  The last CASE: becomes the
+B<default> case if it is not associated with a conditional.  The following
+example shows CASE switched via C<ix> with a function C<rpcb_gettime()>
+having an alias C<x_gettime()>.  When the function is called as
+C<rpcb_gettime()> it's parameters are the usual C<(char *host, time_t *timep)>, 
+but when the function is called as C<x_gettime()> is parameters are
+reversed, C<(time_t *timep, char *host)>.
+
+    long
+    rpcb_gettime(a,b)
+      CASE: ix == 1
+	  ALIAS:
+	  x_gettime = 1
+	  INPUT:
+	  # 'a' is timep, 'b' is host
+          char *b
+          time_t a = NO_INIT
+          CODE:
+               RETVAL = rpcb_gettime( b, &a );
+          OUTPUT:
+          a
+          RETVAL
+      CASE:
+	  # 'a' is host, 'b' is timep
+          char *a
+          time_t &b = NO_INIT
+          OUTPUT:
+          b
+          RETVAL
+
+That function can be called with either of the following statements.  Note
+the different argument lists.
+
+	$status = rpcb_gettime( $host, $timep );
+
+	$status = x_gettime( $timep, $host );
+
+=head2 The & Unary Operator
+
+The & unary operator is used to tell the compiler that it should dereference
+the object when it calls the C function.  This is used when a CODE: block is
+not used and the object is a not a pointer type (the object is an C<int> or
+C<long> but not a C<int*> or C<long*>).
+
+The following XSUB will generate incorrect C code.  The xsubpp compiler will
+turn this into code which calls C<rpcb_gettime()> with parameters C<(char
+*host, time_t timep)>, but the real C<rpcb_gettime()> wants the C<timep>
+parameter to be of type C<time_t*> rather than C<time_t>.
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+          time_t timep
+          OUTPUT:
+          timep
+
+That problem is corrected by using the C<&> operator.  The xsubpp compiler
+will now turn this into code which calls C<rpcb_gettime()> correctly with
+parameters C<(char *host, time_t *timep)>.  It does this by carrying the
+C<&> through, so the function call looks like C<rpcb_gettime(host, &timep)>.
+
+    bool_t
+    rpcb_gettime(host,timep)
+          char *host
+          time_t &timep
+          OUTPUT:
+          timep
+
+=head2 Inserting Comments and C Preprocessor Directives
+
+C preprocessor directives are allowed within BOOT:, PREINIT: INIT:,
+CODE:, PPCODE: and CLEANUP: blocks, as well as outside the functions.
+Comments are allowed anywhere after the MODULE keyword.  The compiler
+will pass the preprocessor directives through untouched and will remove
+the commented lines.
+Comments can be added to XSUBs by placing a C<#> as the first
+non-whitespace of a line.  Care should be taken to avoid making the
+comment look like a C preprocessor directive, lest it be interpreted as
+such.  The simplest way to prevent this is to put whitespace in front of
+the C<#>.
+
+
+If you use preprocessor directives to choose one of two
+versions of a function, use
+
+    #if ... version1
+    #else /* ... version2  */
+    #endif
+
+and not
+
+    #if ... version1
+    #endif
+    #if ... version2
+    #endif
+
+because otherwise xsubpp will believe that you made a duplicate
+definition of the function.  Also, put a blank line before the
+#else/#endif so it will not be seen as part of the function body.
+
+=head2 Using XS With C++
+
+If a function is defined as a C++ method then it will assume
+its first argument is an object pointer.  The object pointer
+will be stored in a variable called THIS.  The object should
+have been created by C++ with the new() function and should
+be blessed by Perl with the sv_setref_pv() macro.  The
+blessing of the object by Perl can be handled by a typemap.  An example
+typemap is shown at the end of this section.
+
+If the method is defined as static it will call the C++
+function using the class::method() syntax.  If the method is not static
+the function will be called using the THIS-E<gt>method() syntax.
+
+The next examples will use the following C++ class.
+
+     class color {
+          public:
+          color();
+          ~color();
+          int blue();
+          void set_blue( int );
+
+          private:
+          int c_blue;
+     };
+
+The XSUBs for the blue() and set_blue() methods are defined with the class
+name but the parameter for the object (THIS, or "self") is implicit and is
+not listed.
+
+     int
+     color::blue()
+
+     void
+     color::set_blue( val )
+          int val
+
+Both functions will expect an object as the first parameter.  The xsubpp
+compiler will call that object C<THIS> and will use it to call the specified
+method.  So in the C++ code the blue() and set_blue() methods will be called
+in the following manner.
+
+     RETVAL = THIS->blue();
+
+     THIS->set_blue( val );
+
+If the function's name is B<DESTROY> then the C++ C<delete> function will be
+called and C<THIS> will be given as its parameter.
+
+     void
+     color::DESTROY()
+
+The C++ code will call C<delete>.
+
+     delete THIS;
+
+If the function's name is B<new> then the C++ C<new> function will be called
+to create a dynamic C++ object.  The XSUB will expect the class name, which
+will be kept in a variable called C<CLASS>, to be given as the first
+argument.
+
+     color *
+     color::new()
+
+The C++ code will call C<new>.
+
+	RETVAL = new color();
+
+The following is an example of a typemap that could be used for this C++
+example.
+
+    TYPEMAP
+    color *		O_OBJECT
+
+    OUTPUT
+    # The Perl object is blessed into 'CLASS', which should be a
+    # char* having the name of the package for the blessing.
+    O_OBJECT
+    	sv_setref_pv( $arg, CLASS, (void*)$var );
+    
+    INPUT
+    O_OBJECT
+    	if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
+    		$var = ($type)SvIV((SV*)SvRV( $arg ));
+    	else{
+    		warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+    		XSRETURN_UNDEF;
+    	}
+
+=head2 Interface Strategy
+
+When designing an interface between Perl and a C library a straight
+translation from C to XS is often sufficient.  The interface will often be
+very C-like and occasionally nonintuitive, especially when the C function
+modifies one of its parameters.  In cases where the programmer wishes to
+create a more Perl-like interface the following strategy may help to
+identify the more critical parts of the interface.
+
+Identify the C functions which modify their parameters.  The XSUBs for
+these functions may be able to return lists to Perl, or may be
+candidates to return undef or an empty list in case of failure.
+
+Identify which values are used by only the C and XSUB functions
+themselves.  If Perl does not need to access the contents of the value
+then it may not be necessary to provide a translation for that value
+from C to Perl.
+
+Identify the pointers in the C function parameter lists and return
+values.  Some pointers can be handled in XS with the & unary operator on
+the variable name while others will require the use of the * operator on
+the type name.  In general it is easier to work with the & operator.
+
+Identify the structures used by the C functions.  In many
+cases it may be helpful to use the T_PTROBJ typemap for
+these structures so they can be manipulated by Perl as
+blessed objects.
+
+=head2 Perl Objects And C Structures
+
+When dealing with C structures one should select either
+B<T_PTROBJ> or B<T_PTRREF> for the XS type.  Both types are
+designed to handle pointers to complex objects.  The
+T_PTRREF type will allow the Perl object to be unblessed
+while the T_PTROBJ type requires that the object be blessed.
+By using T_PTROBJ one can achieve a form of type-checking
+because the XSUB will attempt to verify that the Perl object
+is of the expected type.
+
+The following XS code shows the getnetconfigent() function which is used
+with ONC+ TIRPC.  The getnetconfigent() function will return a pointer to a
+C structure and has the C prototype shown below.  The example will
+demonstrate how the C pointer will become a Perl reference.  Perl will
+consider this reference to be a pointer to a blessed object and will
+attempt to call a destructor for the object.  A destructor will be
+provided in the XS source to free the memory used by getnetconfigent().
+Destructors in XS can be created by specifying an XSUB function whose name
+ends with the word B<DESTROY>.  XS destructors can be used to free memory
+which may have been malloc'd by another XSUB.
+
+     struct netconfig *getnetconfigent(const char *netid);
+
+A C<typedef> will be created for C<struct netconfig>.  The Perl
+object will be blessed in a class matching the name of the C
+type, with the tag C<Ptr> appended, and the name should not
+have embedded spaces if it will be a Perl package name.  The
+destructor will be placed in a class corresponding to the
+class of the object and the PREFIX keyword will be used to
+trim the name to the word DESTROY as Perl will expect.
+
+     typedef struct netconfig Netconfig;
+
+     MODULE = RPC  PACKAGE = RPC
+
+     Netconfig *
+     getnetconfigent(netid)
+          char *netid
+
+     MODULE = RPC  PACKAGE = NetconfigPtr  PREFIX = rpcb_
+
+     void
+     rpcb_DESTROY(netconf)
+          Netconfig *netconf
+          CODE:
+          printf("Now in NetconfigPtr::DESTROY\n");
+          free( netconf );
+
+This example requires the following typemap entry.  Consult the typemap
+section for more information about adding new typemaps for an extension.
+
+     TYPEMAP
+     Netconfig *  T_PTROBJ
+
+This example will be used with the following Perl statements.
+
+     use RPC;
+     $netconf = getnetconfigent("udp");
+
+When Perl destroys the object referenced by $netconf it will send the
+object to the supplied XSUB DESTROY function.  Perl cannot determine, and
+does not care, that this object is a C struct and not a Perl object.  In
+this sense, there is no difference between the object created by the
+getnetconfigent() XSUB and an object created by a normal Perl subroutine.
+
+=head2 The Typemap
+
+The typemap is a collection of code fragments which are used by the B<xsubpp>
+compiler to map C function parameters and values to Perl values.  The
+typemap file may consist of three sections labeled C<TYPEMAP>, C<INPUT>, and
+C<OUTPUT>.  The INPUT section tells the compiler how to translate Perl values
+into variables of certain C types.  The OUTPUT section tells the compiler
+how to translate the values from certain C types into values Perl can
+understand.  The TYPEMAP section tells the compiler which of the INPUT and
+OUTPUT code fragments should be used to map a given C type to a Perl value.
+Each of the sections of the typemap must be preceded by one of the TYPEMAP,
+INPUT, or OUTPUT keywords.
+
+The default typemap in the C<ext> directory of the Perl source contains many
+useful types which can be used by Perl extensions.  Some extensions define
+additional typemaps which they keep in their own directory.  These
+additional typemaps may reference INPUT and OUTPUT maps in the main
+typemap.  The B<xsubpp> compiler will allow the extension's own typemap to
+override any mappings which are in the default typemap.
+
+Most extensions which require a custom typemap will need only the TYPEMAP
+section of the typemap file.  The custom typemap used in the
+getnetconfigent() example shown earlier demonstrates what may be the typical
+use of extension typemaps.  That typemap is used to equate a C structure
+with the T_PTROBJ typemap.  The typemap used by getnetconfigent() is shown
+here.  Note that the C type is separated from the XS type with a tab and
+that the C unary operator C<*> is considered to be a part of the C type name.
+
+     TYPEMAP
+     Netconfig *<tab>T_PTROBJ
+
+=head1 EXAMPLES
+
+File C<RPC.xs>: Interface to some ONC+ RPC bind library functions.
+
+     #include "EXTERN.h"
+     #include "perl.h"
+     #include "XSUB.h"
+
+     #include <rpc/rpc.h>
+
+     typedef struct netconfig Netconfig;
+
+     MODULE = RPC  PACKAGE = RPC
+
+     void
+     rpcb_gettime(host="localhost")
+          char *host
+	  PREINIT:
+          time_t  timep;
+          CODE:
+          ST(0) = sv_newmortal();
+          if( rpcb_gettime( host, &timep ) )
+               sv_setnv( ST(0), (double)timep );
+
+     Netconfig *
+     getnetconfigent(netid="udp")
+          char *netid
+
+     MODULE = RPC  PACKAGE = NetconfigPtr  PREFIX = rpcb_
+
+     void
+     rpcb_DESTROY(netconf)
+          Netconfig *netconf
+          CODE:
+          printf("NetconfigPtr::DESTROY\n");
+          free( netconf );
+
+File C<typemap>: Custom typemap for RPC.xs.
+
+     TYPEMAP
+     Netconfig *  T_PTROBJ
+
+File C<RPC.pm>: Perl module for the RPC extension.
+
+     package RPC;
+
+     require Exporter;
+     require DynaLoader;
+     @ISA = qw(Exporter DynaLoader);
+     @EXPORT = qw(rpcb_gettime getnetconfigent);
+
+     bootstrap RPC;
+     1;
+
+File C<rpctest.pl>: Perl test program for the RPC extension.
+
+     use RPC;
+
+     $netconf = getnetconfigent();
+     $a = rpcb_gettime();
+     print "time = $a\n";
+     print "netconf = $netconf\n";
+
+     $netconf = getnetconfigent("tcp");
+     $a = rpcb_gettime("poplar");
+     print "time = $a\n";
+     print "netconf = $netconf\n";
+
+
+=head1 XS VERSION
+
+This document covers features supported by C<xsubpp> 1.935.
+
+=head1 AUTHOR
+
+Dean Roehrich F<E<lt>roehrich@cray.comE<gt>>
+Mar 12, 1996
diff --git a/gnu/usr.bin/perl/pod/perlxstut.pod b/gnu/usr.bin/perl/pod/perlxstut.pod
new file mode 100644
index 00000000000..7fea4210a96
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/perlxstut.pod
@@ -0,0 +1,722 @@
+=head1 NAME
+
+perlXStut - Tutorial for XSUB's
+
+=head1 DESCRIPTION
+
+This tutorial will educate the reader on the steps involved in creating
+a Perl extension.  The reader is assumed to have access to L<perlguts> and
+L<perlxs>.
+
+This tutorial starts with very simple examples and becomes more complex,
+with each new example adding new features.  Certain concepts may not be
+completely explained until later in the tutorial in order to slowly ease
+the reader into building extensions.
+
+=head2 VERSION CAVEAT
+
+This tutorial tries hard to keep up with the latest development versions
+of Perl.  This often means that it is sometimes in advance of the latest
+released version of Perl, and that certain features described here might
+not work on earlier versions.  This section will keep track of when various
+features were added to Perl 5.
+
+=over 4
+
+=item *
+
+In versions of 5.002 prior to version beta 3, then the line in the .xs file
+about "PROTOTYPES: DISABLE" will cause a compiler error.  Simply remove that
+line from the file.
+
+=item *
+
+In versions of 5.002 prior to version 5.002b1h, the test.pl file was not
+automatically created by h2xs.  This means that you cannot say "make test"
+to run the test script.  You will need to add the following line before the
+"use extension" statement:
+
+	use lib './blib';
+
+=item *
+
+In versions 5.000 and 5.001, instead of using the above line, you will need
+to use the following line:
+
+	BEGIN { unshift(@INC, "./blib") }
+
+=item *
+
+This document assumes that the executable named "perl" is Perl version 5.  
+Some systems may have installed Perl version 5 as "perl5".
+
+=back
+
+=head2 DYNAMIC VERSUS STATIC
+
+It is commonly thought that if a system does not have the capability to
+dynamically load a library, you cannot build XSUB's.  This is incorrect.
+You I<can> build them, but you must link the XSUB's subroutines with the
+rest of Perl, creating a new executable.  This situation is similar to
+Perl 4.
+
+This tutorial can still be used on such a system.  The XSUB build mechanism
+will check the system and build a dynamically-loadable library if possible,
+or else a static library and then, optionally, a new statically-linked
+executable with that static library linked in.
+
+Should you wish to build a statically-linked executable on a system which
+can dynamically load libraries, you may, in all the following examples,
+where the command "make" with no arguments is executed, run the command
+"make perl" instead.
+
+If you have generated such a statically-linked executable by choice, then
+instead of saying "make test", you should say "make test_static".  On systems
+that cannot build dynamically-loadable libraries at all, simply saying "make
+test" is sufficient.
+
+=head2 EXAMPLE 1
+
+Our first extension will be very simple.  When we call the routine in the
+extension, it will print out a well-known message and return.
+
+Run "h2xs -A -n Mytest".  This creates a directory named Mytest, possibly under
+ext/ if that directory exists in the current working directory.  Several files
+will be created in the Mytest dir, including MANIFEST, Makefile.PL, Mytest.pm,
+Mytest.xs, test.pl, and Changes.
+
+The MANIFEST file contains the names of all the files created.
+
+The file Makefile.PL should look something like this:
+
+	use ExtUtils::MakeMaker;
+	# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+	# the contents of the Makefile that is written.
+	WriteMakefile(
+	    'NAME'      => 'Mytest',
+	    'VERSION_FROM' => 'Mytest.pm', # finds $VERSION
+	    'LIBS'      => [''],   # e.g., '-lm'
+	    'DEFINE'    => '',     # e.g., '-DHAVE_SOMETHING'
+	    'INC'       => '',     # e.g., '-I/usr/include/other'
+	);
+
+The file Mytest.pm should start with something like this:
+
+	package Mytest;
+
+	require Exporter;
+	require DynaLoader;
+
+	@ISA = qw(Exporter DynaLoader);
+	# Items to export into callers namespace by default. Note: do not export
+	# names by default without a very good reason. Use EXPORT_OK instead.
+	# Do not simply export all your public functions/methods/constants.
+	@EXPORT = qw(
+
+	);
+	$VERSION = '0.01';
+
+	bootstrap Mytest $VERSION;
+
+	# Preloaded methods go here.
+
+	# Autoload methods go after __END__, and are processed by the autosplit program.
+
+	1;
+	__END__
+	# Below is the stub of documentation for your module. You better edit it!
+
+And the Mytest.xs file should look something like this:
+
+	#ifdef __cplusplus
+	extern "C" {
+	#endif
+	#include "EXTERN.h"
+	#include "perl.h"
+	#include "XSUB.h"
+	#ifdef __cplusplus
+	}
+	#endif
+	
+	PROTOTYPES: DISABLE
+
+	MODULE = Mytest		PACKAGE = Mytest
+
+Let's edit the .xs file by adding this to the end of the file:
+
+	void
+	hello()
+		CODE:
+		printf("Hello, world!\n");
+
+Now we'll run "perl Makefile.PL".  This will create a real Makefile,
+which make needs.  It's output looks something like:
+
+	% perl Makefile.PL
+	Checking if your kit is complete...
+	Looks good
+	Writing Makefile for Mytest
+	%
+
+Now, running make will produce output that looks something like this
+(some long lines shortened for clarity):
+
+	% make
+	umask 0 && cp Mytest.pm ./blib/Mytest.pm
+	perl xsubpp -typemap typemap Mytest.xs >Mytest.tc && mv Mytest.tc Mytest.c
+	cc -c Mytest.c
+	Running Mkbootstrap for Mytest ()
+	chmod 644 Mytest.bs
+	LD_RUN_PATH="" ld -o ./blib/PA-RISC1.1/auto/Mytest/Mytest.sl -b Mytest.o
+	chmod 755 ./blib/PA-RISC1.1/auto/Mytest/Mytest.sl
+	cp Mytest.bs ./blib/PA-RISC1.1/auto/Mytest/Mytest.bs
+	chmod 644 ./blib/PA-RISC1.1/auto/Mytest/Mytest.bs
+
+Now, although there is already a test.pl template ready for us, for this
+example only, we'll create a special test script.  Create a file called hello
+that looks like this:
+
+	#! /opt/perl5/bin/perl
+	
+	use lib './blib';
+	
+	use Mytest;
+	
+	Mytest::hello();
+
+Now we run the script and we should see the following output:
+
+	% perl hello
+	Hello, world!
+	%
+
+=head2 EXAMPLE 2
+
+Now let's add to our extension a subroutine that will take a single argument
+and return 0 if the argument is even, 1 if the argument is odd.
+
+Add the following to the end of Mytest.xs:
+
+	int
+	is_even(input)
+		int	input
+		CODE:
+		RETVAL = (input % 2 == 0);
+		OUTPUT:
+		RETVAL
+
+There does not need to be white space at the start of the "int input" line,
+but it is useful for improving readability.  The semi-colon at the end of
+that line is also optional.
+
+Any white space may be between the "int" and "input".  It is also okay for
+the four lines starting at the "CODE:" line to not be indented.  However,
+for readability purposes, it is suggested that you indent them 8 spaces
+(or one normal tab stop).
+
+Now re-run make to rebuild our new shared library.
+
+Now perform the same steps as before, generating a Makefile from the
+Makefile.PL file, and running make.
+
+In order to test that our extension works, we now need to look at the
+file test.pl.  This file is set up to imitate the same kind of testing
+structure that Perl itself has.  Within the test script, you perform a
+number of tests to confirm the behavior of the extension, printing "ok"
+when the test is correct, "not ok" when it is not.
+
+Remove the line that starts with "use lib", change the print statement in
+the BEGIN block to print "1..4", and add the following code to the end of
+the file:
+
+	print &Mytest::is_even(0) == 1 ? "ok 2" : "not ok 2", "\n";
+	print &Mytest::is_even(1) == 0 ? "ok 3" : "not ok 3", "\n";
+	print &Mytest::is_even(2) == 1 ? "ok 4" : "not ok 4", "\n";
+
+We will be calling the test script through the command "make test".  You
+should see output that looks something like this:
+
+	% make test
+	PERL_DL_NONLAZY=1 /opt/perl5.002b2/bin/perl (lots of -I arguments) test.pl
+	1..4
+	ok 1
+	ok 2
+	ok 3
+	ok 4
+	%
+
+=head2 WHAT HAS GONE ON?
+
+The program h2xs is the starting point for creating extensions.  In later
+examples we'll see how we can use h2xs to read header files and generate
+templates to connect to C routines.
+
+h2xs creates a number of files in the extension directory.  The file
+Makefile.PL is a perl script which will generate a true Makefile to build
+the extension.  We'll take a closer look at it later.
+
+The files <extension>.pm and <extension>.xs contain the meat of the extension.
+The .xs file holds the C routines that make up the extension.  The .pm file
+contains routines that tell Perl how to load your extension.
+
+Generating and invoking the Makefile created a directory blib (which stands
+for "build library") in the current working directory.  This directory will
+contain the shared library that we will build.  Once we have tested it, we
+can install it into its final location.
+
+Invoking the test script via "make test" did something very important.  It
+invoked perl with all those -I arguments so that it could find the various
+files that are part of the extension.
+
+It is I<very> important that while you are still testing extensions that
+you use "make test".  If you try to run the test script all by itself, you
+will get a fatal error.
+
+Another reason it is important to use "make test" to run your test script
+is that if you are testing an upgrade to an already-existing version, using
+"make test" insures that you use your new extension, not the already-existing
+version.
+
+When Perl sees a C<use extension;>, it searches for a file with the same name
+as the use'd extension that has a .pm suffix.  If that file cannot be found,
+Perl dies with a fatal error.  The default search path is contained in the
+@INC array.
+
+In our case, Mytest.pm tells perl that it will need the Exporter and Dynamic
+Loader extensions.  It then sets the @ISA and @EXPORT arrays and the $VERSION
+scalar; finally it tells perl to bootstrap the module.  Perl will call its
+dynamic loader routine (if there is one) and load the shared library.
+
+The two arrays that are set in the .pm file are very important.  The @ISA
+array contains a list of other packages in which to search for methods (or
+subroutines) that do not exist in the current package.  The @EXPORT array
+tells Perl which of the extension's routines should be placed into the
+calling package's namespace.
+
+It's important to select what to export carefully.  Do NOT export method names
+and do NOT export anything else I<by default> without a good reason.
+
+As a general rule, if the module is trying to be object-oriented then don't
+export anything.  If it's just a collection of functions then you can export
+any of the functions via another array, called @EXPORT_OK.
+
+See L<perlmod> for more information.
+
+The $VERSION variable is used to ensure that the .pm file and the shared
+library are "in sync" with each other.  Any time you make changes to
+the .pm or .xs files, you should increment the value of this variable.
+
+=head2 WRITING GOOD TEST SCRIPTS
+
+The importance of writing good test scripts cannot be overemphasized.  You
+should closely follow the "ok/not ok" style that Perl itself uses, so that
+it is very easy and unambiguous to determine the outcome of each test case.
+When you find and fix a bug, make sure you add a test case for it.
+
+By running "make test", you ensure that your test.pl script runs and uses
+the correct version of your extension.  If you have many test cases, you
+might want to copy Perl's test style.  Create a directory named "t", and
+ensure all your test files end with the suffix ".t".  The Makefile will
+properly run all these test files.
+
+
+=head2 EXAMPLE 3
+
+Our third extension will take one argument as its input, round off that
+value, and set the I<argument> to the rounded value.
+
+Add the following to the end of Mytest.xs:
+
+	void
+	round(arg)
+		double  arg
+		CODE:
+		if (arg > 0.0) {
+			arg = floor(arg + 0.5);
+		} else if (arg < 0.0) {
+			arg = ceil(arg - 0.5);
+		} else {
+			arg = 0.0;
+		}
+		OUTPUT:
+		arg
+
+Edit the Makefile.PL file so that the corresponding line looks like this:
+
+	'LIBS'      => ['-lm'],   # e.g., '-lm'
+
+Generate the Makefile and run make.  Change the BEGIN block to print out
+"1..9" and add the following to test.pl:
+
+	$i = -1.5; &Mytest::round($i); print $i == -2.0 ? "ok 5" : "not ok 5", "\n";
+	$i = -1.1; &Mytest::round($i); print $i == -1.0 ? "ok 6" : "not ok 6", "\n";
+	$i = 0.0; &Mytest::round($i); print $i == 0.0 ? "ok 7" : "not ok 7", "\n";
+	$i = 0.5; &Mytest::round($i); print $i == 1.0 ? "ok 8" : "not ok 8", "\n";
+	$i = 1.2; &Mytest::round($i); print $i == 1.0 ? "ok 9" : "not ok 9", "\n";
+
+Running "make test" should now print out that all nine tests are okay.
+
+You might be wondering if you can round a constant.  To see what happens, add
+the following line to test.pl temporarily:
+
+	&Mytest::round(3);
+
+Run "make test" and notice that Perl dies with a fatal error.  Perl won't let
+you change the value of constants!
+
+=head2 WHAT'S NEW HERE?
+
+Two things are new here.  First, we've made some changes to Makefile.PL.
+In this case, we've specified an extra library to link in, in this case the
+math library, libm.  We'll talk later about how to write XSUBs that can call
+every routine in a library.
+
+Second, the value of the function is being passed back not as the function's
+return value, but through the same variable that was passed into the function.
+
+=head2 INPUT AND OUTPUT PARAMETERS
+
+You specify the parameters that will be passed into the XSUB just after you
+declare the function return value and name.  Each parameter line starts with
+optional white space, and may have an optional terminating semicolon.
+
+The list of output parameters occurs after the OUTPUT: directive.  The use
+of RETVAL tells Perl that you wish to send this value back as the return
+value of the XSUB function.  In Example 3, the value we wanted returned was
+contained in the same variable we passed in, so we listed it (and not RETVAL)
+in the OUTPUT: section.
+
+=head2 THE XSUBPP COMPILER
+
+The compiler xsubpp takes the XS code in the .xs file and converts it into
+C code, placing it in a file whose suffix is .c.  The C code created makes
+heavy use of the C functions within Perl.
+
+=head2 THE TYPEMAP FILE
+
+The xsubpp compiler uses rules to convert from Perl's data types (scalar,
+array, etc.) to C's data types (int, char *, etc.).  These rules are stored
+in the typemap file ($PERLLIB/ExtUtils/typemap).  This file is split into
+three parts.
+
+The first part attempts to map various C data types to a coded flag, which
+has some correspondence with the various Perl types.  The second part contains
+C code which xsubpp uses for input parameters.  The third part contains C
+code which xsubpp uses for output parameters.  We'll talk more about the
+C code later.
+
+Let's now take a look at a portion of the .c file created for our extension.
+
+	XS(XS_Mytest_round)
+	{
+	    dXSARGS;
+	    if (items != 1)
+		croak("Usage: Mytest::round(arg)");
+	    {
+		double  arg = (double)SvNV(ST(0));	/* XXXXX */
+		if (arg > 0.0) {
+			arg = floor(arg + 0.5);
+		} else if (arg < 0.0) {
+			arg = ceil(arg - 0.5);
+		} else {
+			arg = 0.0;
+		}
+		sv_setnv(ST(0), (double)arg);	/* XXXXX */
+	    }
+	    XSRETURN(1);
+	}
+
+Notice the two lines marked with "XXXXX".  If you check the first section of
+the typemap file, you'll see that doubles are of type T_DOUBLE.  In the
+INPUT section, an argument that is T_DOUBLE is assigned to the variable
+arg by calling the routine SvNV on something, then casting it to double,
+then assigned to the variable arg.  Similarly, in the OUTPUT section,
+once arg has its final value, it is passed to the sv_setnv function to
+be passed back to the calling subroutine.  These two functions are explained
+in L<perlguts>; we'll talk more later about what that "ST(0)" means in the
+section on the argument stack.
+
+=head2 WARNING
+
+In general, it's not a good idea to write extensions that modify their input
+parameters, as in Example 3.  However, in order to better accomodate calling
+pre-existing C routines, which often do modify their input parameters,
+this behavior is tolerated.
+
+=head2 EXAMPLE 4
+
+In this example, we'll now begin to write XSUB's that will interact with
+pre-defined C libraries.  To begin with, we will build a small library of
+our own, then let h2xs write our .pm and .xs files for us.
+
+Create a new directory called Mytest2 at the same level as the directory
+Mytest.  In the Mytest2 directory, create another directory called mylib,
+and cd into that directory.
+
+Here we'll create some files that will generate a test library.  These will
+include a C source file and a header file.  We'll also create a Makefile.PL
+in this directory.  Then we'll make sure that running make at the Mytest2
+level will automatically run this Makefile.PL file and the resulting Makefile.
+
+In the testlib directory, create a file mylib.h that looks like this:
+
+	#define TESTVAL	4
+
+	extern double	foo(int, long, const char*);
+
+Also create a file mylib.c that looks like this:
+
+	#include <stdlib.h>
+	#include "./mylib.h"
+	
+	double
+	foo(a, b, c)
+	int		a;
+	long		b;
+	const char *	c;
+	{
+		return (a + b + atof(c) + TESTVAL);
+	}
+
+And finally create a file Makefile.PL that looks like this:
+
+	use ExtUtils::MakeMaker;
+	$Verbose = 1;
+	WriteMakefile(
+	    'NAME' => 'Mytest2::mylib',
+	    'clean'     => {'FILES' => 'libmylib.a'},
+	);
+
+
+	sub MY::postamble {
+		'
+	all :: static
+
+	static ::       libmylib$(LIB_EXT)
+
+	libmylib$(LIB_EXT): $(O_FILES)
+		$(AR) cr libmylib$(LIB_EXT) $(O_FILES)
+		$(RANLIB) libmylib$(LIB_EXT)
+
+	';
+	}
+
+We will now create the main top-level Mytest2 files.  Change to the directory
+above Mytest2 and run the following command:
+
+	% h2xs -O -n Mytest2 < ./Mytest2/mylib/mylib.h
+
+This will print out a warning about overwriting Mytest2, but that's okay.
+Our files are stored in Mytest2/mylib, and will be untouched.
+
+The normal Makefile.PL that h2xs generates doesn't know about the mylib
+directory.  We need to tell it that there is a subdirectory and that we
+will be generating a library in it.  Let's add the following key-value
+pair to the WriteMakefile call:
+
+	'MYEXTLIB' => 'mylib/libmylib$(LIB_EXT)',
+
+and a new replacement subroutine too:
+
+	sub MY::postamble {
+	'
+	$(MYEXTLIB): mylib/Makefile
+		cd mylib && $(MAKE)
+	';
+	}
+
+(Note: Most makes will require that there be a tab character that indents
+the line "cd mylib && $(MAKE)".)
+
+Let's also fix the MANIFEST file so that it accurately reflects the contents
+of our extension.  The single line that says "mylib" should be replaced by
+the following three lines:
+
+	mylib/Makefile.PL
+	mylib/mylib.c
+	mylib/mylib.h
+
+To keep our namespace nice and unpolluted, edit the .pm file and change
+the line setting @EXPORT to @EXPORT_OK.  And finally, in the .xs file,
+edit the #include line to read:
+
+	#include "mylib/mylib.h"
+
+And also add the following function definition to the end of the .xs file:
+
+	double
+	foo(a,b,c)
+		int             a
+		long            b
+		const char *    c
+		OUTPUT:
+		RETVAL
+
+Now we also need to create a typemap file because the default Perl doesn't
+currently support the const char * type.  Create a file called typemap and
+place the following in it:
+
+	const char *	T_PV
+
+Now run perl on the top-level Makefile.PL.  Notice that it also created a
+Makefile in the mylib directory.  Run make and see that it does cd into
+the mylib directory and run make in there as well.
+
+Now edit the test.pl script and change the BEGIN block to print "1..4",
+and add the following lines to the end of the script:
+
+	print &Mytest2::foo(1, 2, "Hello, world!") == 7 ? "ok 2\n" : "not ok 2\n";
+	print &Mytest2::foo(1, 2, "0.0") == 7 ? "ok 3\n" : "not ok 3\n";
+	print abs(&Mytest2::foo(0, 0, "-3.4") - 0.6) <= 0.01 ? "ok 4\n" : "not ok 4\n";
+
+(When dealing with floating-point comparisons, it is often useful to not check
+for equality, but rather the difference being below a certain epsilon factor,
+0.01 in this case)
+
+Run "make test" and all should be well.
+
+=head 2 WHAT HAS HAPPENED HERE?
+
+Unlike previous examples, we've now run h2xs on a real include file.  This
+has caused some extra goodies to appear in both the .pm and .xs files.
+
+=item *
+
+In the .xs file, there's now a #include declaration with the full path to
+the mylib.h header file.
+
+=item *
+
+There's now some new C code that's been added to the .xs file.  The purpose
+of the C<constant> routine is to make the values that are #define'd in the
+header file available to the Perl script (in this case, by calling
+C<&main::TESTVAL>).  There's also some XS code to allow calls to the
+C<constant> routine.
+
+=item *
+
+The .pm file has exported the name TESTVAL in the @EXPORT array.  This
+could lead to name clashes.  A good rule of thumb is that if the #define
+is only going to be used by the C routines themselves, and not by the user,
+they should be removed from the @EXPORT array.  Alternately, if you don't
+mind using the "fully qualified name" of a variable, you could remove most
+or all of the items in the @EXPORT array.
+
+=back
+
+We've also told Perl about the library that we built in the mylib
+subdirectory.  That required only the addition of the MYEXTLIB variable
+to the WriteMakefile call and the replacement of the postamble subroutine
+to cd into the subdirectory and run make.  The Makefile.PL for the
+library is a bit more complicated, but not excessively so.  Again we
+replaced the postamble subroutine to insert our own code.  This code
+simply specified that the library to be created here was a static
+archive (as opposed to a dynamically loadable library) and provided the
+commands to build it.
+
+=head2 SPECIFYING ARGUMENTS TO XSUBPP
+
+With the completion of Example 4, we now have an easy way to simulate some
+real-life libraries whose interfaces may not be the cleanest in the world.
+We shall now continue with a discussion of the arguments passed to the
+xsubpp compiler.
+
+When you specify arguments in the .xs file, you are really passing three
+pieces of information for each one listed.  The first piece is the order
+of that argument relative to the others (first, second, etc).  The second
+is the type of argument, and consists of the type declaration of the
+argument (e.g., int, char*, etc).  The third piece is the exact way in
+which the argument should be used in the call to the library function
+from this XSUB.  This would mean whether or not to place a "&" before
+the argument or not, meaning the argument expects to be passed the address
+of the specified data type.
+
+There is a difference between the two arguments in this hypothetical function:
+
+	int
+	foo(a,b)
+		char	&a
+		char *	b
+
+The first argument to this function would be treated as a char and assigned
+to the variable a, and its address would be passed into the function foo.
+The second argument would be treated as a string pointer and assigned to the
+variable b.  The I<value> of b would be passed into the function foo.  The
+actual call to the function foo that xsubpp generates would look like this:
+
+	foo(&a, b);
+
+Xsubpp will identically parse the following function argument lists:
+
+	char	&a
+	char&a
+	char	& a
+
+However, to help ease understanding, it is suggested that you place a "&"
+next to the variable name and away from the variable type), and place a
+"*" near the variable type, but away from the variable name (as in the
+complete example above).  By doing so, it is easy to understand exactly
+what will be passed to the C function -- it will be whatever is in the
+"last column".
+
+You should take great pains to try to pass the function the type of variable
+it wants, when possible.  It will save you a lot of trouble in the long run.
+
+=head2 THE ARGUMENT STACK
+
+If we look at any of the C code generated by any of the examples except
+example 1, you will notice a number of references to ST(n), where n is
+usually 0.  The "ST" is actually a macro that points to the n'th argument
+on the argument stack.  ST(0) is thus the first argument passed to the
+XSUB, ST(1) is the second argument, and so on.
+
+When you list the arguments to the XSUB in the .xs file, that tell xsubpp
+which argument corresponds to which of the argument stack (i.e., the first
+one listed is the first argument, and so on).  You invite disaster if you
+do not list them in the same order as the function expects them.
+
+=head2 EXTENDING YOUR EXTENSION
+
+Sometimes you might want to provide some extra methods or subroutines
+to assist in making the interface between Perl and your extension simpler
+or easier to understand.  These routines should live in the .pm file.
+Whether they are automatically loaded when the extension itself is loaded
+or only loaded when called depends on where in the .pm file the subroutine
+definition is placed.
+
+=head2 DOCUMENTING YOUR EXTENSION
+
+There is absolutely no excuse for not documenting your extension.
+Documentation belongs in the .pm file.  This file will be fed to pod2man,
+and the embedded documentation will be converted to the man page format,
+then placed in the blib directory.  It will be copied to Perl's man
+page directory when the extension is installed.
+
+You may intersperse documentation and Perl code within the .pm file.
+In fact, if you want to use method autoloading, you must do this,
+as the comment inside the .pm file explains.
+
+See L<perlpod> for more information about the pod format.
+
+=head2 INSTALLING YOUR EXTENSION
+
+Once your extension is complete and passes all its tests, installing it
+is quite simple: you simply run "make install".  You will either need 
+to have write permission into the directories where Perl is installed,
+or ask your system administrator to run the make for you.
+
+=head2 SEE ALSO
+
+For more information, consult L<perlguts>, L<perlxs>, L<perlmod>,
+and L<perlpod>.
+
+=head2 Author
+
+Jeff Okamoto <okamoto@corp.hp.com>
+
+Reviewed and assisted by Dean Roehrich, Ilya Zakharevich, Andreas Koenig,
+and Tim Bunce.
+
+=head2 Last Changed
+
+1996/2/9
diff --git a/gnu/usr.bin/perl/pod/pod2html.PL b/gnu/usr.bin/perl/pod/pod2html.PL
new file mode 100644
index 00000000000..646190bddbc
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/pod2html.PL
@@ -0,0 +1,549 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+eval 'exec perl -S $0 ${1+"$@"}'
+        if $running_under_some_shell;
+#
+# pod2html - convert pod format to html
+# Version 1.15
+# usage: pod2html [podfiles]
+# Will read the cwd and parse all files with .pod extension
+# if no arguments are given on the command line.
+#
+# Many helps, suggestions, and fixes from the perl5 porters, and all over.
+# Bill Middleton - wjm@metronet.com
+#
+# Please send patches/fixes/features to me
+#
+#
+# 
+*RS = */;
+*ERRNO = *!;
+
+################################################################################
+# Invoke with various levels of debugging possible
+################################################################################
+while ($ARGV[0] =~ /^-d(.*)/) {
+    shift;
+    $Debug{ lc($1 || shift) }++;
+}
+
+# ck for podnames on command line
+while ($ARGV[0]) {
+    push(@Pods,shift);
+}
+
+################################################################################
+# CONFIGURE
+#
+# The beginning of the url for the anchors to the other sections.
+# Edit $type to suit.  It's configured for relative url's now.
+# Other possibilities are:
+# $type = '<A HREF="file://localhost/usr/local/htmldir/'; # file url
+# $type = '<A HREF="http://www.bozo.com/perl/manual/html/' # server
+#
+################################################################################
+
+$type = '<A HREF="';		
+$dir = ".";             # location of pods
+
+# look in these pods for things not found within the current pod
+# be careful tho, namespace collisions cause stupid links
+
+@inclusions = qw[
+     perlfunc perlvar perlrun perlop 
+];
+################################################################################
+# END CONFIGURE
+################################################################################
+
+$A = {};  # The beginning of all things
+
+unless (@Pods) {
+    opendir(DIR,$dir)  or  die "Can't opendir $dir: $ERRNO";
+    @Pods = grep(/\.pod$/,readdir(DIR));
+    closedir(DIR) or die "Can't closedir $dir: $ERRNO";
+}
+@Pods or die "aak, expected pods";
+
+# loop twice through the pods, first to learn the links, then to produce html
+for $count (0,1) {
+    print STTDER "Scanning pods...\n" unless $count;
+    foreach $podfh ( @Pods ) {
+	($pod = $podfh) =~ s/\.pod$//;
+	Debug("files", "opening 2 $podfh" );
+	print "Creating $pod.html from $podfh\n" if $count;
+	$RS = "\n=";         # grok pods by item (Nonstandard but effecient)
+	open($podfh,"<".$podfh)  || die "can't open $podfh: $ERRNO";
+	@all = <$podfh>;
+	close($podfh);
+	$RS = "\n";
+
+	$all[0] =~ s/^=//;
+	for (@all) { s/=$// }
+	$Podnames{$pod} = 1;
+	$in_list = 0;
+	$html = $pod.".html";
+	if ($count) {              # give us a html and rcs header
+	    open(HTML,">$html") || die "can't create $html: $ERRNO";
+	    print HTML '<!-- $Id$ -->',"\n",'<HTML><HEAD>',"\n";
+	    print HTML "<CENTER>" unless $NO_NS;
+	    print HTML "<TITLE>$pod</TITLE>\n</HEAD>\n<BODY>";
+	    print HTML "</CENTER>" unless $NO_NS;
+	}
+	for ($i = 0; $i <= $#all; $i++) {       # decide what to do with each chunk
+	    $all[$i] =~ /^(\w+)\s*(.*)\n?([^\0]*)$/ ;
+	    ($cmd, $title, $rest) = ($1,$2,$3);
+	    if ($cmd eq "item") {
+		if ($count ) { # producing html
+		    do_list("over",$all[$i],\$in_list,\$depth) unless $depth;
+		    do_item($title,$rest,$in_list);
+		}
+		else {  
+		    # scan item
+		    scan_thing("item",$title,$pod);
+		}
+	    }
+	    elsif ($cmd =~ /^head([12])/) {
+		$num = $1;
+		if ($count) { # producing html
+		    do_hdr($num,$title,$rest,$depth);
+		}
+		else {
+		    # header scan
+		    scan_thing($cmd,$title,$pod); # skip head1
+		}
+	    }
+	    elsif ($cmd =~ /^over/) {
+		$count and $depth and do_list("over",$all[$i+1],\$in_list,\$depth);
+	    }
+	    elsif ($cmd =~ /^back/) {
+		if ($count) {  # producing html
+		    ($depth) or next; # just skip it
+		    do_list("back",$all[$i+1],\$in_list,\$depth);
+		    do_rest("$title.$rest");
+		}
+	    }
+	    elsif ($cmd =~ /^cut/) {
+		next;
+	    }
+            elsif ($cmd =~ /^for/) {  # experimental pragma html
+                if ($count) {  # producing html
+                    if ($title =~ s/^html//) {
+                        $in_html =1;
+                        do_rest("$title.$rest");
+                    }
+                }
+            }
+            elsif ($cmd =~ /^begin/) {  # experimental pragma html
+                if ($count) {  # producing html
+                    if ($title =~ s/^html//) {
+                        print HTML $title,"\n",$rest;
+                    }
+                    elsif ($title =~ /^end/) {
+                        next;
+                    }
+                }
+            }
+	    elsif ($Debug{"misc"}) { 
+		warn("unrecognized header: $cmd");
+	    }
+	}
+        # close open lists without '=back' stmts
+	if ($count) {  # producing html
+	    while ($depth) {
+		 do_list("back",$all[$i+1],\$in_list,\$depth);
+	    }
+	    print HTML "\n</BODY>\n</HTML>\n";
+	}
+    }
+}
+
+sub do_list{   # setup a list type, depending on some grok logic
+    my($which,$next_one,$list_type,$depth) = @_;
+    my($key);
+    if ($which eq "over") {
+	unless ($next_one =~ /^item\s+(.*)/) {
+	    warn "Bad list, $1\n" if $Debug{"misc"};
+	}
+	$key = $1;
+
+	if      ($key =~ /^1\.?/) {
+	    $$list_type = "OL";
+	} elsif ($key =~ /\*\s*$/) {
+	    $$list_type = "UL";
+	} elsif ($key =~ /\*?\s*\w/) {
+	    $$list_type = "DL";
+	} else {
+	    warn "unknown list type for item $key" if $Debug{"misc"};
+	}
+
+	print HTML qq{\n};
+	print HTML $$list_type eq 'DL' ? qq{<DL COMPACT>} : qq{<$$list_type>};
+	$$depth++;
+    }
+    elsif ($which eq "back") {
+	print HTML qq{\n</$$list_type>\n};
+	$$depth--;
+    }
+}
+
+sub do_hdr{   # headers
+    my($num,$title,$rest,$depth) = @_;
+    print HTML qq{<p><hr>\n} if $num == 1;
+    process_thing(\$title,"NAME");
+    print HTML qq{\n<H$num> };
+    print HTML $title; 
+    print HTML qq{</H$num>\n};
+    do_rest($rest);
+}
+
+sub do_item{  # list items
+    my($title,$rest,$list_type) = @_;
+    my $bullet_only = $title eq '*' and $list_type eq 'UL';
+    process_thing(\$title,"NAME");
+    if ($list_type eq "DL") {
+	print HTML qq{\n<DT><STRONG>\n};
+	print HTML $title; 
+	print HTML qq{\n</STRONG>\n};
+	print HTML qq{<DD>\n};
+    }
+    else {
+	print HTML qq{\n<LI>};
+	unless ($bullet_only or $list_type eq "OL") {
+	    print HTML $title,"\n";
+	}
+    }
+    do_rest($rest);
+}
+
+sub do_rest{   # the rest of the chunk handled here
+    my($rest) = @_;
+    my(@lines,$p,$q,$line,,@paras,$inpre);
+    @paras = split(/\n\n\n*/,$rest);  
+    for ($p = 0; $p <= $#paras; $p++) {
+	$paras[$p] =~ s/^\n//mg;
+	@lines = split(/\n/,$paras[$p]);
+        if ($in_html) {  # handle =for html paragraphs
+            print HTML $paras[0];
+            $in_html = 0;
+            next;
+        }
+	elsif ($lines[0] =~ /^\s+\w*\t.*/) {  # listing or unordered list
+	    print HTML qq{<UL>};
+	    foreach $line (@lines) { 
+		($line =~ /^\s+(\w*)\t(.*)/) && (($key,$rem) = ($1,$2));
+		print HTML defined($Podnames{$key}) 
+				?  "<LI>$type$key.html\">$key<\/A>\t$rem</LI>\n" 
+				: "<LI>$line</LI>\n";
+	    }
+	    print HTML qq{</UL>\n};
+	}
+	elsif ($lines[0] =~ /^\s/) {       # preformatted code
+	    if ($paras[$p] =~/>>|<</) {
+		print HTML qq{\n<PRE>\n};
+		$inpre=1;
+	    }
+	    else {                         # Still cant beat XMP.  Yes, I know 
+		print HTML qq{\n<XMP>\n}; # it's been obsoleted... suggestions?
+		$inpre = 0;
+	    }
+	    while (defined($paras[$p])) {
+	        @lines = split(/\n/,$paras[$p]);
+		foreach $q (@lines) {      # mind your p's and q's here :-)
+		    if ($paras[$p] =~ />>|<</) {
+			if ($inpre) {
+			    process_thing(\$q,"HTML");
+			}
+			else {
+			    print HTML qq{\n</XMP>\n};
+			    print HTML qq{<PRE>\n};
+			    $inpre=1;
+			    process_thing(\$q,"HTML");
+			}
+		    }
+		    1 while $q =~  s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e;
+		    print HTML  $q,"\n";
+		}
+		last if $paras[$p+1] !~ /^\s/;
+		$p++;
+	    }
+	    print HTML ($inpre==1) ? (qq{\n</PRE>\n}) : (qq{\n</XMP>\n});
+	}
+	else {                             # other text
+	    @lines = split(/\n/,$paras[$p]);
+	    foreach $line (@lines) {
+                process_thing(\$line,"HTML");
+		print HTML qq{$line\n};
+	    }
+	}
+	print HTML qq{<p>};
+    }
+}
+
+sub process_thing{       # process a chunk, order important
+    my($thing,$htype) = @_;
+    pre_escapes($thing);
+    find_refs($thing,$htype);
+    post_escapes($thing);
+}
+
+sub scan_thing{           # scan a chunk for later references
+    my($cmd,$title,$pod) = @_;
+    $_ = $title;
+    s/\n$//;
+    s/E<(.*?)>/&$1;/g;
+    # remove any formatting information for the headers
+    s/[SFCBI]<(.*?)>/$1/g;         
+    # the "don't format me" thing
+    s/Z<>//g;
+    if ($cmd eq "item") {
+        /^\*/ and  return; 	# skip bullets
+        /^\d+\./ and  return; 	# skip numbers
+        s/(-[a-z]).*/$1/i;
+	trim($_);
+        return if defined $A->{$pod}->{"Items"}->{$_};
+        $A->{$pod}->{"Items"}->{$_} = gensym($pod, $_);
+        $A->{$pod}->{"Items"}->{(split(' ',$_))[0]}=$A->{$pod}->{"Items"}->{$_};
+        Debug("items", "item $_");
+        if (!/^-\w$/ && /([%\$\@\w]+)/ && $1 ne $_ 
+    	    && !defined($A->{$pod}->{"Items"}->{$_}) && ($_ ne $1)) 
+        {
+    	    $A->{$pod}->{"Items"}->{$1} = $A->{$pod}->{"Items"}->{$_};
+    	    Debug("items", "item $1 REF TO $_");
+        } 
+        if ( m{^(tr|y|s|m|q[qwx])/.*[^/]} ) {
+    	    my $pf = $1 . '//';
+    	    $pf .= "/" if $1 eq "tr" || $1 eq "y" || $1 eq "s";
+    	    if ($pf ne $_) {
+    	        $A->{$pod}->{"Items"}->{$pf} = $A->{$pod}->{"Items"}->{$_};
+    	        Debug("items", "item $pf REF TO $_");
+    	    }
+	}
+    }
+    elsif ($cmd =~ /^head[12]/) {                
+        return if defined($A->{$pod}->{"Headers"}->{$_});
+        $A->{$pod}->{"Headers"}->{$_} = gensym($pod, $_);
+        Debug("headers", "header $_");
+    } 
+    else {
+        warn "unrecognized header: $cmd" if $Debug;
+    } 
+}
+
+
+sub picrefs { 
+    my($char, $bigkey, $lilkey,$htype) = @_;
+    my($key,$ref,$podname);
+    for $podname ($pod,@inclusions) {
+	for $ref ( "Items", "Headers" ) {
+	    if (defined $A->{$podname}->{$ref}->{$bigkey}) {
+		$value = $A->{$podname}->{$ref}->{$key = $bigkey};
+		Debug("subs", "bigkey is $bigkey, value is $value\n");
+	    } 
+	    elsif (defined $A->{$podname}->{$ref}->{$lilkey}) {
+		$value = $A->{$podname}->{$ref}->{$key = $lilkey};
+		return "" if $lilkey eq '';
+		Debug("subs", "lilkey is $lilkey, value is $value\n");
+	    } 
+	} 
+	if (length($key)) {
+            ($pod2,$num) = split(/_/,$value,2);
+	    if ($htype eq "NAME") {  
+		return "\n<A NAME=\"".$value."\">\n$bigkey</A>\n"
+	    }
+	    else {
+		return "\n$type$pod2.html\#".$value."\">$bigkey<\/A>\n";
+	    }
+	} 
+    }
+    if ($char =~ /[IF]/) {
+	return "<EM>$bigkey</EM>";
+    } elsif ($char =~ /C/) {
+	return "<CODE>$bigkey</CODE>";
+    } else {
+	return "<STRONG>$bigkey</STRONG>";
+    }
+} 
+
+sub find_refs { 
+    my($thing,$htype) = @_;
+    my($orig) = $$thing;
+    # LREF: a manpage(3f) we don't know about
+    for ($$thing) {
+	#s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))>:the I<$1>$2 manpage:g;
+        s@(\S+?://\S*[^.,;!?\s])@noremap(qq{<A HREF="$1">$1</A>})@ge;
+        s,([a-z0-9_.-]+\@([a-z0-9_-]+\.)+([a-z0-9_-]+)),noremap(qq{<A HREF="MAILTO:$1">$1</A>}),gie;
+	s/L<([^>]*)>/lrefs($1,$htype)/ge;
+	s/([CIBF])<(\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
+	s/(S)<([^\/]\W*?(-?\w*).*?)>/picrefs($1, $2, $3, $htype)/ge;
+	s/((\w+)\(\))/picrefs("I", $1, $2,$htype)/ge;
+	s/([\$\@%](?!&[gl]t)([\w:]+|\W\b))/varrefs($1,$htype)/ge;
+    }
+    if ($$thing eq $orig && $htype eq "NAME") { 
+	$$thing = picrefs("I", $$thing, "", $htype);
+    }
+
+}
+
+sub lrefs {
+    my($page, $item) = split(m#/#, $_[0], 2);
+    my($htype) = $_[1];
+    my($podname);
+    my($section) = $page =~ /\((.*)\)/;
+    my $selfref;
+    if ($page =~ /^[A-Z]/ && $item) {
+	$selfref++;
+	$item = "$page/$item";
+	$page = $pod;
+    }  elsif (!$item && $page =~ /[^a-z\-]/ && $page !~ /^\$.$/) {
+	$selfref++;
+	$item = $page;
+	$page = $pod;
+    } 
+    $item =~ s/\(\)$//;
+    if (!$item) {
+    	if (!defined $section && defined $Podnames{$page}) {
+	    return "\n$type$page.html\">\nthe <EM>$page</EM> manpage<\/A>\n";
+	} else {
+	    (warn "Bizarre entry $page/$item") if $Debug;
+	    return "the <EM>$_[0]</EM>  manpage\n";
+	} 
+    } 
+
+    if ($item =~ s/"(.*)"/$1/ || ($item =~ /[^\w\/\-]/ && $item !~ /^\$.$/)) {
+	$text = "<EM>$item</EM>";
+	$ref = "Headers";
+    } else {
+	$text = "<EM>$item</EM>";
+	$ref = "Items";
+    } 
+    for $podname ($pod, @inclusions) {
+	undef $value;
+	if ($ref eq "Items") {
+	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
+		($pod2,$num) = split(/_/,$value,2);
+		return (($pod eq $pod2) && ($htype eq "NAME"))
+	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
+	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
+            }
+        } 
+	elsif ($ref eq "Headers") {
+	    if (defined($value = $A->{$podname}->{$ref}->{$item})) {
+		($pod2,$num) = split(/_/,$value,2);
+		return (($pod eq $pod2) && ($htype eq "NAME")) 
+	    	? "\n<A NAME=\"".$value."\">\n$text</A>\n"
+	    	: "\n$type$pod2.html\#".$value."\">$text<\/A>\n";
+            }
+	}
+    }
+    warn "No $ref reference for $item (@_)" if $Debug;
+    return $text;
+} 
+
+sub varrefs {
+    my ($var,$htype) = @_;
+    for $podname ($pod,@inclusions) {
+	if ($value = $A->{$podname}->{"Items"}->{$var}) {
+	    ($pod2,$num) = split(/_/,$value,2);
+	    Debug("vars", "way cool -- var ref on $var");
+	    return (($pod eq $pod2) && ($htype eq "NAME"))  # INHERIT $_, $pod
+		? "\n<A NAME=\"".$value."\">\n$var</A>\n"
+		: "\n$type$pod2.html\#".$value."\">$var<\/A>\n";
+	}
+    }
+    Debug( "vars", "bummer, $var not a var");
+    return "<STRONG>$var</STRONG>";
+} 
+
+sub gensym {
+    my ($podname, $key) = @_;
+    $key =~ s/\s.*//;
+    ($key = lc($key)) =~ tr/a-z/_/cs;
+    my $name = "${podname}_${key}_0";
+    $name =~ s/__/_/g;
+    while ($sawsym{$name}++) {
+        $name =~ s/_?(\d+)$/'_' . ($1 + 1)/e;
+    }
+    return $name;
+} 
+
+sub pre_escapes {  # twiddle these, and stay up late  :-)
+    my($thing) = @_;
+    for ($$thing) { 
+	s/"(.*?)"/``$1''/gs;
+	s/&/noremap("&amp;")/ge;
+	s/<</noremap("&lt;&lt;")/eg;
+	s/([^ESIBLCF])</$1\&lt\;/g;
+	s/E<([^\/][^<>]*)>/\&$1\;/g;              # embedded special
+    }
+}
+sub noremap {   # adding translator for hibit chars soon
+    my $hide = $_[0];
+    $hide =~ tr/\000-\177/\200-\377/;  
+    $hide;
+} 
+
+
+sub post_escapes {
+    my($thing) = @_;
+    for ($$thing) {
+	s/([^GM])>>/$1\&gt\;\&gt\;/g;
+	s/([^D][^"MGA])>/$1\&gt\;/g;
+	tr/\200-\377/\000-\177/;
+    }
+}
+
+sub Debug {
+    my $level = shift;
+    print STDERR @_,"\n" if $Debug{$level};
+} 
+
+sub dumptable  {
+    my $t = shift;
+    print STDERR "TABLE DUMP $t\n";
+    foreach $k (sort keys %$t) {
+	printf STDERR "%-20s <%s>\n", $t->{$k}, $k;
+    } 
+} 
+sub trim {
+    for (@_) {
+        s/^\s+//;
+        s/\s\n?$//;
+    }
+}
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/pod/pod2latex.PL b/gnu/usr.bin/perl/pod/pod2latex.PL
new file mode 100644
index 00000000000..34b1faadba8
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/pod2latex.PL
@@ -0,0 +1,672 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+#
+# pod2latex, version 1.1
+# by Taro Kawagish (kawagish@imslab.co.jp),  Jan 11, 1995.
+#
+# pod2latex filters Perl pod documents to LaTeX documents.
+#
+# What pod2latex does:
+# 1. Pod file 'perl_doc_entry.pod' is filtered to 'perl_doc_entry.tex'.
+# 2. Indented paragraphs are translated into
+#    '\begin{verbatim} ... \end{verbatim}'.
+# 3. '=head1 heading' command is translated into '\section{heading}'
+# 4. '=head2 heading' command is translated into '\subsection*{heading}'
+# 5. '=over N' command is translated into
+#        '\begin{itemize}'	if following =item starts with *,
+#        '\begin{enumerate}'	if following =item starts with 1.,
+#        '\begin{description}'	if else.
+#      (indentation level N is ignored.)
+# 6. '=item * heading' command is translated into '\item heading',
+#    '=item 1. heading' command is translated into '\item heading',
+#    '=item heading' command(other) is translated into '\item[heading]'.
+# 7. '=back' command is translated into
+#        '\end{itemize}'	if started with '\begin{itemize}',
+#        '\end{enumerate}'	if started with '\begin{enumerate}',
+#        '\end{description}'	if started with '\begin{description}'.
+# 8. other paragraphs are translated into strings with TeX special characters
+#    escaped.
+# 9. In heading text, and other paragraphs, the following translation of pod
+#    quotes are done, and then TeX special characters are escaped after that.
+#      I<text> to {\em text\/},
+#      B<text> to {\bf text},
+#      S<text> to text1,
+#        where text1 is a string with blank characters replaced with ~,
+#      C<text> to {\tt text2},
+#        where text2 is a string with TeX special characters escaped to
+#        obtain a literal printout,
+#      E<text> (HTML escape) to TeX escaped string,
+#      L<text> to referencing string as is done by pod2man,
+#      F<file> to {\em file\/},
+#      Z<> to a null string,
+# 10. those headings are indexed:
+#       '=head1 heading'   =>  \section{heading}\index{heading}
+#       '=head2 heading'   =>  \subsection*{heading}\index{heading}
+#                 only when heading does not match frequent patterns such as
+#                 DESCRIPTION, DIAGNOSTICS,...
+#       '=item heading'   =>  \item{heading}\index{heading}
+#
+# Usage:
+#     pod2latex perl_doc_entry.pod
+# this will write to a file 'perl_doc_entry.tex'.
+#
+# To LaTeX:
+# The following commands need to be defined in the preamble of the LaTeX
+# document:
+# \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}}
+# \def\underscore{\leavevmode\kern.04em\vbox{\hrule width 0.4em height 0.3pt}}
+# and \parindent should be set zero:
+# \setlength{\parindent}{0pt}
+#
+# Note:
+# This script was written modifing pod2man.
+#
+# Bug:
+# If HTML escapes E<text> other than E<amp>,E<lt>,E<gt>,E<quot> are used
+# in C<>, translation will produce wrong character strings.
+# Translation of HTML escapes of various European accents might be wrong.
+
+
+$/ = "";			# record separator is blank lines
+# TeX special characters.
+##$tt_ables = "!@*()-=+|;:'\"`,./?<>";
+$backslash_escapables = "#\$%&{}_";
+$backslash_escapables2 = "#\$%&{}";	# except _
+##$nonverbables = "^\\~";
+##$bracketesc = "[]";
+##@tex_verb_fences = unpack("aaaaaaaaa","|#@!*+?:;");
+
+@head1_freq_patterns		# =head1 patterns which need not be index'ed
+    = ("AUTHOR","Author","BUGS","DATE","DESCRIPTION","DIAGNOSTICS",
+       "ENVIRONMENT","EXAMPLES","FILES","INTRODUCTION","NAME","NOTE",
+       "SEE ALSO","SYNOPSIS","WARNING");
+
+$indent = 0;
+
+# parse the pods, produce LaTeX.
+
+open(POD,"<$ARGV[0]") || die "cant open $ARGV[0]";
+($pod=$ARGV[0]) =~ s/\.pod$//;
+open(LATEX,">$pod.tex");
+&do_hdr();
+
+$cutting = 1;
+while (<POD>) {
+    if ($cutting) {
+	next unless /^=/;
+	$cutting = 0;
+    }
+    chop;
+    length || (print LATEX  "\n") && next;
+
+    # translate indented lines as a verabatim paragraph
+    if (/^\s/) {
+	@lines = split(/\n/);
+	print LATEX  "\\begin{verbatim}\n";
+	for (@lines) {
+	    1 while s
+		{^( [^\t]* ) \t ( \t* ) }
+		{ $1 . ' ' x (8 - (length($1)%8) + 8*(length($2))) }ex;
+	    print LATEX  $_,"\n";
+	}
+	print LATEX  "\\end{verbatim}\n";
+	next;
+    }
+
+    # preserve '=item' line with pod quotes as they are.
+    if (/^=item/) {
+	($bareitem = $_) =~ s/^=item\s*//;
+    }
+
+    # check for things that'll hosed our noremap scheme; affects $_
+    &init_noremap();
+
+    # expand strings "func()" as pod quotes.
+    if (!/^=item/) {
+	# first hide pod escapes.
+	# escaped strings are mapped into the ones with the MSB's on.
+	s/([A-Z]<[^<>]*>)/noremap($1)/ge;
+
+	# func() is a reference to a perl function
+	s{\b([:\w]+\(\))}{I<$1>}g;
+	# func(n) is a reference to a man page
+	s{(\w+)(\([^\s,\051]+\))}{I<$1>$2}g;
+	# convert simple variable references
+#	s/([\$\@%][\w:]+)/C<$1>/g;
+#	s/\$[\w:]+\[[0-9]+\]/C<$&>/g;
+
+	if (m{ ([\-\w]+\([^\051]*?[\@\$,][^\051]*?\))
+	       }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
+	{
+	    warn "``$1'' should be a [LCI]<$1> ref";
+	}
+	while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
+	    warn "``$1'' should be [CB]<$1> ref";
+	}
+
+	# put back pod quotes so we get the inside of <> processed;
+	$_ = &clear_noremap($_);
+    }
+
+
+    # process TeX special characters
+
+    # First hide HTML quotes E<> since they can be included in C<>.
+    s/(E<[^<>]+>)/noremap($1)/ge;
+
+    # Then hide C<> type literal quotes.
+    # String inside of C<> will later be expanded into {\tt ..} strings
+    # with TeX special characters escaped as needed.
+    s/(C<[^<>]*>)/&noremap($1)/ge;
+
+    # Next escape TeX special characters including other pod quotes B< >,...
+    #
+    # NOTE: s/re/&func($str)/e evaluates $str just once in perl5.
+    # (in perl4 evaluation takes place twice before getting passed to func().)
+
+    # - hyphen => ---
+    s/(\S+)(\s+)-+(\s+)(\S+)/"$1".&noremap(" --- ")."$4"/ge;
+    # '-', '--', "-"  =>  '{\tt -}', '{\tt --}', "{\tt -}"
+##    s/("|')(\s*)(-+)(\s*)\1/&noremap("$1$2\{\\tt $3\}$4$1")/ge;
+## changed Wed Jan 25 15:26:39 JST 1995
+    # '-', '--', "-"  =>  '$-$', '$--$', "$-$"
+    s/(\s+)(['"])(-+)([^'"\-]*)\2(\s+|[,.])/"$1$2".&noremap("\$$3\$")."$4$2$5"/ge;
+    s/(\s+)(['"])([^'"\-]*)(-+)(\s*)\2(\s+|[,.])/"$1$2$3".&noremap("\$$4\$")."$5$2$6"/ge;
+    # (--|-)  =>  ($--$|$-$)
+    s/(\s+)\((-+)([=@%\$\+\\\|\w]*)(-*)([=@%\$\+\\\|\w]*)\)(\s+|[,.])/"$1\(".&noremap("\$$2\$")."$3".&noremap("\$$4\$")."$5\)$6"/ge;
+    # numeral -  =>  $-$
+    s/(\(|[0-9]+|\s+)-(\s*\(?\s*[0-9]+)/&noremap("$1\$-\$$2")/ge;
+    # -- in quotes  =>  two separate -
+    s/B<([^<>]*)--([^<>]*)>/&noremap("B<$1\{\\tt --\}$2>")/ge;
+
+    # backslash escapable characters except _.
+    s/([$backslash_escapables2])/&noremap("\\$1")/ge;
+    s/_/&noremap("\\underscore{}")/ge;		# a litle thicker than \_.
+    # quote TeX special characters |, ^, ~, \.
+    s/\|/&noremap("\$|\$")/ge;
+    s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge;
+    s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge;
+    s/\\/&noremap("\$\\backslash{}\$")/ge;
+    # quote [ and ] to be used in \item[]
+    s/([\[\]])/&noremap("{\\tt $1}")/ge;
+    # characters need to be treated differently in TeX
+    # keep * if an item heading
+    s/^(=item[ \t]+)[*]((.|\n)*)/"$1" . &noremap("*") . "$2"/ge;
+    s/[*]/&noremap("\$\\ast\$")/ge;	# other *
+
+    # hide other pod quotes.
+    s/([ABD-Z]<[^<>]*>)/&noremap($1)/ge;
+
+    # escape < and > as math strings,
+    # now that we are done with hiding pod <> quotes.
+    s/</&noremap("\$<\$")/ge;
+    s/>/&noremap("\$>\$")/ge;
+
+    # put it back so we get the <> processed again;
+    $_ = &clear_noremap($_);
+
+
+    # Expand pod quotes recursively:
+    # (1) type face directives [BIFS]<[^<>]*> to appropriate TeX commands,
+    # (2) L<[^<>]*> to reference strings,
+    # (3) C<[^<>]*> to TeX literal quotes,
+    # (4) HTML quotes E<> inside of C<> quotes.
+
+    # Hide E<> again since they can be included in C<>.
+    s/(E<[^<>]+>)/noremap($1)/ge;
+
+    $maxnest = 10;
+    while ($maxnest-- && /[A-Z]</) {
+
+	# bold and italic quotes
+	s/B<([^<>]*)>/"{\\bf $1}"/eg;
+	s#I<([^<>]*)>#"{\\em $1\\/}"#eg;
+
+	# files and filelike refs in italics
+	s#F<([^<>]*)>#"{\\em $1\\/}"#eg;
+
+	# no break quote -- usually we want C<> for this
+	s/S<([^<>]*)>/&nobreak($1)/eg;
+
+	# LREF: a manpage(3f)
+	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the {\\em $1\\/}$2 manpage:g;
+
+	# LREF: an =item on another manpage
+	s{
+	    L<([^/]+)/([:\w]+(\(\))?)>
+	} {the C<$2> entry in the I<$1> manpage}gx;
+
+	# LREF: an =item on this manpage
+	s{
+	   ((?:L</([:\w]+(\(\))?)>
+	    (,?\s+(and\s+)?)?)+)
+	} { &internal_lrefs($1) }gex;
+
+	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
+	# the "func" can disambiguate
+	s{
+	    L<(?:([a-zA-Z]\S+?) /)?"?(.*?)"?>
+	}{
+	    do {
+		$1 	# if no $1, assume it means on this page.
+		    ?  "the section on I<$2> in the I<$1> manpage"
+		    :  "the section on I<$2>"
+	    } 
+	}gex;
+
+	s/Z<>/\\&/g;		# the "don't format me" thing
+
+	# comes last because not subject to reprocessing
+	s{
+	    C<([^<>]*)>
+	}{
+	    do {
+		($str = $1) =~ tr/\200-\377/\000-\177/; #normalize hidden stuff
+		# expand HTML escapes if any;
+		# WARNING: if HTML escapes other than E<amp>,E<lt>,E<gt>,
+		# E<quot> are in C<>, they will not be printed correctly.
+		$str = &expand_HTML_escapes($str);
+		$strverb = &alltt($str);    # Tex verbatim escape of a string.
+		&noremap("$strverb");
+	    }
+	}gex;
+
+#	if ( /C<([^<>]*)/ ) {
+#	    $str = $1;
+#	    if ($str !~ /\|/) {		# if includes |
+#		s/C<([^<>]*)>/&noremap("\\verb|$str|")/eg;
+#	    } else {
+#		print STDERR "found \| in C<.*> at paragraph $.\n";
+#		# find a character not contained in $str to use it as a
+#		# separator of the \verb
+#		($chars = $str) =~ s/(\W)/\\$1/g;
+#		## ($chars = $str) =~ s/([\$<>,\|"'\-^{}()*+?\\])/\\$1/g;
+#		@fence = grep(!/[ $chars]/,@tex_verb_fences);
+#		s/C<([^<>]*)>/&noremap("\\verb$fence[0]$str$fence[0]")/eg;
+#	    }
+#	}
+    }
+
+
+    # process each pod command
+    if (s/^=//) {				# if a command
+	s/\n/ /g;
+	($cmd, $rest) = split(' ', $_, 2);
+	$rest =~ s/^\s*//;
+	$rest =~ s/\s*$//;
+
+	if (defined $rest) {
+	    &escapes;
+	}
+
+	$rest = &clear_noremap($rest);
+	$rest = &expand_HTML_escapes($rest);
+
+	if ($cmd eq 'cut') {
+	    $cutting = 1;
+	    $lastcmd = 'cut';
+	}
+	elsif ($cmd eq 'head1') {	# heading type 1
+	    $rest =~ s/^\s*//; $rest =~ s/\s*$//;
+	    print LATEX  "\n\\subsection*{$rest}";
+	    # put index entry
+	    ($index = $rest) =~ s/^(An?\s+|The\s+)//i;	# remove 'A' and 'The'
+	    # index only those heads not matching the frequent patterns.
+	    foreach $pat (@head1_freq_patterns) {
+		if ($index =~ /^$pat/) {
+		    goto freqpatt;
+		}
+	    }
+	    print LATEX  "%\n\\index{$index}\n" if ($index);
+	  freqpatt:
+	    $lastcmd = 'head1';
+	}
+	elsif ($cmd eq 'head2') {	# heading type 2
+	    $rest =~ s/^\s*//; $rest =~ s/\s*$//;
+	    print LATEX  "\n\\subsubsection*{$rest}";
+	    # put index entry
+	    ($index = $rest) =~ s/^(An?\s+|The\s+)//i;	# remove 'A' and 'The'
+	    $index =~ s/^Example\s*[1-9][0-9]*\s*:\s*//; # remove 'Example :'
+	    print LATEX  "%\n\\index{$index}\n"  if ($index);
+	    $lastcmd = 'head2';
+	}
+	elsif ($cmd eq 'over') {	# 1 level within a listing environment
+	    push(@indent,$indent);
+	    $indent = $rest + 0;
+	    $lastcmd = 'over';
+	}
+	elsif ($cmd eq 'back') {	# 1 level out of a listing environment
+	    $indent = pop(@indent);
+	    warn "Unmatched =back\n" unless defined $indent;
+	    $listingcmd = pop(@listingcmd);
+	    print LATEX  "\n\\end{$listingcmd}\n"  if ($listingcmd);
+	    $lastcmd = 'back';
+	}
+	elsif ($cmd eq 'item') {	# an item paragraph starts
+	    if ($lastcmd eq 'over') {	# if we have just entered listing env
+		# see what type of list environment we are in.
+		if ($rest =~ /^[0-9]\.?/) {	# if numeral heading
+		    $listingcmd = 'enumerate';
+		} elsif ($rest =~ /^\*\s*/) {	# if * heading
+		    $listingcmd = 'itemize';
+		} elsif ($rest =~ /^[^*]/) {	# if other headings
+		    $listingcmd = 'description';
+		} else {
+		    warn "unknown list type for item $rest";
+		}
+		print LATEX  "\n\\begin{$listingcmd}\n";
+		push(@listingcmd,$listingcmd);
+	    } elsif ($lastcmd ne 'item') {
+		warn "Illegal '=item' command without preceding 'over':";
+		warn "=item $bareitem";
+	    }
+
+	    if ($listingcmd eq 'enumerate') {
+		$rest =~ s/^[0-9]+\.?\s*//;	# remove numeral heading
+		print LATEX  "\n\\item";
+		print LATEX  "{\\bf $rest}" if $rest;
+	    } elsif ($listingcmd eq 'itemize') {
+		$rest =~ s/^\*\s*//;		# remove * heading
+		print LATEX  "\n\\item";
+		print LATEX  "{\\bf $rest}" if $rest;
+	    } else {				# description item
+		print LATEX  "\n\\item[$rest]";
+	    }
+	    $lastcmd = 'item';
+	    $rightafter_item = 'yes';
+
+	    # check if the item heading is short or long.
+	    ($itemhead = $rest) =~ s/{\\bf (\S*)}/$1/g;
+	    if (length($itemhead) < 4) {
+		$itemshort = "yes";
+	    } else {
+		$itemshort = "no";
+	    }
+	    # write index entry
+	    if ($pod =~ "perldiag") {			# skip 'perldiag.pod'
+		goto noindex;
+	    }
+	    # strip out the item of pod quotes and get a plain text entry
+	    $bareitem =~ s/\n/ /g;			# remove newlines
+	    $bareitem =~ s/\s*$//;			# remove trailing space
+	    $bareitem =~ s/[A-Z]<([^<>]*)>/$1/g;	# remove <> quotes
+	    ($index = $bareitem) =~ s/^\*\s+//;		# remove leading '*'
+	    $index =~ s/^(An?\s+|The\s+)//i;		# remove 'A' and 'The'
+	    $index =~ s/^\s*[1-9][0-9]*\s*[.]\s*$//; # remove numeral only
+	    $index =~ s/^\s*\w\s*$//;			# remove 1 char only's
+		# quote ", @ and ! with " to be used in makeindex.
+	    $index =~ s/"/""/g;				# quote "
+	    $index =~ s/@/"@/g;				# quote @
+	    $index =~ s/!/"!/g;				# quote !
+	    ($rest2=$rest) =~ s/^\*\s+//;	# remove *
+	    $rest2 =~ s/"/""/g;				# quote "
+	    $rest2 =~ s/@/"@/g;				# quote @
+	    $rest2 =~ s/!/"!/g;				# quote !
+	    if ($pod =~ "(perlfunc|perlvar)") {	# when doc is perlfunc,perlvar
+		# take only the 1st word of item heading
+		$index =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/;
+		$rest2 =~ s/^([^{}\s]*)({.*})?([^{}\s]*)\s+.*/\1\2\3/;
+	    }
+	    if ($index =~ /[A-Za-z\$@%]/) {
+		    #  write  \index{plain_text_entry@TeX_string_entry}
+		print LATEX  "%\n\\index{$index\@$rest2}%\n";
+	    }
+	  noindex:
+	    ;
+	}
+	else {
+	    warn "Unrecognized directive: $cmd\n";
+	}
+    }
+    else {					# if not command
+	&escapes;
+	$_ = &clear_noremap($_);
+	$_ = &expand_HTML_escapes($_);
+
+	# if the present paragraphs follows an =item declaration,
+	# put a line break.
+	if ($lastcmd eq 'item' &&
+	    $rightafter_item eq 'yes' && $itemshort eq "no") {
+	    print LATEX  "\\hfil\\\\";
+	    $rightafter_item = 'no';
+	}
+	print LATEX  "\n",$_;
+    }
+}
+
+print LATEX  "\n";
+close(POD);
+close(LATEX);
+
+
+#########################################################################
+
+sub do_hdr {
+    print LATEX "% LaTeX document produced by pod2latex from \"$pod.pod\".\n";
+    print LATEX "% The followings need be defined in the preamble of this document:\n";
+    print LATEX "%\\def\\C++{{\\rm C\\kern-.05em\\raise.3ex\\hbox{\\footnotesize ++}}}\n";
+    print LATEX "%\\def\\underscore{\\leavevmode\\kern.04em\\vbox{\\hrule width 0.4em height 0.3pt}}\n";
+    print LATEX "%\\setlength{\\parindent}{0pt}\n";
+    print LATEX "\n";
+    $podq = &escape_tex_specials("\U$pod\E");
+    print LATEX "\\section{$podq}%\n";
+    print LATEX "\\index{$podq}";
+    print LATEX "\n";
+}
+
+sub nobreak {
+    my $string = shift;
+    $string =~ s/ +/~/g;		# TeX no line break
+    $string;
+}
+
+sub noremap {
+    local($thing_to_hide) = shift;
+    $thing_to_hide =~ tr/\000-\177/\200-\377/;
+    return $thing_to_hide;
+}
+
+sub init_noremap {
+    if ( /[\200-\377]/ ) {
+	warn "hit bit char in input stream";
+    }
+}
+
+sub clear_noremap {
+    local($tmp) = shift;
+    $tmp =~ tr/\200-\377/\000-\177/;
+    return $tmp;
+}
+
+sub expand_HTML_escapes {
+    local($s) = $_[0];
+    $s =~ s { E<([A-Za-z]+)> }
+    {
+	do {
+	    exists $HTML_Escapes{$1}
+	    ? do { $HTML_Escapes{$1} }
+	    : do {
+		warn "Unknown escape: $& in $_";
+		"E<$1>";
+	    }
+	}
+    }egx;
+    return $s;
+}
+
+sub escapes {
+    # make C++ into \C++, which is to be defined as
+    # \def\C++{{\rm C\kern-.05em\raise.3ex\hbox{\footnotesize ++}}}
+    s/\bC\+\+/\\C++{}/g;
+}
+
+# Translate a string into a TeX \tt string to obtain a verbatim print out.
+# TeX special characters are escaped by \.
+# This can be used inside of LaTeX command arguments.
+# We don't use LaTeX \verb since it doesn't work inside of command arguments.
+sub alltt {
+    local($str) = shift;
+	# other chars than #,\,$,%,&,{,},_,\,^,~ ([ and ] included).
+    $str =~ s/([^${backslash_escapables}\\\^\~]+)/&noremap("$&")/eg;
+	# chars #,\,$,%,&,{,}  =>  \# , ...
+    $str =~ s/([$backslash_escapables2])/&noremap("\\$&")/eg;
+	# chars _,\,^,~  =>  \char`\_ , ...
+    $str =~ s/_/&noremap("\\char`\\_")/eg;
+    $str =~ s/\\/&noremap("\\char`\\\\")/ge;
+    $str =~ s/\^/\\char`\\^/g;
+    $str =~ s/\~/\\char`\\~/g;
+
+    $str =~ tr/\200-\377/\000-\177/;		# put back
+    $str = "{\\tt ".$str."}";			# make it a \tt string
+    return $str;
+}
+
+sub escape_tex_specials {
+    local($str) = shift;
+	# other chars than #,\,$,%,&,{,},  _,\,^,~ ([ and ] included).
+    # backslash escapable characters #,\,$,%,&,{,} except _.
+    $str =~ s/([$backslash_escapables2])/&noremap("\\$1")/ge;
+    $str =~ s/_/&noremap("\\underscore{}")/ge;	# \_ is too thin.
+    # quote TeX special characters |, ^, ~, \.
+    $str =~ s/\|/&noremap("\$|\$")/ge;
+    $str =~ s/\^/&noremap("\$\\hat{\\hspace{0.4em}}\$")/ge;
+    $str =~ s/\~/&noremap("\$\\tilde{\\hspace{0.4em}}\$")/ge;
+    $str =~ s/\\/&noremap("\$\\backslash{}\$")/ge;
+    # characters need to be treated differently in TeX
+    # *
+    $str =~ s/[*]/&noremap("\$\\ast\$")/ge;
+    # escape < and > as math string,
+    $str =~ s/</&noremap("\$<\$")/ge;
+    $str =~ s/>/&noremap("\$>\$")/ge;
+    $str =~ tr/\200-\377/\000-\177/;		# put back
+    return $str;
+}
+
+sub internal_lrefs {
+    local($_) = shift;
+
+    s{L</([^>]+)>}{$1}g;
+    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
+    my $retstr = "the ";
+    my $i;
+    for ($i = 0; $i <= $#items; $i++) {
+	$retstr .= "C<$items[$i]>";
+	$retstr .= ", " if @items > 2 && $i != $#items;
+	$retstr .= " and " if $i+2 == @items;
+    }
+    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
+	    .  " elsewhere in this document";
+
+    return $retstr;
+}
+
+# map of HTML escapes to TeX escapes.
+BEGIN {
+%HTML_Escapes = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"\\'{A}",	#   capital A, acute accent
+    "aacute"	=>	"\\'{a}",	#   small a, acute accent
+    "Acirc"	=>	"\\^{A}",	#   capital A, circumflex accent
+    "acirc"	=>	"\\^{a}",	#   small a, circumflex accent
+    "AElig"	=>	'\\AE',		#   capital AE diphthong (ligature)
+    "aelig"	=>	'\\ae',		#   small ae diphthong (ligature)
+    "Agrave"	=>	"\\`{A}",	#   capital A, grave accent
+    "agrave"	=>	"\\`{a}",	#   small a, grave accent
+    "Aring"	=>	'\\u{A}',	#   capital A, ring
+    "aring"	=>	'\\u{a}',	#   small a, ring
+    "Atilde"	=>	'\\~{A}',	#   capital A, tilde
+    "atilde"	=>	'\\~{a}',	#   small a, tilde
+    "Auml"	=>	'\\"{A}',	#   capital A, dieresis or umlaut mark
+    "auml"	=>	'\\"{a}',	#   small a, dieresis or umlaut mark
+    "Ccedil"	=>	'\\c{C}',	#   capital C, cedilla
+    "ccedil"	=>	'\\c{c}',	#   small c, cedilla
+    "Eacute"	=>	"\\'{E}",	#   capital E, acute accent
+    "eacute"	=>	"\\'{e}",	#   small e, acute accent
+    "Ecirc"	=>	"\\^{E}",	#   capital E, circumflex accent
+    "ecirc"	=>	"\\^{e}",	#   small e, circumflex accent
+    "Egrave"	=>	"\\`{E}",	#   capital E, grave accent
+    "egrave"	=>	"\\`{e}",	#   small e, grave accent
+    "ETH"	=>	'\\OE',		#   capital Eth, Icelandic
+    "eth"	=>	'\\oe',		#   small eth, Icelandic
+    "Euml"	=>	'\\"{E}',	#   capital E, dieresis or umlaut mark
+    "euml"	=>	'\\"{e}',	#   small e, dieresis or umlaut mark
+    "Iacute"	=>	"\\'{I}",	#   capital I, acute accent
+    "iacute"	=>	"\\'{i}",	#   small i, acute accent
+    "Icirc"	=>	"\\^{I}",	#   capital I, circumflex accent
+    "icirc"	=>	"\\^{i}",	#   small i, circumflex accent
+    "Igrave"	=>	"\\`{I}",	#   capital I, grave accent
+    "igrave"	=>	"\\`{i}",	#   small i, grave accent
+    "Iuml"	=>	'\\"{I}',	#   capital I, dieresis or umlaut mark
+    "iuml"	=>	'\\"{i}',	#   small i, dieresis or umlaut mark
+    "Ntilde"	=>	'\\~{N}',	#   capital N, tilde
+    "ntilde"	=>	'\\~{n}',	#   small n, tilde
+    "Oacute"	=>	"\\'{O}",	#   capital O, acute accent
+    "oacute"	=>	"\\'{o}",	#   small o, acute accent
+    "Ocirc"	=>	"\\^{O}",	#   capital O, circumflex accent
+    "ocirc"	=>	"\\^{o}",	#   small o, circumflex accent
+    "Ograve"	=>	"\\`{O}",	#   capital O, grave accent
+    "ograve"	=>	"\\`{o}",	#   small o, grave accent
+    "Oslash"	=>	"\\O",		#   capital O, slash
+    "oslash"	=>	"\\o",		#   small o, slash
+    "Otilde"	=>	"\\~{O}",	#   capital O, tilde
+    "otilde"	=>	"\\~{o}",	#   small o, tilde
+    "Ouml"	=>	'\\"{O}',	#   capital O, dieresis or umlaut mark
+    "ouml"	=>	'\\"{o}',	#   small o, dieresis or umlaut mark
+    "szlig"	=>	'\\ss',		#   small sharp s, German (sz ligature)
+    "THORN"	=>	'\\L',		#   capital THORN, Icelandic
+    "thorn"	=>	'\\l',,		#   small thorn, Icelandic
+    "Uacute"	=>	"\\'{U}",	#   capital U, acute accent
+    "uacute"	=>	"\\'{u}",	#   small u, acute accent
+    "Ucirc"	=>	"\\^{U}",	#   capital U, circumflex accent
+    "ucirc"	=>	"\\^{u}",	#   small u, circumflex accent
+    "Ugrave"	=>	"\\`{U}",	#   capital U, grave accent
+    "ugrave"	=>	"\\`{u}",	#   small u, grave accent
+    "Uuml"	=>	'\\"{U}',	#   capital U, dieresis or umlaut mark
+    "uuml"	=>	'\\"{u}',	#   small u, dieresis or umlaut mark
+    "Yacute"	=>	"\\'{Y}",	#   capital Y, acute accent
+    "yacute"	=>	"\\'{y}",	#   small y, acute accent
+    "yuml"	=>	'\\"{y}',	#   small y, dieresis or umlaut mark
+);
+}
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/pod/pod2man.PL b/gnu/usr.bin/perl/pod/pod2man.PL
new file mode 100644
index 00000000000..d8f7cbb716c
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/pod2man.PL
@@ -0,0 +1,1083 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+eval 'exec perl -S $0 "$@"'
+    if 0;
+
+=head1 NAME
+
+pod2man - translate embedded Perl pod directives into man pages
+
+=head1 SYNOPSIS
+
+B<pod2man>
+[ B<--section=>I<manext> ]
+[ B<--release=>I<relpatch> ]
+[ B<--center=>I<string> ]
+[ B<--date=>I<string> ]
+[ B<--fixed=>I<font> ]
+[ B<--official> ]
+I<inputfile>
+
+=head1 DESCRIPTION
+
+B<pod2man> converts its input file containing embedded pod directives (see
+L<perlpod>) into nroff source suitable for viewing with nroff(1) or
+troff(1) using the man(7) macro set.
+
+Besides the obvious pod conversions, B<pod2man> also takes care of
+func(), func(n), and simple variable references like $foo or @bar so
+you don't have to use code escapes for them; complex expressions like
+C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
+little roffish things that it catches include translating the minus in
+something like foo-bar, making a long dash--like this--into a real em
+dash, fixing up "paired quotes", putting a little space after the
+parens in something like func(), making C++ and PI look right, making
+double underbars have a little tiny space between them, making ALLCAPS
+a teeny bit smaller in troff(1), and escaping backslashes so you don't
+have to.
+
+=head1 OPTIONS
+
+=over 8
+
+=item center
+
+Set the centered header to a specific string.  The default is
+"User Contributed Perl Documentation", unless the C<--official> flag is
+given, in which case the default is "Perl Programmers Reference Guide".
+
+=item date
+
+Set the left-hand footer string to this value.  By default,
+the modification date of the input file will be used.
+
+=item fixed
+
+The fixed font to use for code refs.  Defaults to CW.
+
+=item official
+
+Set the default header to indicate that this page is of
+the standard release in case C<--center> is not given.
+
+=item release
+
+Set the centered footer.  By default, this is the current
+perl release.
+
+=item section
+
+Set the section for the C<.TH> macro.  The standard conventions on
+sections are to use 1 for user commands,  2 for system calls, 3 for
+functions, 4 for devices, 5 for file formats, 6 for games, 7 for
+miscellaneous information, and 8 for administrator commands.  This works
+best if you put your Perl man pages in a separate tree, like
+F</usr/local/perl/man/>.  By default, section 1 will be used
+unless the file ends in F<.pm> in which case section 3 will be selected.
+
+=back
+
+=head1 Anatomy of a Proper Man Page
+
+For those not sure of the proper layout of a man page, here's
+an example of the skeleton of a proper man page.  Head of the
+major headers should be setout as a C<=head1> directive, and
+are historically written in the rather startling ALL UPPER CASE
+format, although this is not mandatory.
+Minor headers may be included using C<=head2>, and are
+typically in mixed case.
+
+=over 10
+
+=item NAME
+
+Mandatory section; should be a comma-separated list of programs or
+functions documented by this podpage, such as:
+
+    foo, bar - programs to do something
+
+=item SYNOPSIS
+
+A short usage summary for programs and functions, which
+may someday be deemed mandatory.
+
+=item DESCRIPTION
+
+Long drawn out discussion of the program.  It's a good idea to break this
+up into subsections using the C<=head2> directives, like
+
+    =head2 A Sample Subection
+
+    =head2 Yet Another Sample Subection
+
+=item OPTIONS
+
+Some people make this separate from the description.
+
+=item RETURN VALUE
+
+What the program or function returns if successful.
+
+=item ERRORS
+
+Exceptions, return codes, exit stati, and errno settings.
+
+=item EXAMPLES
+
+Give some example uses of the program.
+
+=item ENVIRONMENT
+
+Envariables this program might care about.
+
+=item FILES
+
+All files used by the program.  You should probably use the FE<lt>E<gt>
+for these.
+
+=item SEE ALSO
+
+Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
+
+=item NOTES
+
+Miscellaneous commentary.
+
+=item CAVEATS
+
+Things to take special care with; sometimes called WARNINGS.
+
+=item DIAGNOSTICS
+
+All possible messages the program can print out--and
+what they mean.
+
+=item BUGS
+
+Things that are broken or just don't work quite right.
+
+=item RESTRICTIONS
+
+Bugs you don't plan to fix :-)
+
+=item AUTHOR
+
+Who wrote it (or AUTHORS if multiple).
+
+=item HISTORY
+
+Programs derived from other sources sometimes have this, or
+you might keep a modification long here.
+
+=back
+
+=head1 EXAMPLES
+
+    pod2man program > program.1
+    pod2man some_module.pm > /usr/perl/man/man3/some_module.3
+    pod2man --section=7 note.pod > note.7
+
+=head1 DIAGNOSTICS
+
+The following diagnostics are generated by B<pod2man>.  Items
+marked "(W)" are non-fatal, whereas the "(F)" errors will cause
+B<pod2man> to immediately exit with a non-zero status.
+
+=over 4
+
+=item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
+
+(W) If you start include an option, you should set it off
+as bold, italic, or code.
+
+=item can't open %s: %s
+
+(F) The input file wasn't available for the given reason.
+
+=item high bit char in input stream
+
+(W) You can't use high-bit characters in the input stream,
+because the translator uses them for its own nefarious purposes.
+Use an HTML entity in angle brackets instead.
+
+=item Improper man page - no dash in NAME header in paragraph %d of %s
+
+(W) The NAME header did not have an isolated dash in it.  This is
+considered important.
+
+=item Invalid man page - no NAME line in %s
+
+(F) You did not include a NAME header, which is essential.
+
+=item roff font should be 1 or 2 chars, not `%s'  (F)
+
+(F) The font specified with the C<--fixed> option was not
+a one- or two-digit roff font.
+
+=item %s is missing required section: %s
+
+(W) Required sections include NAME, DESCRIPTION, and if you're
+using a section starting with a 3, also a SYNOPSIS.  Actually,
+not having a NAME is a fatal.
+
+=item Unknown escape: %s in %s
+
+(W) An unknown HTML entity (probably for an 8-bit character) was given via
+a C<E<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
+entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
+Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
+Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
+icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
+ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
+THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
+Yacute, yacute, and yuml.
+
+=item Unmatched =back
+
+(W) You have a C<=back> without a corresponding C<=over>.
+
+=item Unrecognized pod directive: %s
+
+(W) You specified a pod directive that isn't in the known list of
+C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
+
+
+=back
+
+=head1 NOTES
+
+If you would like to print out a lot of man page continuously, you
+probably want to set the C and D registers to set contiguous page
+numbering and even/odd paging, at least one some versions of man(7).
+Settting the F register will get you some additional experimental
+indexing:
+
+    troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
+
+The indexing merely outputs messages via C<.tm> for each
+major page, section, subsection, item, and any C<XE<lt>E<gt>>
+directives.
+
+
+=head1 RESTRICTIONS
+
+You shouldn't use 8-bit characters in the input stream, as these
+will be used by the translator.
+
+=head1 BUGS
+
+The =over and =back directives don't really work right.  They
+take absolute positions instead of offsets, don't nest well, and
+making people count is suboptimal in any event.
+
+=head1 AUTHORS
+
+Original prototype by Larry Wall, but so massively hacked over by
+Tom Christiansen such that Larry probably doesn't recognize it anymore.
+
+=cut
+
+$/ = "";
+$cutting = 1;
+
+($version,$patch) = `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3}(?: +)(?:\S+)?)(?:.*patchlevel (\d\S*))?/s;
+$DEF_RELEASE  = "perl $version";
+$DEF_RELEASE .= ", patch $patch" if $patch;
+
+
+sub makedate {
+    my $secs = shift;
+    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
+    my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
+    return "$mday/$mname/$year";
+}
+
+use Getopt::Long;
+
+$DEF_SECTION = 1;
+$DEF_CENTER = "User Contributed Perl Documentation";
+$STD_CENTER = "Perl Programmers Reference Guide";
+$DEF_FIXED = 'CW';
+
+sub usage {
+    warn "$0: @_\n" if @_;
+    die <<EOF;
+usage: $0 [options] podpage
+Options are:
+	--section=manext      (default "$DEF_SECTION")
+	--release=relpatch    (default "$DEF_RELEASE")
+	--center=string       (default "$DEF_CENTER")
+	--date=string         (default "$DEF_DATE")
+	--fixed=font	      (default "$DEF_FIXED")
+	--official	      (default NOT)
+EOF
+}
+
+$uok = GetOptions( qw(
+	section=s
+	release=s
+	center=s
+	date=s
+	fixed=s
+	official
+	help));
+
+$DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
+
+usage("Usage error!") unless $uok;
+usage() if $opt_help;
+usage("Need one and only one podpage argument") unless @ARGV == 1;
+
+$section = $opt_section || ($ARGV[0] =~ /\.pm$/ ? 3 : $DEF_SECTION);
+$RP = $opt_release || $DEF_RELEASE;
+$center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
+
+$CFont = $opt_fixed || $DEF_FIXED;
+
+if (length($CFont) == 2) {
+    $CFont_embed = "\\f($CFont";
+}
+elsif (length($CFont) == 1) {
+    $CFont_embed = "\\f$CFont";
+}
+else {
+    die "roff font should be 1 or 2 chars, not `$CFont_embed'";
+}
+
+$section = $opt_section || $DEF_SECTION;
+$date = $opt_date || $DEF_DATE;
+
+for (qw{NAME DESCRIPTION}) {
+# for (qw{NAME DESCRIPTION AUTHOR}) {
+    $wanna_see{$_}++;
+}
+$wanna_see{SYNOPSIS}++ if $section =~ /^3/;
+
+
+$name = @ARGV ? $ARGV[0] : "<STDIN>";
+$Filename = $name;
+$name = uc($name) if $section =~ /^1/;
+$name =~ s/\.[^.]*$//;
+
+if ($name ne 'something') {
+    FCHECK: {
+	open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
+	while (<F>) {
+	    next unless /^=\b/;
+	    if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
+		$_ = <F>;
+		unless (/\s*-+\s+/) {
+		    $oops++;
+		    warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
+		}
+		%namedesc = split /\s+-\s+/;
+		last FCHECK;
+	    }
+	    next if /^=cut\b/;	# DB_File and Net::Ping have =cut before NAME
+	    die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n";
+	}
+	die "$0: Invalid man page - no documentation in $ARGV[0]\n";
+    }
+    close F;
+}
+
+print <<"END";
+.rn '' }`
+''' \$RCSfile\$\$Revision\$\$Date\$
+'''
+''' \$Log\$
+'''
+.de Sh
+.br
+.if t .Sp
+.ne 5
+.PP
+\\fB\\\\\$1\\fR
+.PP
+..
+.de Sp
+.if t .sp .5v
+.if n .sp
+..
+.de Ip
+.br
+.ie \\\\n(.\$>=3 .ne \\\\\$3
+.el .ne 3
+.IP "\\\\\$1" \\\\\$2
+..
+.de Vb
+.ft $CFont
+.nf
+.ne \\\\\$1
+..
+.de Ve
+.ft R
+
+.fi
+..
+'''
+'''
+'''     Set up \\*(-- to give an unbreakable dash;
+'''     string Tr holds user defined translation string.
+'''     Bell System Logo is used as a dummy character.
+'''
+.tr \\(*W-|\\(bv\\*(Tr
+.ie n \\{\\
+.ds -- \\(*W-
+.ds PI pi
+.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
+.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
+.ds L" ""
+.ds R" ""
+.ds L' '
+.ds R' '
+'br\\}
+.el\\{\\
+.ds -- \\(em\\|
+.tr \\*(Tr
+.ds L" ``
+.ds R" ''
+.ds L' `
+.ds R' '
+.ds PI \\(*p
+'br\\}
+END
+
+print <<'END';
+.\"	If the F register is turned on, we'll generate
+.\"	index entries out stderr for the following things:
+.\"		TH	Title 
+.\"		SH	Header
+.\"		Sh	Subsection 
+.\"		Ip	Item
+.\"		X<>	Xref  (embedded
+.\"	Of course, you have to process the output yourself
+.\"	in some meaninful fashion.
+.if \nF \{
+.de IX
+.tm Index:\\$1\t\\n%\t"\\$2"
+..
+.nr % 0
+.rr F
+.\}
+END
+
+print <<"END";
+.TH $name $section "$RP" "$date" "$center"
+.IX Title "$name $section"
+.UC
+END
+
+while (($name, $desc) = each %namedesc) {
+    for ($name, $desc) { s/^\s+//; s/\s+$//; }
+    print qq(.IX Name "$name - $desc"\n);
+}
+
+print <<'END';
+.if n .hy 0
+.if n .na
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.de CQ          \" put $1 in typewriter font
+END
+print ".ft $CFont\n";
+print <<'END';
+'if n "\c
+'if t \\&\\$1\c
+'if n \\&\\$1\c
+'if n \&"
+\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
+'.ft R
+..
+.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
+.	\" AM - accent mark definitions
+.bd B 3
+.	\" fudge factors for nroff and troff
+.if n \{\
+.	ds #H 0
+.	ds #V .8m
+.	ds #F .3m
+.	ds #[ \f1
+.	ds #] \fP
+.\}
+.if t \{\
+.	ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+.	ds #V .6m
+.	ds #F 0
+.	ds #[ \&
+.	ds #] \&
+.\}
+.	\" simple accents for nroff and troff
+.if n \{\
+.	ds ' \&
+.	ds ` \&
+.	ds ^ \&
+.	ds , \&
+.	ds ~ ~
+.	ds ? ?
+.	ds ! !
+.	ds /
+.	ds q
+.\}
+.if t \{\
+.	ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+.	ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+.	ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+.	ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+.	ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+.	ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
+.	ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
+.	ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.	ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
+.\}
+.	\" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
+.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
+.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
+.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+.ds oe o\h'-(\w'o'u*4/10)'e
+.ds Oe O\h'-(\w'O'u*4/10)'E
+.	\" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+.	\" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+.	ds : e
+.	ds 8 ss
+.	ds v \h'-1'\o'\(aa\(ga'
+.	ds _ \h'-1'^
+.	ds . \h'-1'.
+.	ds 3 3
+.	ds o a
+.	ds d- d\h'-1'\(ga
+.	ds D- D\h'-1'\(hy
+.	ds th \o'bp'
+.	ds Th \o'LP'
+.	ds ae ae
+.	ds Ae AE
+.	ds oe oe
+.	ds Oe OE
+.\}
+.rm #[ #] #H #V #F C
+END
+
+$indent = 0;
+
+while (<>) {
+    if ($cutting) {
+	next unless /^=/;
+	$cutting = 0;
+    }
+    chomp;
+
+    # Translate verbatim paragraph
+
+    if (/^\s/) {
+	@lines = split(/\n/);
+	for (@lines) {
+	    1 while s
+		{^( [^\t]* ) \t ( \t* ) }
+		{ $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
+	    s/\\/\\e/g;
+	    s/\A/\\&/s;
+	}
+	$lines = @lines;
+	makespace() unless $verbatim++;
+	print ".Vb $lines\n";
+	print join("\n", @lines), "\n";
+	print ".Ve\n";
+	$needspace = 0;
+	next;
+    }
+
+    $verbatim = 0;
+
+    # check for things that'll hosed our noremap scheme; affects $_
+    init_noremap();
+
+    if (!/^=item/) {
+
+	# trofficate backslashes; must do it before what happens below
+	s/\\/noremap('\\e')/ge;
+
+	# first hide the escapes in case we need to
+	# intuit something and get it wrong due to fmting
+
+	s/([A-Z]<[^<>]*>)/noremap($1)/ge;
+
+	# func() is a reference to a perl function
+	s{
+	    \b
+	    (
+		[:\w]+ \(\)
+	    )
+	} {I<$1>}gx;
+
+	# func(n) is a reference to a man page
+	s{
+	    (\w+)
+	    (
+		\(
+		    [^\s,\051]+
+		\)
+	    )
+	} {I<$1>\\|$2}gx;
+
+	# convert simple variable references
+	s/(\s+)([\$\@%][\w:]+)/${1}C<$2>/g;
+
+	if (m{ (
+		    [\-\w]+
+		    \(
+			[^\051]*?
+			[\@\$,]
+			[^\051]*?
+		    \)
+		)
+	    }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
+	{
+	    warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
+	    $oops++;
+	}
+
+	while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
+	    warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
+	    $oops++;
+	}
+
+	# put it back so we get the <> processed again;
+	clear_noremap(0); # 0 means leave the E's
+
+    } else {
+	# trofficate backslashes
+	s/\\/noremap('\\e')/ge;
+
+    }
+
+    # need to hide E<> first; they're processed in clear_noremap
+    s/(E<[^<>]+>)/noremap($1)/ge;
+
+
+    $maxnest = 10;
+    while ($maxnest-- && /[A-Z]</) {
+
+	# can't do C font here
+	s/([BI])<([^<>]*)>/font($1) . $2 . font('R')/eg;
+
+	# files and filelike refs in italics
+	s/F<([^<>]*)>/I<$1>/g;
+
+	# no break -- usually we want C<> for this
+	s/S<([^<>]*)>/nobreak($1)/eg;
+
+	# LREF: a manpage(3f)
+	s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
+
+	# LREF: an =item on another manpage
+	s{
+	    L<
+		([^/]+)
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	} {the C<$2> entry in the I<$1> manpage}gx;
+
+	# LREF: an =item on this manpage
+	s{
+	   ((?:
+	    L<
+		/
+		(
+		    [:\w]+
+		    (\(\))?
+		)
+	    >
+	    (,?\s+(and\s+)?)?
+	  )+)
+	} { internal_lrefs($1) }gex;
+
+	# LREF: a =head2 (head1?), maybe on a manpage, maybe right here
+	# the "func" can disambiguate
+	s{
+	    L<
+		(?:
+		    ([a-zA-Z]\S+?) /
+		)?
+		"?(.*?)"?
+	    >
+	}{
+	    do {
+		$1 	# if no $1, assume it means on this page.
+		    ?  "the section on I<$2> in the I<$1> manpage"
+		    :  "the section on I<$2>"
+	    }
+	}gex;
+
+	s/Z<>/\\&/g;
+
+	# comes last because not subject to reprocessing
+	s/C<([^<>]*)>/noremap("${CFont_embed}${1}\\fR")/eg;
+    }
+
+    if (s/^=//) {
+	$needspace = 0;		# Assume this.
+
+	s/\n/ /g;
+
+	($Cmd, $_) = split(' ', $_, 2);
+
+	if (defined $_) {
+	    &escapes;
+	    s/"/""/g;
+	}
+
+	clear_noremap(1);
+
+	if ($Cmd eq 'cut') {
+	    $cutting = 1;
+	}
+	elsif ($Cmd eq 'head1') {
+	    s/\s+$//;
+	    delete $wanna_see{$_} if exists $wanna_see{$_};
+	    print qq{.SH "$_"\n};
+	    print qq{.IX Header "$_"\n};
+	}
+	elsif ($Cmd eq 'head2') {
+	    print qq{.Sh "$_"\n};
+	    print qq{.IX Subsection "$_"\n};
+	}
+	elsif ($Cmd eq 'over') {
+	    push(@indent,$indent);
+	    $indent += ($_ + 0) || 5;
+	}
+	elsif ($Cmd eq 'back') {
+	    $indent = pop(@indent);
+	    warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
+	    $needspace = 1;
+	}
+	elsif ($Cmd eq 'item') {
+	    s/^\*( |$)/\\(bu$1/g;
+	    print STDOUT qq{.Ip "$_" $indent\n};
+	    print qq{.IX Item "$_"\n};
+	}
+	elsif ($Cmd eq 'pod') {
+	    # this is just a comment
+	} 
+	else {
+	    warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
+	}
+    }
+    else {
+	if ($needspace) {
+	    &makespace;
+	}
+	&escapes;
+	clear_noremap(1);
+	print $_, "\n";
+	$needspace = 1;
+    }
+}
+
+print <<"END";
+
+.rn }` ''
+END
+
+if (%wanna_see) {
+    @missing = keys %wanna_see;
+    warn "$0: $Filename is missing required section"
+	.  (@missing > 1 && "s")
+	.  ": @missing\n";
+    $oops++;
+}
+
+exit;
+#exit ($oops != 0);
+
+#########################################################################
+
+sub nobreak {
+    my $string = shift;
+    $string =~ s/ /\\ /g;
+    $string;
+}
+
+sub escapes {
+
+    s/X<(.*?)>/mkindex($1)/ge;
+
+    # translate the minus in foo-bar into foo\-bar for roff
+    s/([^0-9a-z-])-([^-])/$1\\-$2/g;
+
+    # make -- into the string version \*(-- (defined above)
+    s/\b--\b/\\*(--/g;
+    s/"--([^"])/"\\*(--$1/g;  # should be a better way
+    s/([^"])--"/$1\\*(--"/g;
+
+    # fix up quotes; this is somewhat tricky
+    if (!/""/) {
+	s/(^|\s)(['"])/noremap("$1\\*(L$2")/ge;
+	s/(['"])($|[\-\s,;\\!?.])/noremap("\\*(R$1$2")/ge;
+    }
+
+    #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
+    #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
+
+
+    # make sure that func() keeps a bit a space tween the parens
+    ### s/\b\(\)/\\|()/g;
+    ### s/\b\(\)/(\\|)/g;
+
+    # make C++ into \*C+, which is a squinched version (defined above)
+    s/\bC\+\+/\\*(C+/g;
+
+    # make double underbars have a little tiny space between them
+    s/__/_\\|_/g;
+
+    # PI goes to \*(PI (defined above)
+    s/\bPI\b/noremap('\\*(PI')/ge;
+
+    # make all caps a teeny bit smaller, but don't muck with embedded code literals
+    my $hidCFont = font('C');
+    if ($Cmd !~ /^head1/) { # SH already makes smaller
+	# /g isn't enough; 1 while or we'll be off
+
+#	1 while s{
+#	    (?!$hidCFont)(..|^.|^)
+#	    \b
+#	    (
+#		[A-Z][\/A-Z+:\-\d_$.]+
+#	    )
+#	    (s?) 		
+#	    \b
+#	} {$1\\s-1$2\\s0}gmox;
+
+	1 while s{
+	    (?!$hidCFont)(..|^.|^)
+	    (
+		\b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
+	    )
+	} {
+	    $1 . noremap( '\\s-1' .  $2 . '\\s0' )
+	}egmox;
+
+    }
+}
+
+# make troff just be normal, but make small nroff get quoted
+# decided to just put the quotes in the text; sigh;
+sub ccvt {
+     local($_,$prev) = @_;
+     if ( /^\W+$/ && !/^\$./ ) {
+ 	($prev && "\n") . noremap(qq{.CQ $_ \n\\&});
+ 	# what about $" ?
+     } else {
+ 	noremap(qq{${CFont_embed}$_\\fR});
+     }
+    noremap(qq{.CQ "$_" \n\\&});
+}
+
+sub makespace {
+    if ($indent) {
+	print ".Sp\n";
+    }
+    else {
+	print ".PP\n";
+    }
+}
+
+sub mkindex {
+    my ($entry) = @_;
+    my @entries = split m:\s*/\s*:, $entry;
+    print ".IX Xref ";
+    for $entry (@entries) {
+	print qq("$entry" );
+    }
+    print "\n";
+    return '';
+}
+
+sub font {
+    local($font) = shift;
+    return '\\f' . noremap($font);
+}
+
+sub noremap {
+    local($thing_to_hide) = shift;
+    $thing_to_hide =~ tr/\000-\177/\200-\377/;
+    return $thing_to_hide;
+}
+
+sub init_noremap {
+    if ( /[\200-\377]/ ) {
+	warn "$0: high bit char in input stream in paragraph $. of $ARGV\n";
+    }
+}
+
+sub clear_noremap {
+    my $ready_to_print = $_[0];
+
+    tr/\200-\377/\000-\177/;
+
+    # trofficate backslashes
+    # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
+
+    # now for the E<>s, which have been hidden until now
+    # otherwise the interative \w<> processing would have
+    # been hosed by the E<gt>
+    s {
+	    E<	
+	    ( [A-Za-z]+ )	
+	    >	
+    } {
+	 do {	
+	     exists $HTML_Escapes{$1}
+		? do { $HTML_Escapes{$1} }
+		: do {
+		    warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
+		    "E<$1>";
+		}
+	 }
+    }egx if $ready_to_print;
+}
+
+sub internal_lrefs {
+    local($_) = shift;
+
+    s{L</([^>]+)>}{$1}g;
+    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
+    my $retstr = "the ";
+    my $i;
+    for ($i = 0; $i <= $#items; $i++) {
+	$retstr .= "C<$items[$i]>";
+	$retstr .= ", " if @items > 2 && $i != $#items;
+	$retstr .= " and " if $i+2 == @items;
+    }
+
+    $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
+	    .  " elsewhere in this document";
+
+    return $retstr;
+
+}
+
+BEGIN {
+%HTML_Escapes = (
+    'amp'	=>	'&',	#   ampersand
+    'lt'	=>	'<',	#   left chevron, less-than
+    'gt'	=>	'>',	#   right chevron, greater-than
+    'quot'	=>	'"',	#   double quote
+
+    "Aacute"	=>	"A\\*'",	#   capital A, acute accent
+    "aacute"	=>	"a\\*'",	#   small a, acute accent
+    "Acirc"	=>	"A\\*^",	#   capital A, circumflex accent
+    "acirc"	=>	"a\\*^",	#   small a, circumflex accent
+    "AElig"	=>	'\*(AE',	#   capital AE diphthong (ligature)
+    "aelig"	=>	'\*(ae',	#   small ae diphthong (ligature)
+    "Agrave"	=>	"A\\*`",	#   capital A, grave accent
+    "agrave"	=>	"A\\*`",	#   small a, grave accent
+    "Aring"	=>	'A\\*o',	#   capital A, ring
+    "aring"	=>	'a\\*o',	#   small a, ring
+    "Atilde"	=>	'A\\*~',	#   capital A, tilde
+    "atilde"	=>	'a\\*~',	#   small a, tilde
+    "Auml"	=>	'A\\*:',	#   capital A, dieresis or umlaut mark
+    "auml"	=>	'a\\*:',	#   small a, dieresis or umlaut mark
+    "Ccedil"	=>	'C\\*,',	#   capital C, cedilla
+    "ccedil"	=>	'c\\*,',	#   small c, cedilla
+    "Eacute"	=>	"E\\*'",	#   capital E, acute accent
+    "eacute"	=>	"e\\*'",	#   small e, acute accent
+    "Ecirc"	=>	"E\\*^",	#   capital E, circumflex accent
+    "ecirc"	=>	"e\\*^",	#   small e, circumflex accent
+    "Egrave"	=>	"E\\*`",	#   capital E, grave accent
+    "egrave"	=>	"e\\*`",	#   small e, grave accent
+    "ETH"	=>	'\\*(D-',	#   capital Eth, Icelandic
+    "eth"	=>	'\\*(d-',	#   small eth, Icelandic
+    "Euml"	=>	"E\\*:",	#   capital E, dieresis or umlaut mark
+    "euml"	=>	"e\\*:",	#   small e, dieresis or umlaut mark
+    "Iacute"	=>	"I\\*'",	#   capital I, acute accent
+    "iacute"	=>	"i\\*'",	#   small i, acute accent
+    "Icirc"	=>	"I\\*^",	#   capital I, circumflex accent
+    "icirc"	=>	"i\\*^",	#   small i, circumflex accent
+    "Igrave"	=>	"I\\*`",	#   capital I, grave accent
+    "igrave"	=>	"i\\*`",	#   small i, grave accent
+    "Iuml"	=>	"I\\*:",	#   capital I, dieresis or umlaut mark
+    "iuml"	=>	"i\\*:",	#   small i, dieresis or umlaut mark
+    "Ntilde"	=>	'N\*~',		#   capital N, tilde
+    "ntilde"	=>	'n\*~',		#   small n, tilde
+    "Oacute"	=>	"O\\*'",	#   capital O, acute accent
+    "oacute"	=>	"o\\*'",	#   small o, acute accent
+    "Ocirc"	=>	"O\\*^",	#   capital O, circumflex accent
+    "ocirc"	=>	"o\\*^",	#   small o, circumflex accent
+    "Ograve"	=>	"O\\*`",	#   capital O, grave accent
+    "ograve"	=>	"o\\*`",	#   small o, grave accent
+    "Oslash"	=>	"O\\*/",	#   capital O, slash
+    "oslash"	=>	"o\\*/",	#   small o, slash
+    "Otilde"	=>	"O\\*~",	#   capital O, tilde
+    "otilde"	=>	"o\\*~",	#   small o, tilde
+    "Ouml"	=>	"O\\*:",	#   capital O, dieresis or umlaut mark
+    "ouml"	=>	"o\\*:",	#   small o, dieresis or umlaut mark
+    "szlig"	=>	'\*8',		#   small sharp s, German (sz ligature)
+    "THORN"	=>	'\\*(Th',	#   capital THORN, Icelandic
+    "thorn"	=>	'\\*(th',,	#   small thorn, Icelandic
+    "Uacute"	=>	"U\\*'",	#   capital U, acute accent
+    "uacute"	=>	"u\\*'",	#   small u, acute accent
+    "Ucirc"	=>	"U\\*^",	#   capital U, circumflex accent
+    "ucirc"	=>	"u\\*^",	#   small u, circumflex accent
+    "Ugrave"	=>	"U\\*`",	#   capital U, grave accent
+    "ugrave"	=>	"u\\*`",	#   small u, grave accent
+    "Uuml"	=>	"U\\*:",	#   capital U, dieresis or umlaut mark
+    "uuml"	=>	"u\\*:",	#   small u, dieresis or umlaut mark
+    "Yacute"	=>	"Y\\*'",	#   capital Y, acute accent
+    "yacute"	=>	"y\\*'",	#   small y, acute accent
+    "yuml"	=>	"y\\*:",	#   small y, dieresis or umlaut mark
+);
+}
+
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/pod/pod2text.PL b/gnu/usr.bin/perl/pod/pod2text.PL
new file mode 100644
index 00000000000..49198078c00
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/pod2text.PL
@@ -0,0 +1,49 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+use Pod::Text;
+
+if(@ARGV) {
+	pod2text($ARGV[0]);
+} else {
+	pod2text("<&STDIN");
+}
+
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/pod/roffitall b/gnu/usr.bin/perl/pod/roffitall
new file mode 100644
index 00000000000..024279a69ea
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/roffitall
@@ -0,0 +1,84 @@
+#!/bin/sh
+#psroff -t -man -rC1 -rD1 -rF1 > /tmp/PerlDoc.ps 2>/tmp/PerlTOC.raw \
+nroff -man -rC1 -rD1 -rF1 > /tmp/PerlDoc.txt 2>/tmp/PerlTOC.nr.raw \
+    /usr/local/man/man1/perl.1	\
+    /usr/local/man/man1/perldata.1	\
+    /usr/local/man/man1/perlsyn.1	\
+    /usr/local/man/man1/perlop.1	\
+    /usr/local/man/man1/perlre.1	\
+    /usr/local/man/man1/perlrun.1	\
+    /usr/local/man/man1/perlfunc.1	\
+    /usr/local/man/man1/perlvar.1	\
+    /usr/local/man/man1/perlsub.1	\
+    /usr/local/man/man1/perlmod.1	\
+    /usr/local/man/man1/perlref.1	\
+    /usr/local/man/man1/perldsc.1	\
+    /usr/local/man/man1/perllol.1	\
+    /usr/local/man/man1/perlobj.1	\
+    /usr/local/man/man1/perltie.1	\
+    /usr/local/man/man1/perlbot.1	\
+    /usr/local/man/man1/perldebug.1	\
+    /usr/local/man/man1/perldiag.1	\
+    /usr/local/man/man1/perlform.1	\
+    /usr/local/man/man1/perlipc.1	\
+    /usr/local/man/man1/perlsec.1	\
+    /usr/local/man/man1/perltrap.1	\
+    /usr/local/man/man1/perlstyle.1	\
+    /usr/local/man/man1/perlxs.1	\
+    /usr/local/man/man1/perlxstut.1	\
+    /usr/local/man/man1/perlguts.1	\
+    /usr/local/man/man1/perlcall.1	\
+    /usr/local/man/man1/perlembed.1	\
+    /usr/local/man/man1/perlpod.1	\
+    /usr/local/man/man1/perlbook.1	\
+	\
+    /usr/local/man/man3/diagnostics.3	\
+    /usr/local/man/man3/integer.3	\
+    /usr/local/man/man3/less.3	\
+    /usr/local/man/man3/lib.3	\
+    /usr/local/man/man3/overload.3	\
+    /usr/local/man/man3/sigtrap.3	\
+    /usr/local/man/man3/strict.3	\
+    /usr/local/man/man3/subs.3	\
+	\
+    /usr/local/man/man3/AnyDBM_File.3	\
+    /usr/local/man/man3/AutoLoader.3	\
+    /usr/local/man/man3/AutoSplit.3	\
+    /usr/local/man/man3/Benchmark.3	\
+    /usr/local/man/man3/Carp.3	\
+    /usr/local/man/man3/Config.3	\
+    /usr/local/man/man3/Cwd.3	\
+    /usr/local/man/man3/DB_File.3	\
+    /usr/local/man/man3/Devel::SelfStubber.3	\
+    /usr/local/man/man3/DynaLoader.3	\
+    /usr/local/man/man3/English.3	\
+    /usr/local/man/man3/Env.3	\
+    /usr/local/man/man3/Exporter.3	\
+    /usr/local/man/man3/ExtUtils::Liblist.3	\
+    /usr/local/man/man3/ExtUtils::MakeMaker.3	\
+    /usr/local/man/man3/ExtUtils::Manifest.3	\
+    /usr/local/man/man3/ExtUtils::Mkbootstrap.3	\
+    /usr/local/man/man3/Fcntl.3	\
+    /usr/local/man/man3/File::Basename.3	\
+    /usr/local/man/man3/File::CheckTree.3	\
+    /usr/local/man/man3/File::Find.3	\
+    /usr/local/man/man3/FileHandle.3	\
+    /usr/local/man/man3/File::Path.3	\
+    /usr/local/man/man3/Getopt::Long.3	\
+    /usr/local/man/man3/Getopt::Std.3	\
+    /usr/local/man/man3/I18N::Collate.3	\
+    /usr/local/man/man3/IPC::Open2.3	\
+    /usr/local/man/man3/IPC::Open3.3	\
+    /usr/local/man/man3/Net::Ping.3	\
+    /usr/local/man/man3/POSIX.3	\
+    /usr/local/man/man3/Safe.3	\
+    /usr/local/man/man3/SelfLoader.3	\
+    /usr/local/man/man3/Socket.3	\
+    /usr/local/man/man3/Sys::Hostname.3	\
+    /usr/local/man/man3/Term::Cap.3	\
+    /usr/local/man/man3/Term::Complete.3	\
+    /usr/local/man/man3/Test::Harness.3	\
+    /usr/local/man/man3/Text::Abbrev.3	\
+    /usr/local/man/man3/Text::Soundex.3	\
+    /usr/local/man/man3/TieHash.3	\
+    /usr/local/man/man3/Time::Local.3	
diff --git a/gnu/usr.bin/perl/pod/splitman b/gnu/usr.bin/perl/pod/splitman
new file mode 100644
index 00000000000..9fe404a0610
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/splitman
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+while (<>) {
+    if ($seqno = 1 .. /^\.TH/) {
+	unless ($seqno =~ /e/i) {
+	    $header .= $_;
+	} 
+	next;
+    } 
+
+    if ( /^\.Ip\s*"(.*)"\s*\d+$/) {
+	$desking = 0;
+	$desc = $1;
+	if (name($desc) ne $myname) {
+	    $myname = name($desc);
+	    print $myname, "\n";
+	    open(MAN, "> $myname.3pl");
+	    print MAN <<EOALL;
+$header
+.TH $myname 3PL "\\*(RP"
+.SH NAME 
+$myname
+.SH SYNOPSIS 
+.B $desc
+EOALL
+	} else {
+	    print MAN <<EOMORE;
+.br
+.ti +3n
+or
+.br
+.B $desc
+EOMORE
+	} 
+	next;
+    } 
+    unless ($desking) {
+	print MAN ".SH DESCRIPTION\n";
+	$desking = 1;
+    } 
+    print MAN;
+} 
+
+sub name {
+    ($_[0] =~ /(\w+)/)[0];
+} 
diff --git a/gnu/usr.bin/perl/pod/splitpod b/gnu/usr.bin/perl/pod/splitpod
new file mode 100644
index 00000000000..8db40603706
--- /dev/null
+++ b/gnu/usr.bin/perl/pod/splitpod
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+use lib '../lib';  # If you haven't installed perl yet.
+use Pod::Functions;
+
+local $/ = '';
+
+$cur = '';
+while (<>) {
+
+    next unless /^=(?!cut)/ .. /^=cut/;
+
+    if (s/=item (\S+)/$1/) {
+	#$cur = "POSIX::" . $1;
+	$cur = $1;
+	$syn{$cur} .= $_;
+	next;
+    } else { 
+	#s,L</,L<POSIX/,g;
+	s,L</,L<perlfunc/,g;
+	$pod{$cur} .= $_ if $cur;
+    }
+} 
+
+for $f ( keys %syn ) {
+    $type = $Type{$f} || next;
+    $flavor = $Flavor{$f};
+    $orig = $f;
+    ($name = $f) =~ s/\W//g;
+    open (POD, "> $name.pod") || die "can't open $name.pod: $!";
+    print POD <<EOF;
+=head1 NAME
+
+$orig - $flavor
+
+=head1 SYNOPSIS
+
+$syn{$orig}
+
+=head1 DESCRIPTION
+
+$pod{$orig}
+
+EOF
+
+    close POD;
+
+} 
diff --git a/gnu/usr.bin/perl/pp.c b/gnu/usr.bin/perl/pp.c
new file mode 100644
index 00000000000..54433af2925
--- /dev/null
+++ b/gnu/usr.bin/perl/pp.c
@@ -0,0 +1,3512 @@
+/*    pp.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "It's a big house this, and very peculiar.  Always a bit more to discover,
+ * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static void doencodes _((SV *sv, char *s, I32 len));
+
+/* variations on pp_null */
+
+PP(pp_stub)
+{
+    dSP;
+    if (GIMME != G_ARRAY) {
+	XPUSHs(&sv_undef);
+    }
+    RETURN;
+}
+
+PP(pp_scalar)
+{
+    return NORMAL;
+}
+
+/* Pushy stuff. */
+
+PP(pp_padav)
+{
+    dSP; dTARGET;
+    if (op->op_private & OPpLVAL_INTRO)
+	SAVECLEARSV(curpad[op->op_targ]);
+    EXTEND(SP, 1);
+    if (op->op_flags & OPf_REF) {
+	PUSHs(TARG);
+	RETURN;
+    }
+    if (GIMME == G_ARRAY) {
+	I32 maxarg = AvFILL((AV*)TARG) + 1;
+	EXTEND(SP, maxarg);
+	Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+	SP += maxarg;
+    }
+    else {
+	SV* sv = sv_newmortal();
+	I32 maxarg = AvFILL((AV*)TARG) + 1;
+	sv_setiv(sv, maxarg);
+	PUSHs(sv);
+    }
+    RETURN;
+}
+
+PP(pp_padhv)
+{
+    dSP; dTARGET;
+    XPUSHs(TARG);
+    if (op->op_private & OPpLVAL_INTRO)
+	SAVECLEARSV(curpad[op->op_targ]);
+    if (op->op_flags & OPf_REF)
+	RETURN;
+    if (GIMME == G_ARRAY) { /* array wanted */
+	RETURNOP(do_kv(ARGS));
+    }
+    else {
+	SV* sv = sv_newmortal();
+	if (HvFILL((HV*)TARG)) {
+	    sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
+	    sv_setpv(sv, buf);
+	}
+	else
+	    sv_setiv(sv, 0);
+	SETs(sv);
+	RETURN;
+    }
+}
+
+PP(pp_padany)
+{
+    DIE("NOT IMPL LINE %d",__LINE__);
+}
+
+/* Translations. */
+
+PP(pp_rv2gv)
+{
+    dSP; dTOPss;
+    
+    if (SvROK(sv)) {
+      wasref:
+	sv = SvRV(sv);
+	if (SvTYPE(sv) != SVt_PVGV)
+	    DIE("Not a GLOB reference");
+    }
+    else {
+	if (SvTYPE(sv) != SVt_PVGV) {
+	    char *sym;
+
+	    if (SvGMAGICAL(sv)) {
+		mg_get(sv);
+		if (SvROK(sv))
+		    goto wasref;
+	    }
+	    if (!SvOK(sv)) {
+		if (op->op_flags & OPf_REF ||
+		    op->op_private & HINT_STRICT_REFS)
+		    DIE(no_usym, "a symbol");
+		RETSETUNDEF;
+	    }
+	    sym = SvPV(sv, na);
+	    if (op->op_private & HINT_STRICT_REFS)
+		DIE(no_symref, sym, "a symbol");
+	    sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+	}
+    }
+    if (op->op_private & OPpLVAL_INTRO) {
+	GP *ogp = GvGP(sv);
+
+	SSCHECK(3);
+	SSPUSHPTR(SvREFCNT_inc(sv));
+	SSPUSHPTR(ogp);
+	SSPUSHINT(SAVEt_GP);
+
+	if (op->op_flags & OPf_SPECIAL) {
+	    GvGP(sv)->gp_refcnt++;		/* will soon be assigned */
+	    GvINTRO_on(sv);
+	}
+	else {
+	    GP *gp;
+	    Newz(602,gp, 1, GP);
+	    GvGP(sv) = gp;
+	    GvREFCNT(sv) = 1;
+	    GvSV(sv) = NEWSV(72,0);
+	    GvLINE(sv) = curcop->cop_line;
+	    GvEGV(sv) = sv;
+	}
+    }
+    SETs(sv);
+    RETURN;
+}
+
+PP(pp_rv2sv)
+{
+    dSP; dTOPss;
+
+    if (SvROK(sv)) {
+      wasref:
+	sv = SvRV(sv);
+	switch (SvTYPE(sv)) {
+	case SVt_PVAV:
+	case SVt_PVHV:
+	case SVt_PVCV:
+	    DIE("Not a SCALAR reference");
+	}
+    }
+    else {
+	GV *gv = sv;
+	char *sym;
+
+	if (SvTYPE(gv) != SVt_PVGV) {
+	    if (SvGMAGICAL(sv)) {
+		mg_get(sv);
+		if (SvROK(sv))
+		    goto wasref;
+	    }
+	    if (!SvOK(sv)) {
+		if (op->op_flags & OPf_REF ||
+		    op->op_private & HINT_STRICT_REFS)
+		    DIE(no_usym, "a SCALAR");
+		RETSETUNDEF;
+	    }
+	    sym = SvPV(sv, na);
+	    if (op->op_private & HINT_STRICT_REFS)
+		DIE(no_symref, sym, "a SCALAR");
+	    gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
+	}
+	sv = GvSV(gv);
+    }
+    if (op->op_flags & OPf_MOD) {
+	if (op->op_private & OPpLVAL_INTRO)
+	    sv = save_scalar((GV*)TOPs);
+	else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+	    provide_ref(op, sv);
+    }
+    SETs(sv);
+    RETURN;
+}
+
+PP(pp_av2arylen)
+{
+    dSP;
+    AV *av = (AV*)TOPs;
+    SV *sv = AvARYLEN(av);
+    if (!sv) {
+	AvARYLEN(av) = sv = NEWSV(0,0);
+	sv_upgrade(sv, SVt_IV);
+	sv_magic(sv, (SV*)av, '#', Nullch, 0);
+    }
+    SETs(sv);
+    RETURN;
+}
+
+PP(pp_pos)
+{
+    dSP; dTARGET; dPOPss;
+    
+    if (op->op_flags & OPf_MOD) {
+	LvTYPE(TARG) = '<';
+	LvTARG(TARG) = sv;
+	PUSHs(TARG);	/* no SvSETMAGIC */
+	RETURN;
+    }
+    else {
+	MAGIC* mg; 
+
+	if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
+	    mg = mg_find(sv, 'g');
+	    if (mg && mg->mg_len >= 0) {
+		PUSHi(mg->mg_len + curcop->cop_arybase);
+		RETURN;
+	    }
+	}
+	RETPUSHUNDEF;
+    }
+}
+
+PP(pp_rv2cv)
+{
+    dSP;
+    GV *gv;
+    HV *stash;
+
+    /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
+    /* (But not in defined().) */
+    CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
+
+    if (!cv)
+	cv = (CV*)&sv_undef;
+    SETs((SV*)cv);
+    RETURN;
+}
+
+PP(pp_prototype)
+{
+    dSP;
+    CV *cv;
+    HV *stash;
+    GV *gv;
+    SV *ret;
+
+    ret = &sv_undef;
+    cv = sv_2cv(TOPs, &stash, &gv, FALSE);
+    if (cv && SvPOK(cv)) {
+	char *p = SvPVX(cv);
+	ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
+    }
+    SETs(ret);
+    RETURN;
+}
+
+PP(pp_anoncode)
+{
+    dSP;
+    CV* cv = (CV*)cSVOP->op_sv;
+    EXTEND(SP,1);
+
+    if (CvCLONE(cv))
+	cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+
+    PUSHs((SV*)cv);
+    RETURN;
+}
+
+PP(pp_srefgen)
+{
+    dSP; dTOPss;
+    SV* rv;
+    rv = sv_newmortal();
+    sv_upgrade(rv, SVt_RV);
+    if (SvPADTMP(sv))
+	sv = newSVsv(sv);
+    else {
+	SvTEMP_off(sv);
+	(void)SvREFCNT_inc(sv);
+    }
+    SvRV(rv) = sv;
+    SvROK_on(rv);
+    SETs(rv);
+    RETURN;
+} 
+
+PP(pp_refgen)
+{
+    dSP; dMARK;
+    SV* sv;
+    SV* rv;
+    if (GIMME != G_ARRAY) {
+	MARK[1] = *SP;
+	SP = MARK + 1;
+    }
+    while (MARK < SP) {
+	sv = *++MARK;
+	rv = sv_newmortal();
+	sv_upgrade(rv, SVt_RV);
+	if (SvPADTMP(sv))
+	    sv = newSVsv(sv);
+	else {
+	    SvTEMP_off(sv);
+	    (void)SvREFCNT_inc(sv);
+	}
+	SvRV(rv) = sv;
+	SvROK_on(rv);
+	*MARK = rv;
+    }
+    RETURN;
+}
+
+PP(pp_ref)
+{
+    dSP; dTARGET;
+    SV *sv;
+    char *pv;
+
+    sv = POPs;
+    if (!sv || !SvROK(sv))
+	RETPUSHNO;
+
+    sv = SvRV(sv);
+    pv = sv_reftype(sv,TRUE);
+    PUSHp(pv, strlen(pv));
+    RETURN;
+}
+
+PP(pp_bless)
+{
+    dSP;
+    HV *stash;
+
+    if (MAXARG == 1)
+	stash = curcop->cop_stash;
+    else
+	stash = gv_stashsv(POPs, TRUE);
+
+    (void)sv_bless(TOPs, stash);
+    RETURN;
+}
+
+/* Pattern matching */
+
+PP(pp_study)
+{
+    dSP; dPOPss;
+    register unsigned char *s;
+    register I32 pos;
+    register I32 ch;
+    register I32 *sfirst;
+    register I32 *snext;
+    I32 retval;
+    STRLEN len;
+
+    s = (unsigned char*)(SvPV(sv, len));
+    pos = len;
+    if (sv == lastscream)
+	SvSCREAM_off(sv);
+    else {
+	if (lastscream) {
+	    SvSCREAM_off(lastscream);
+	    SvREFCNT_dec(lastscream);
+	}
+	lastscream = SvREFCNT_inc(sv);
+    }
+    if (pos <= 0) {
+	retval = 0;
+	goto ret;
+    }
+    if (pos > maxscream) {
+	if (maxscream < 0) {
+	    maxscream = pos + 80;
+	    New(301, screamfirst, 256, I32);
+	    New(302, screamnext, maxscream, I32);
+	}
+	else {
+	    maxscream = pos + pos / 4;
+	    Renew(screamnext, maxscream, I32);
+	}
+    }
+
+    sfirst = screamfirst;
+    snext = screamnext;
+
+    if (!sfirst || !snext)
+	DIE("do_study: out of memory");
+
+    for (ch = 256; ch; --ch)
+	*sfirst++ = -1;
+    sfirst -= 256;
+
+    while (--pos >= 0) {
+	ch = s[pos];
+	if (sfirst[ch] >= 0)
+	    snext[pos] = sfirst[ch] - pos;
+	else
+	    snext[pos] = -pos;
+	sfirst[ch] = pos;
+
+	/* If there were any case insensitive searches, we must assume they
+	 * all are.  This speeds up insensitive searches much more than
+	 * it slows down sensitive ones.
+	 */
+	if (sawi)
+	    sfirst[fold[ch]] = pos;
+    }
+
+    SvSCREAM_on(sv);
+    sv_magic(sv, Nullsv, 'g', Nullch, 0);	/* piggyback on m//g magic */
+    retval = 1;
+  ret:
+    XPUSHs(sv_2mortal(newSViv((I32)retval)));
+    RETURN;
+}
+
+PP(pp_trans)
+{
+    dSP; dTARG;
+    SV *sv;
+
+    if (op->op_flags & OPf_STACKED)
+	sv = POPs;
+    else {
+	sv = GvSV(defgv);
+	EXTEND(SP,1);
+    }
+    TARG = sv_newmortal();
+    PUSHi(do_trans(sv, op));
+    RETURN;
+}
+
+/* Lvalue operators. */
+
+PP(pp_schop)
+{
+    dSP; dTARGET;
+    do_chop(TARG, TOPs);
+    SETTARG;
+    RETURN;
+}
+
+PP(pp_chop)
+{
+    dSP; dMARK; dTARGET;
+    while (SP > MARK)
+	do_chop(TARG, POPs);
+    PUSHTARG;
+    RETURN;
+}
+
+PP(pp_schomp)
+{
+    dSP; dTARGET;
+    SETi(do_chomp(TOPs));
+    RETURN;
+}
+
+PP(pp_chomp)
+{
+    dSP; dMARK; dTARGET;
+    register I32 count = 0;
+    
+    while (SP > MARK)
+	count += do_chomp(POPs);
+    PUSHi(count);
+    RETURN;
+}
+
+PP(pp_defined)
+{
+    dSP;
+    register SV* sv;
+
+    sv = POPs;
+    if (!sv || !SvANY(sv))
+	RETPUSHNO;
+    switch (SvTYPE(sv)) {
+    case SVt_PVAV:
+	if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
+	    RETPUSHYES;
+	break;
+    case SVt_PVHV:
+	if (HvARRAY(sv) || SvRMAGICAL(sv))
+	    RETPUSHYES;
+	break;
+    case SVt_PVCV:
+	if (CvROOT(sv) || CvXSUB(sv))
+	    RETPUSHYES;
+	break;
+    default:
+	if (SvGMAGICAL(sv))
+	    mg_get(sv);
+	if (SvOK(sv))
+	    RETPUSHYES;
+    }
+    RETPUSHNO;
+}
+
+PP(pp_undef)
+{
+    dSP;
+    SV *sv;
+
+    if (!op->op_private)
+	RETPUSHUNDEF;
+
+    sv = POPs;
+    if (!sv)
+	RETPUSHUNDEF;
+
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv))
+	    RETPUSHUNDEF;
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	break;
+    case SVt_PVAV:
+	av_undef((AV*)sv);
+	break;
+    case SVt_PVHV:
+	hv_undef((HV*)sv);
+	break;
+    case SVt_PVCV:
+	cv_undef((CV*)sv);
+	sub_generation++;
+	break;
+    case SVt_PVGV:
+        if (SvFAKE(sv)) {
+            sv_setsv(sv, &sv_undef);
+            break;
+        }
+    default:
+	if (SvPOK(sv) && SvLEN(sv)) {
+	    (void)SvOOK_off(sv);
+	    Safefree(SvPVX(sv));
+	    SvPV_set(sv, Nullch);
+	    SvLEN_set(sv, 0);
+	}
+	(void)SvOK_off(sv);
+	SvSETMAGIC(sv);
+    }
+
+    RETPUSHUNDEF;
+}
+
+PP(pp_predec)
+{
+    dSP;
+    if (SvIOK(TOPs)) {
+	--SvIVX(TOPs);
+	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+	sv_dec(TOPs);
+    SvSETMAGIC(TOPs);
+    return NORMAL;
+}
+
+PP(pp_postinc)
+{
+    dSP; dTARGET;
+    sv_setsv(TARG, TOPs);
+    if (SvIOK(TOPs)) {
+	++SvIVX(TOPs);
+	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+	sv_inc(TOPs);
+    SvSETMAGIC(TOPs);
+    if (!SvOK(TARG))
+	sv_setiv(TARG, 0);
+    SETs(TARG);
+    return NORMAL;
+}
+
+PP(pp_postdec)
+{
+    dSP; dTARGET;
+    sv_setsv(TARG, TOPs);
+    if (SvIOK(TOPs)) {
+	--SvIVX(TOPs);
+	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+	sv_dec(TOPs);
+    SvSETMAGIC(TOPs);
+    SETs(TARG);
+    return NORMAL;
+}
+
+/* Ordinary operators. */
+
+PP(pp_pow)
+{
+    dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
+    {
+      dPOPTOPnnrl;
+      SETn( pow( left, right) );
+      RETURN;
+    }
+}
+
+PP(pp_multiply)
+{
+    dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
+    {
+      dPOPTOPnnrl;
+      SETn( left * right );
+      RETURN;
+    }
+}
+
+PP(pp_divide)
+{
+    dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
+    {
+      dPOPnv;
+      if (value == 0.0)
+	DIE("Illegal division by zero");
+#ifdef SLOPPYDIVIDE
+      /* insure that 20./5. == 4. */
+      {
+	double x;
+	I32    k;
+	x =  POPn;
+	if ((double)I_32(x)     == x &&
+	    (double)I_32(value) == value &&
+	    (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
+	    value = k;
+	} else {
+	    value = x/value;
+	}
+      }
+#else
+      value = POPn / value;
+#endif
+      PUSHn( value );
+      RETURN;
+    }
+}
+
+PP(pp_modulo)
+{
+    dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+    {
+      register unsigned long tmpulong;
+      register long tmplong;
+      I32 value;
+
+      tmpulong = (unsigned long) POPn;
+      if (tmpulong == 0L)
+	DIE("Illegal modulus zero");
+      value = TOPn;
+      if (value >= 0.0)
+	value = (I32)(((unsigned long)value) % tmpulong);
+      else {
+	tmplong = (long)value;
+	value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
+      }
+      SETi(value);
+      RETURN;
+    }
+}
+
+PP(pp_repeat)
+{
+  dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+  {
+    register I32 count = POPi;
+    if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
+	dMARK;
+	I32 items = SP - MARK;
+	I32 max;
+
+	max = items * count;
+	MEXTEND(MARK, max);
+	if (count > 1) {
+	    while (SP > MARK) {
+		if (*SP)
+		    SvTEMP_off((*SP));
+		SP--;
+	    }
+	    MARK++;
+	    repeatcpy((char*)(MARK + items), (char*)MARK,
+		items * sizeof(SV*), count - 1);
+	    SP += max;
+	}
+	else if (count <= 0)
+	    SP -= items;
+    }
+    else {	/* Note: mark already snarfed by pp_list */
+	SV *tmpstr;
+	STRLEN len;
+
+	tmpstr = POPs;
+	if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
+	    if (SvREADONLY(tmpstr) && curcop != &compiling)
+		DIE("Can't x= to readonly value");
+	    if (SvROK(tmpstr))
+		sv_unref(tmpstr);
+	}
+	SvSetSV(TARG, tmpstr);
+	SvPV_force(TARG, len);
+	if (count >= 1) {
+	    SvGROW(TARG, (count * len) + 1);
+	    if (count > 1)
+		repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
+	    SvCUR(TARG) *= count;
+	    *SvEND(TARG) = '\0';
+	    (void)SvPOK_only(TARG);
+	}
+	else
+	    sv_setsv(TARG, &sv_no);
+	PUSHTARG;
+    }
+    RETURN;
+  }
+}
+
+PP(pp_subtract)
+{
+    dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
+    {
+      dPOPTOPnnrl;
+      SETn( left - right );
+      RETURN;
+    }
+}
+
+PP(pp_left_shift)
+{
+    dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
+    {
+        dPOPTOPiirl;
+        SETi( left << right );
+        RETURN;
+    }
+}
+
+PP(pp_right_shift)
+{
+    dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
+    {
+      dPOPTOPiirl;
+      SETi( left >> right );
+      RETURN;
+    }
+}
+
+PP(pp_lt)
+{
+    dSP; tryAMAGICbinSET(lt,0); 
+    {
+      dPOPnv;
+      SETs((TOPn < value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_gt)
+{
+    dSP; tryAMAGICbinSET(gt,0); 
+    {
+      dPOPnv;
+      SETs((TOPn > value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_le)
+{
+    dSP; tryAMAGICbinSET(le,0); 
+    {
+      dPOPnv;
+      SETs((TOPn <= value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_ge)
+{
+    dSP; tryAMAGICbinSET(ge,0); 
+    {
+      dPOPnv;
+      SETs((TOPn >= value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_ne)
+{
+    dSP; tryAMAGICbinSET(ne,0); 
+    {
+      dPOPnv;
+      SETs((TOPn != value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_ncmp)
+{
+    dSP; dTARGET; tryAMAGICbin(ncmp,0); 
+    {
+      dPOPTOPnnrl;
+      I32 value;
+
+      if (left > right)
+	value = 1;
+      else if (left < right)
+	value = -1;
+      else
+	value = 0;
+      SETi(value);
+      RETURN;
+    }
+}
+
+PP(pp_slt)
+{
+    dSP; tryAMAGICbinSET(slt,0); 
+    {
+      dPOPTOPssrl;
+      SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_sgt)
+{
+    dSP; tryAMAGICbinSET(sgt,0); 
+    {
+      dPOPTOPssrl;
+      SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_sle)
+{
+    dSP; tryAMAGICbinSET(sle,0); 
+    {
+      dPOPTOPssrl;
+      SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_sge)
+{
+    dSP; tryAMAGICbinSET(sge,0); 
+    {
+      dPOPTOPssrl;
+      SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_sne)
+{
+    dSP; tryAMAGICbinSET(sne,0); 
+    {
+      dPOPTOPssrl;
+      SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_scmp)
+{
+    dSP; dTARGET;  tryAMAGICbin(scmp,0);
+    {
+      dPOPTOPssrl;
+      SETi( sv_cmp(left, right) );
+      RETURN;
+    }
+}
+
+PP(pp_bit_and) {
+    dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
+    {
+      dPOPTOPssrl;
+      if (SvNIOKp(left) || SvNIOKp(right)) {
+	unsigned long value = U_L(SvNV(left));
+	value = value & U_L(SvNV(right));
+	SETn((double)value);
+      }
+      else {
+	do_vop(op->op_type, TARG, left, right);
+	SETTARG;
+      }
+      RETURN;
+    }
+}
+
+PP(pp_bit_xor)
+{
+    dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
+    {
+      dPOPTOPssrl;
+      if (SvNIOKp(left) || SvNIOKp(right)) {
+	unsigned long value = U_L(SvNV(left));
+	value = value ^ U_L(SvNV(right));
+	SETn((double)value);
+      }
+      else {
+	do_vop(op->op_type, TARG, left, right);
+	SETTARG;
+      }
+      RETURN;
+    }
+}
+
+PP(pp_bit_or)
+{
+    dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
+    {
+      dPOPTOPssrl;
+      if (SvNIOKp(left) || SvNIOKp(right)) {
+	unsigned long value = U_L(SvNV(left));
+	value = value | U_L(SvNV(right));
+	SETn((double)value);
+      }
+      else {
+	do_vop(op->op_type, TARG, left, right);
+	SETTARG;
+      }
+      RETURN;
+    }
+}
+
+PP(pp_negate)
+{
+    dSP; dTARGET; tryAMAGICun(neg);
+    {
+	dTOPss;
+	if (SvGMAGICAL(sv))
+	    mg_get(sv);
+	if (SvNIOKp(sv))
+	    SETn(-SvNV(sv));
+	else if (SvPOKp(sv)) {
+	    STRLEN len;
+	    char *s = SvPV(sv, len);
+	    if (isALPHA(*s) || *s == '_') {
+		sv_setpvn(TARG, "-", 1);
+		sv_catsv(TARG, sv);
+	    }
+	    else if (*s == '+' || *s == '-') {
+		sv_setsv(TARG, sv);
+		*SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
+	    }
+	    else
+		sv_setnv(TARG, -SvNV(sv));
+	    SETTARG;
+	}
+	else
+	    SETn(-SvNV(sv));
+    }
+    RETURN;
+}
+
+PP(pp_not)
+{
+#ifdef OVERLOAD
+    dSP; tryAMAGICunSET(not);
+#endif /* OVERLOAD */
+    *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
+    return NORMAL;
+}
+
+PP(pp_complement)
+{
+    dSP; dTARGET; tryAMAGICun(compl); 
+    {
+      dTOPss;
+      register I32 anum;
+
+      if (SvNIOKp(sv)) {
+	IV iv = ~SvIV(sv);
+	if (iv < 0)
+	    SETn( (double) ~U_L(SvNV(sv)) );
+	else
+	    SETi( iv );
+      }
+      else {
+	register char *tmps;
+	register long *tmpl;
+	STRLEN len;
+
+	SvSetSV(TARG, sv);
+	tmps = SvPV_force(TARG, len);
+	anum = len;
+#ifdef LIBERAL
+	for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
+	    *tmps = ~*tmps;
+	tmpl = (long*)tmps;
+	for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
+	    *tmpl = ~*tmpl;
+	tmps = (char*)tmpl;
+#endif
+	for ( ; anum > 0; anum--, tmps++)
+	    *tmps = ~*tmps;
+
+	SETs(TARG);
+      }
+      RETURN;
+    }
+}
+
+/* integer versions of some of the above */
+
+PP(pp_i_multiply)
+{
+    dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
+    {
+      dPOPTOPiirl;
+      SETi( left * right );
+      RETURN;
+    }
+}
+
+PP(pp_i_divide)
+{
+    dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
+    {
+      dPOPiv;
+      if (value == 0)
+	DIE("Illegal division by zero");
+      value = POPi / value;
+      PUSHi( value );
+      RETURN;
+    }
+}
+
+PP(pp_i_modulo)
+{
+    dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); 
+    {
+      dPOPTOPiirl;
+      SETi( left % right );
+      RETURN;
+    }
+}
+
+PP(pp_i_add)
+{
+    dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
+    {
+      dPOPTOPiirl;
+      SETi( left + right );
+      RETURN;
+    }
+}
+
+PP(pp_i_subtract)
+{
+    dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
+    {
+      dPOPTOPiirl;
+      SETi( left - right );
+      RETURN;
+    }
+}
+
+PP(pp_i_lt)
+{
+    dSP; tryAMAGICbinSET(lt,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left < right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_gt)
+{
+    dSP; tryAMAGICbinSET(gt,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left > right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_le)
+{
+    dSP; tryAMAGICbinSET(le,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left <= right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_ge)
+{
+    dSP; tryAMAGICbinSET(ge,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left >= right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_eq)
+{
+    dSP; tryAMAGICbinSET(eq,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left == right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_ne)
+{
+    dSP; tryAMAGICbinSET(ne,0); 
+    {
+      dPOPTOPiirl;
+      SETs((left != right) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_i_ncmp)
+{
+    dSP; dTARGET; tryAMAGICbin(ncmp,0); 
+    {
+      dPOPTOPiirl;
+      I32 value;
+
+      if (left > right)
+	value = 1;
+      else if (left < right)
+	value = -1;
+      else
+	value = 0;
+      SETi(value);
+      RETURN;
+    }
+}
+
+PP(pp_i_negate)
+{
+    dSP; dTARGET; tryAMAGICun(neg);
+    SETi(-TOPi);
+    RETURN;
+}
+
+/* High falutin' math. */
+
+PP(pp_atan2)
+{
+    dSP; dTARGET; tryAMAGICbin(atan2,0); 
+    {
+      dPOPTOPnnrl;
+      SETn(atan2(left, right));
+      RETURN;
+    }
+}
+
+PP(pp_sin)
+{
+    dSP; dTARGET; tryAMAGICun(sin);
+    {
+      double value;
+      value = POPn;
+      value = sin(value);
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_cos)
+{
+    dSP; dTARGET; tryAMAGICun(cos);
+    {
+      double value;
+      value = POPn;
+      value = cos(value);
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_rand)
+{
+    dSP; dTARGET;
+    double value;
+    if (MAXARG < 1)
+	value = 1.0;
+    else
+	value = POPn;
+    if (value == 0.0)
+	value = 1.0;
+#if RANDBITS == 31
+    value = rand() * value / 2147483648.0;
+#else
+#if RANDBITS == 16
+    value = rand() * value / 65536.0;
+#else
+#if RANDBITS == 15
+    value = rand() * value / 32768.0;
+#else
+    value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
+#endif
+#endif
+#endif
+    XPUSHn(value);
+    RETURN;
+}
+
+PP(pp_srand)
+{
+    dSP;
+    I32 anum;
+    Time_t when;
+
+    if (MAXARG < 1) {
+	(void)time(&when);
+	anum = when;
+    }
+    else
+	anum = POPi;
+    (void)srand(anum);
+    EXTEND(SP, 1);
+    RETPUSHYES;
+}
+
+PP(pp_exp)
+{
+    dSP; dTARGET; tryAMAGICun(exp);
+    {
+      double value;
+      value = POPn;
+      value = exp(value);
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_log)
+{
+    dSP; dTARGET; tryAMAGICun(log);
+    {
+      double value;
+      value = POPn;
+      if (value <= 0.0)
+	DIE("Can't take log of %g", value);
+      value = log(value);
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_sqrt)
+{
+    dSP; dTARGET; tryAMAGICun(sqrt);
+    {
+      double value;
+      value = POPn;
+      if (value < 0.0)
+	DIE("Can't take sqrt of %g", value);
+      value = sqrt(value);
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_int)
+{
+    dSP; dTARGET;
+    double value;
+    value = POPn;
+    if (value >= 0.0)
+	(void)modf(value, &value);
+    else {
+	(void)modf(-value, &value);
+	value = -value;
+    }
+    XPUSHn(value);
+    RETURN;
+}
+
+PP(pp_abs)
+{
+    dSP; dTARGET; tryAMAGICun(abs);
+    {
+      double value;
+      value = POPn;
+
+      if (value < 0.0)
+	value = -value;
+
+      XPUSHn(value);
+      RETURN;
+    }
+}
+
+PP(pp_hex)
+{
+    dSP; dTARGET;
+    char *tmps;
+    unsigned long value;
+    I32 argtype;
+
+    tmps = POPp;
+    value = scan_hex(tmps, 99, &argtype);
+    if ((IV)value >= 0)
+	XPUSHi(value);
+    else
+	XPUSHn(U_V(value));
+    RETURN;
+}
+
+PP(pp_oct)
+{
+    dSP; dTARGET;
+    unsigned long value;
+    I32 argtype;
+    char *tmps;
+
+    tmps = POPp;
+    while (*tmps && isSPACE(*tmps))
+	tmps++;
+    if (*tmps == '0')
+	tmps++;
+    if (*tmps == 'x')
+	value = scan_hex(++tmps, 99, &argtype);
+    else
+	value = scan_oct(tmps, 99, &argtype);
+    if ((IV)value >= 0)
+	XPUSHi(value);
+    else
+	XPUSHn(U_V(value));
+    RETURN;
+}
+
+/* String stuff. */
+
+PP(pp_length)
+{
+    dSP; dTARGET;
+    SETi( sv_len(TOPs) );
+    RETURN;
+}
+
+PP(pp_substr)
+{
+    dSP; dTARGET;
+    SV *sv;
+    I32 len;
+    STRLEN curlen;
+    I32 pos;
+    I32 rem;
+    I32 lvalue = op->op_flags & OPf_MOD;
+    char *tmps;
+    I32 arybase = curcop->cop_arybase;
+
+    if (MAXARG > 2)
+	len = POPi;
+    pos = POPi - arybase;
+    sv = POPs;
+    tmps = SvPV(sv, curlen);
+    if (pos < 0)
+	pos += curlen + arybase;
+    if (pos < 0 || pos > curlen) {
+	if (dowarn || lvalue)
+	    warn("substr outside of string");
+	RETPUSHUNDEF;
+    }
+    else {
+	if (MAXARG < 3)
+	    len = curlen;
+	else if (len < 0) {
+	    len += curlen - pos;
+	    if (len < 0)
+		len = 0;
+	}
+	tmps += pos;
+	rem = curlen - pos;	/* rem=how many bytes left*/
+	if (rem > len)
+	    rem = len;
+	sv_setpvn(TARG, tmps, rem);
+	if (lvalue) {			/* it's an lvalue! */
+	    if (!SvGMAGICAL(sv))
+		(void)SvPOK_only(sv);
+	    if (SvTYPE(TARG) < SVt_PVLV) {
+		sv_upgrade(TARG, SVt_PVLV);
+		sv_magic(TARG, Nullsv, 'x', Nullch, 0);
+	    }
+
+	    LvTYPE(TARG) = 's';
+	    LvTARG(TARG) = sv;
+	    LvTARGOFF(TARG) = pos;
+	    LvTARGLEN(TARG) = rem; 
+	}
+    }
+    PUSHs(TARG);		/* avoid SvSETMAGIC here */
+    RETURN;
+}
+
+PP(pp_vec)
+{
+    dSP; dTARGET;
+    register I32 size = POPi;
+    register I32 offset = POPi;
+    register SV *src = POPs;
+    I32 lvalue = op->op_flags & OPf_MOD;
+    STRLEN srclen;
+    unsigned char *s = (unsigned char*)SvPV(src, srclen);
+    unsigned long retnum;
+    I32 len;
+
+    offset *= size;		/* turn into bit offset */
+    len = (offset + size + 7) / 8;
+    if (offset < 0 || size < 1)
+	retnum = 0;
+    else {
+	if (lvalue) {                      /* it's an lvalue! */
+	    if (SvTYPE(TARG) < SVt_PVLV) {
+		sv_upgrade(TARG, SVt_PVLV);
+		sv_magic(TARG, Nullsv, 'v', Nullch, 0);
+	    }
+
+	    LvTYPE(TARG) = 'v';
+	    LvTARG(TARG) = src;
+	    LvTARGOFF(TARG) = offset; 
+	    LvTARGLEN(TARG) = size; 
+	}
+	if (len > srclen) {
+	    if (size <= 8)
+		retnum = 0;
+	    else {
+		offset >>= 3;
+		if (size == 16) {
+		    if (offset >= srclen)
+			retnum = 0;
+		    else
+			retnum = (unsigned long) s[offset] << 8;
+		}
+		else if (size == 32) {
+		    if (offset >= srclen)
+			retnum = 0;
+		    else if (offset + 1 >= srclen)
+			retnum = (unsigned long) s[offset] << 24;
+		    else if (offset + 2 >= srclen)
+			retnum = ((unsigned long) s[offset] << 24) +
+			    ((unsigned long) s[offset + 1] << 16);
+		    else
+			retnum = ((unsigned long) s[offset] << 24) +
+			    ((unsigned long) s[offset + 1] << 16) +
+			    (s[offset + 2] << 8);
+		}
+	    }
+	}
+	else if (size < 8)
+	    retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
+	else {
+	    offset >>= 3;
+	    if (size == 8)
+		retnum = s[offset];
+	    else if (size == 16)
+		retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
+	    else if (size == 32)
+		retnum = ((unsigned long) s[offset] << 24) +
+			((unsigned long) s[offset + 1] << 16) +
+			(s[offset + 2] << 8) + s[offset+3];
+	}
+    }
+
+    sv_setiv(TARG, (I32)retnum);
+    PUSHs(TARG);
+    RETURN;
+}
+
+PP(pp_index)
+{
+    dSP; dTARGET;
+    SV *big;
+    SV *little;
+    I32 offset;
+    I32 retval;
+    char *tmps;
+    char *tmps2;
+    STRLEN biglen;
+    I32 arybase = curcop->cop_arybase;
+
+    if (MAXARG < 3)
+	offset = 0;
+    else
+	offset = POPi - arybase;
+    little = POPs;
+    big = POPs;
+    tmps = SvPV(big, biglen);
+    if (offset < 0)
+	offset = 0;
+    else if (offset > biglen)
+	offset = biglen;
+    if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
+      (unsigned char*)tmps + biglen, little)))
+	retval = -1 + arybase;
+    else
+	retval = tmps2 - tmps + arybase;
+    PUSHi(retval);
+    RETURN;
+}
+
+PP(pp_rindex)
+{
+    dSP; dTARGET;
+    SV *big;
+    SV *little;
+    STRLEN blen;
+    STRLEN llen;
+    SV *offstr;
+    I32 offset;
+    I32 retval;
+    char *tmps;
+    char *tmps2;
+    I32 arybase = curcop->cop_arybase;
+
+    if (MAXARG >= 3)
+	offstr = POPs;
+    little = POPs;
+    big = POPs;
+    tmps2 = SvPV(little, llen);
+    tmps = SvPV(big, blen);
+    if (MAXARG < 3)
+	offset = blen;
+    else
+	offset = SvIV(offstr) - arybase + llen;
+    if (offset < 0)
+	offset = 0;
+    else if (offset > blen)
+	offset = blen;
+    if (!(tmps2 = rninstr(tmps,  tmps  + offset,
+			  tmps2, tmps2 + llen)))
+	retval = -1 + arybase;
+    else
+	retval = tmps2 - tmps + arybase;
+    PUSHi(retval);
+    RETURN;
+}
+
+PP(pp_sprintf)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    do_sprintf(TARG, SP-MARK, MARK+1);
+    SP = ORIGMARK;
+    PUSHTARG;
+    RETURN;
+}
+
+PP(pp_ord)
+{
+    dSP; dTARGET;
+    I32 value;
+    char *tmps;
+
+#ifndef I286
+    tmps = POPp;
+    value = (I32) (*tmps & 255);
+#else
+    I32 anum;
+    tmps = POPp;
+    anum = (I32) *tmps;
+    value = (I32) (anum & 255);
+#endif
+    XPUSHi(value);
+    RETURN;
+}
+
+PP(pp_chr)
+{
+    dSP; dTARGET;
+    char *tmps;
+
+    (void)SvUPGRADE(TARG,SVt_PV);
+    SvGROW(TARG,2);
+    SvCUR_set(TARG, 1);
+    tmps = SvPVX(TARG);
+    *tmps++ = POPi;
+    *tmps = '\0';
+    (void)SvPOK_only(TARG);
+    XPUSHs(TARG);
+    RETURN;
+}
+
+PP(pp_crypt)
+{
+    dSP; dTARGET; dPOPTOPssrl;
+#ifdef HAS_CRYPT
+    char *tmps = SvPV(left, na);
+#ifdef FCRYPT
+    sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
+#else
+    sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
+#endif
+#else
+    DIE(
+      "The crypt() function is unimplemented due to excessive paranoia.");
+#endif
+    SETs(TARG);
+    RETURN;
+}
+
+PP(pp_ucfirst)
+{
+    dSP;
+    SV *sv = TOPs;
+    register char *s;
+
+    if (!SvPADTMP(sv)) {
+	dTARGET;
+	sv_setsv(TARG, sv);
+	sv = TARG;
+	SETs(sv);
+    }
+    s = SvPV_force(sv, na);
+    if (isLOWER(*s))
+	*s = toUPPER(*s);
+
+    RETURN;
+}
+
+PP(pp_lcfirst)
+{
+    dSP;
+    SV *sv = TOPs;
+    register char *s;
+
+    if (!SvPADTMP(sv)) {
+	dTARGET;
+	sv_setsv(TARG, sv);
+	sv = TARG;
+	SETs(sv);
+    }
+    s = SvPV_force(sv, na);
+    if (isUPPER(*s))
+	*s = toLOWER(*s);
+
+    SETs(sv);
+    RETURN;
+}
+
+PP(pp_uc)
+{
+    dSP;
+    SV *sv = TOPs;
+    register char *s;
+    register char *send;
+    STRLEN len;
+
+    if (!SvPADTMP(sv)) {
+	dTARGET;
+	sv_setsv(TARG, sv);
+	sv = TARG;
+	SETs(sv);
+    }
+    s = SvPV_force(sv, len);
+    send = s + len;
+    while (s < send) {
+	if (isLOWER(*s))
+	    *s = toUPPER(*s);
+	s++;
+    }
+    RETURN;
+}
+
+PP(pp_lc)
+{
+    dSP;
+    SV *sv = TOPs;
+    register char *s;
+    register char *send;
+    STRLEN len;
+
+    if (!SvPADTMP(sv)) {
+	dTARGET;
+	sv_setsv(TARG, sv);
+	sv = TARG;
+	SETs(sv);
+    }
+    s = SvPV_force(sv, len);
+    send = s + len;
+    while (s < send) {
+	if (isUPPER(*s))
+	    *s = toLOWER(*s);
+	s++;
+    }
+    RETURN;
+}
+
+PP(pp_quotemeta)
+{
+    dSP; dTARGET;
+    SV *sv = TOPs;
+    STRLEN len;
+    register char *s = SvPV(sv,len);
+    register char *d;
+
+    if (len) {
+	(void)SvUPGRADE(TARG, SVt_PV);
+	SvGROW(TARG, (len * 2) + 1);
+	d = SvPVX(TARG);
+	while (len--) {
+	    if (!isALNUM(*s))
+		*d++ = '\\';
+	    *d++ = *s++;
+	}
+	*d = '\0';
+	SvCUR_set(TARG, d - SvPVX(TARG));
+	(void)SvPOK_only(TARG);
+    }
+    else
+	sv_setpvn(TARG, s, len);
+    SETs(TARG);
+    RETURN;
+}
+
+/* Arrays. */
+
+PP(pp_aslice)
+{
+    dSP; dMARK; dORIGMARK;
+    register SV** svp;
+    register AV* av = (AV*)POPs;
+    register I32 lval = op->op_flags & OPf_MOD;
+    I32 arybase = curcop->cop_arybase;
+    I32 elem;
+
+    if (SvTYPE(av) == SVt_PVAV) {
+	if (lval && op->op_private & OPpLVAL_INTRO) {
+	    I32 max = -1;
+	    for (svp = mark + 1; svp <= sp; svp++) {
+		elem = SvIVx(*svp);
+		if (elem > max)
+		    max = elem;
+	    }
+	    if (max > AvMAX(av))
+		av_extend(av, max);
+	}
+	while (++MARK <= SP) {
+	    elem = SvIVx(*MARK);
+
+	    if (elem > 0)
+		elem -= arybase;
+	    svp = av_fetch(av, elem, lval);
+	    if (lval) {
+		if (!svp || *svp == &sv_undef)
+		    DIE(no_aelem, elem);
+		if (op->op_private & OPpLVAL_INTRO)
+		    save_svref(svp);
+	    }
+	    *MARK = svp ? *svp : &sv_undef;
+	}
+    }
+    if (GIMME != G_ARRAY) {
+	MARK = ORIGMARK;
+	*++MARK = *SP;
+	SP = MARK;
+    }
+    RETURN;
+}
+
+/* Associative arrays. */
+
+PP(pp_each)
+{
+    dSP; dTARGET;
+    HV *hash = (HV*)POPs;
+    HE *entry;
+    I32 i;
+    char *tmps;
+    
+    PUTBACK;
+    entry = hv_iternext(hash);                        /* might clobber stack_sp */
+    SPAGAIN;
+
+    EXTEND(SP, 2);
+    if (entry) {
+	tmps = hv_iterkey(entry, &i);	              /* won't clobber stack_sp */
+	if (!i)
+	    tmps = "";
+	PUSHs(sv_2mortal(newSVpv(tmps, i)));
+	if (GIMME == G_ARRAY) {
+	    PUTBACK;
+	    sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
+	    SPAGAIN;
+	    PUSHs(TARG);
+	}
+    }
+    else if (GIMME == G_SCALAR)
+	RETPUSHUNDEF;
+
+    RETURN;
+}
+
+PP(pp_values)
+{
+    return do_kv(ARGS);
+}
+
+PP(pp_keys)
+{
+    return do_kv(ARGS);
+}
+
+PP(pp_delete)
+{
+    dSP;
+    SV *sv;
+    SV *tmpsv = POPs;
+    HV *hv = (HV*)POPs;
+    char *tmps;
+    STRLEN len;
+    if (SvTYPE(hv) != SVt_PVHV) {
+	DIE("Not a HASH reference");
+    }
+    tmps = SvPV(tmpsv, len);
+    sv = hv_delete(hv, tmps, len,
+	op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
+    if (!sv)
+	RETPUSHUNDEF;
+    PUSHs(sv);
+    RETURN;
+}
+
+PP(pp_exists)
+{
+    dSP;
+    SV *tmpsv = POPs;
+    HV *hv = (HV*)POPs;
+    char *tmps;
+    STRLEN len;
+    if (SvTYPE(hv) != SVt_PVHV) {
+	DIE("Not a HASH reference");
+    }
+    tmps = SvPV(tmpsv, len);
+    if (hv_exists(hv, tmps, len))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_hslice)
+{
+    dSP; dMARK; dORIGMARK;
+    register SV **svp;
+    register HV *hv = (HV*)POPs;
+    register I32 lval = op->op_flags & OPf_MOD;
+
+    if (SvTYPE(hv) == SVt_PVHV) {
+	while (++MARK <= SP) {
+	    STRLEN keylen;
+	    char *key = SvPV(*MARK, keylen);
+
+	    svp = hv_fetch(hv, key, keylen, lval);
+	    if (lval) {
+		if (!svp || *svp == &sv_undef)
+		    DIE(no_helem, key);
+		if (op->op_private & OPpLVAL_INTRO)
+		    save_svref(svp);
+	    }
+	    *MARK = svp ? *svp : &sv_undef;
+	}
+    }
+    if (GIMME != G_ARRAY) {
+	MARK = ORIGMARK;
+	*++MARK = *SP;
+	SP = MARK;
+    }
+    RETURN;
+}
+
+/* List operators. */
+
+PP(pp_list)
+{
+    dSP; dMARK;
+    if (GIMME != G_ARRAY) {
+	if (++MARK <= SP)
+	    *MARK = *SP;		/* unwanted list, return last item */
+	else
+	    *MARK = &sv_undef;
+	SP = MARK;
+    }
+    RETURN;
+}
+
+PP(pp_lslice)
+{
+    dSP;
+    SV **lastrelem = stack_sp;
+    SV **lastlelem = stack_base + POPMARK;
+    SV **firstlelem = stack_base + POPMARK + 1;
+    register SV **firstrelem = lastlelem + 1;
+    I32 arybase = curcop->cop_arybase;
+    I32 lval = op->op_flags & OPf_MOD;
+    I32 is_something_there = lval;
+
+    register I32 max = lastrelem - lastlelem;
+    register SV **lelem;
+    register I32 ix;
+
+    if (GIMME != G_ARRAY) {
+	ix = SvIVx(*lastlelem);
+	if (ix < 0)
+	    ix += max;
+	else
+	    ix -= arybase;
+	if (ix < 0 || ix >= max)
+	    *firstlelem = &sv_undef;
+	else
+	    *firstlelem = firstrelem[ix];
+	SP = firstlelem;
+	RETURN;
+    }
+
+    if (max == 0) {
+	SP = firstlelem - 1;
+	RETURN;
+    }
+
+    for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
+	ix = SvIVx(*lelem);
+	if (ix < 0) {
+	    ix += max;
+	    if (ix < 0)
+		*lelem = &sv_undef;
+	    else if (!(*lelem = firstrelem[ix]))
+		*lelem = &sv_undef;
+	}
+	else {
+	    ix -= arybase;
+	    if (ix >= max || !(*lelem = firstrelem[ix]))
+		*lelem = &sv_undef;
+	}
+	if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
+	    is_something_there = TRUE;
+    }
+    if (is_something_there)
+	SP = lastlelem;
+    else
+	SP = firstlelem - 1;
+    RETURN;
+}
+
+PP(pp_anonlist)
+{
+    dSP; dMARK;
+    I32 items = SP - MARK;
+    SP = MARK;
+    XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
+    RETURN;
+}
+
+PP(pp_anonhash)
+{
+    dSP; dMARK; dORIGMARK;
+    STRLEN len;
+    HV* hv = (HV*)sv_2mortal((SV*)newHV());
+
+    while (MARK < SP) {
+	SV* key = *++MARK;
+	char *tmps;
+	SV *val = NEWSV(46, 0);
+	if (MARK < SP)
+	    sv_setsv(val, *++MARK);
+	else
+	    warn("Odd number of elements in hash list");
+	tmps = SvPV(key,len);
+	(void)hv_store(hv,tmps,len,val,0);
+    }
+    SP = ORIGMARK;
+    XPUSHs((SV*)hv);
+    RETURN;
+}
+
+PP(pp_splice)
+{
+    dSP; dMARK; dORIGMARK;
+    register AV *ary = (AV*)*++MARK;
+    register SV **src;
+    register SV **dst;
+    register I32 i;
+    register I32 offset;
+    register I32 length;
+    I32 newlen;
+    I32 after;
+    I32 diff;
+    SV **tmparyval = 0;
+
+    SP++;
+
+    if (++MARK < SP) {
+	offset = SvIVx(*MARK);
+	if (offset < 0)
+	    offset += AvFILL(ary) + 1;
+	else
+	    offset -= curcop->cop_arybase;
+	if (++MARK < SP) {
+	    length = SvIVx(*MARK++);
+	    if (length < 0)
+		length = 0;
+	}
+	else
+	    length = AvMAX(ary) + 1;		/* close enough to infinity */
+    }
+    else {
+	offset = 0;
+	length = AvMAX(ary) + 1;
+    }
+    if (offset < 0) {
+	length += offset;
+	offset = 0;
+	if (length < 0)
+	    length = 0;
+    }
+    if (offset > AvFILL(ary) + 1)
+	offset = AvFILL(ary) + 1;
+    after = AvFILL(ary) + 1 - (offset + length);
+    if (after < 0) {				/* not that much array */
+	length += after;			/* offset+length now in array */
+	after = 0;
+	if (!AvALLOC(ary))
+	    av_extend(ary, 0);
+    }
+
+    /* At this point, MARK .. SP-1 is our new LIST */
+
+    newlen = SP - MARK;
+    diff = newlen - length;
+
+    if (diff < 0) {				/* shrinking the area */
+	if (newlen) {
+	    New(451, tmparyval, newlen, SV*);	/* so remember insertion */
+	    Copy(MARK, tmparyval, newlen, SV*);
+	}
+
+	MARK = ORIGMARK + 1;
+	if (GIMME == G_ARRAY) {			/* copy return vals to stack */
+	    MEXTEND(MARK, length);
+	    Copy(AvARRAY(ary)+offset, MARK, length, SV*);
+	    if (AvREAL(ary)) {
+		for (i = length, dst = MARK; i; i--)
+		    sv_2mortal(*dst++);	/* free them eventualy */
+	    }
+	    MARK += length - 1;
+	}
+	else {
+	    *MARK = AvARRAY(ary)[offset+length-1];
+	    if (AvREAL(ary)) {
+		sv_2mortal(*MARK);
+		for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
+		    SvREFCNT_dec(*dst++);	/* free them now */
+	    }
+	}
+	AvFILL(ary) += diff;
+
+	/* pull up or down? */
+
+	if (offset < after) {			/* easier to pull up */
+	    if (offset) {			/* esp. if nothing to pull */
+		src = &AvARRAY(ary)[offset-1];
+		dst = src - diff;		/* diff is negative */
+		for (i = offset; i > 0; i--)	/* can't trust Copy */
+		    *dst-- = *src--;
+	    }
+	    dst = AvARRAY(ary);
+	    SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
+	    AvMAX(ary) += diff;
+	}
+	else {
+	    if (after) {			/* anything to pull down? */
+		src = AvARRAY(ary) + offset + length;
+		dst = src + diff;		/* diff is negative */
+		Move(src, dst, after, SV*);
+	    }
+	    dst = &AvARRAY(ary)[AvFILL(ary)+1];
+						/* avoid later double free */
+	}
+	i = -diff;
+	while (i)
+	    dst[--i] = &sv_undef;
+	
+	if (newlen) {
+	    for (src = tmparyval, dst = AvARRAY(ary) + offset;
+	      newlen; newlen--) {
+		*dst = NEWSV(46, 0);
+		sv_setsv(*dst++, *src++);
+	    }
+	    Safefree(tmparyval);
+	}
+    }
+    else {					/* no, expanding (or same) */
+	if (length) {
+	    New(452, tmparyval, length, SV*);	/* so remember deletion */
+	    Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
+	}
+
+	if (diff > 0) {				/* expanding */
+
+	    /* push up or down? */
+
+	    if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
+		if (offset) {
+		    src = AvARRAY(ary);
+		    dst = src - diff;
+		    Move(src, dst, offset, SV*);
+		}
+		SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
+		AvMAX(ary) += diff;
+		AvFILL(ary) += diff;
+	    }
+	    else {
+		if (AvFILL(ary) + diff >= AvMAX(ary))	/* oh, well */
+		    av_extend(ary, AvFILL(ary) + diff);
+		AvFILL(ary) += diff;
+
+		if (after) {
+		    dst = AvARRAY(ary) + AvFILL(ary);
+		    src = dst - diff;
+		    for (i = after; i; i--) {
+			*dst-- = *src--;
+		    }
+		}
+	    }
+	}
+
+	for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
+	    *dst = NEWSV(46, 0);
+	    sv_setsv(*dst++, *src++);
+	}
+	MARK = ORIGMARK + 1;
+	if (GIMME == G_ARRAY) {			/* copy return vals to stack */
+	    if (length) {
+		Copy(tmparyval, MARK, length, SV*);
+		if (AvREAL(ary)) {
+		    for (i = length, dst = MARK; i; i--)
+			sv_2mortal(*dst++);	/* free them eventualy */
+		}
+		Safefree(tmparyval);
+	    }
+	    MARK += length - 1;
+	}
+	else if (length--) {
+	    *MARK = tmparyval[length];
+	    if (AvREAL(ary)) {
+		sv_2mortal(*MARK);
+		while (length-- > 0)
+		    SvREFCNT_dec(tmparyval[length]);
+	    }
+	    Safefree(tmparyval);
+	}
+	else
+	    *MARK = &sv_undef;
+    }
+    SP = MARK;
+    RETURN;
+}
+
+PP(pp_push)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    register AV *ary = (AV*)*++MARK;
+    register SV *sv = &sv_undef;
+
+    for (++MARK; MARK <= SP; MARK++) {
+	sv = NEWSV(51, 0);
+	if (*MARK)
+	    sv_setsv(sv, *MARK);
+	av_push(ary, sv);
+    }
+    SP = ORIGMARK;
+    PUSHi( AvFILL(ary) + 1 );
+    RETURN;
+}
+
+PP(pp_pop)
+{
+    dSP;
+    AV *av = (AV*)POPs;
+    SV *sv = av_pop(av);
+    if (sv != &sv_undef && AvREAL(av))
+	(void)sv_2mortal(sv);
+    PUSHs(sv);
+    RETURN;
+}
+
+PP(pp_shift)
+{
+    dSP;
+    AV *av = (AV*)POPs;
+    SV *sv = av_shift(av);
+    EXTEND(SP, 1);
+    if (!sv)
+	RETPUSHUNDEF;
+    if (sv != &sv_undef && AvREAL(av))
+	(void)sv_2mortal(sv);
+    PUSHs(sv);
+    RETURN;
+}
+
+PP(pp_unshift)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    register AV *ary = (AV*)*++MARK;
+    register SV *sv;
+    register I32 i = 0;
+
+    av_unshift(ary, SP - MARK);
+    while (MARK < SP) {
+	sv = NEWSV(27, 0);
+	sv_setsv(sv, *++MARK);
+	(void)av_store(ary, i++, sv);
+    }
+
+    SP = ORIGMARK;
+    PUSHi( AvFILL(ary) + 1 );
+    RETURN;
+}
+
+PP(pp_reverse)
+{
+    dSP; dMARK;
+    register SV *tmp;
+    SV **oldsp = SP;
+
+    if (GIMME == G_ARRAY) {
+	MARK++;
+	while (MARK < SP) {
+	    tmp = *MARK;
+	    *MARK++ = *SP;
+	    *SP-- = tmp;
+	}
+	SP = oldsp;
+    }
+    else {
+	register char *up;
+	register char *down;
+	register I32 tmp;
+	dTARGET;
+	STRLEN len;
+
+	if (SP - MARK > 1)
+	    do_join(TARG, &sv_no, MARK, SP);
+	else
+	    sv_setsv(TARG, *SP);
+	up = SvPV_force(TARG, len);
+	if (len > 1) {
+	    down = SvPVX(TARG) + len - 1;
+	    while (down > up) {
+		tmp = *up;
+		*up++ = *down;
+		*down-- = tmp;
+	    }
+	    (void)SvPOK_only(TARG);
+	}
+	SP = MARK + 1;
+	SETTARG;
+    }
+    RETURN;
+}
+
+/* Explosives and implosives. */
+
+PP(pp_unpack)
+{
+    dSP;
+    dPOPPOPssrl;
+    SV *sv;
+    STRLEN llen;
+    STRLEN rlen;
+    register char *pat = SvPV(left, llen);
+    register char *s = SvPV(right, rlen);
+    char *strend = s + rlen;
+    char *strbeg = s;
+    register char *patend = pat + llen;
+    I32 datumtype;
+    register I32 len;
+    register I32 bits;
+
+    /* These must not be in registers: */
+    I16 ashort;
+    int aint;
+    I32 along;
+#ifdef HAS_QUAD
+    Quad_t aquad;
+#endif
+    U16 aushort;
+    unsigned int auint;
+    U32 aulong;
+#ifdef HAS_QUAD
+    unsigned Quad_t auquad;
+#endif
+    char *aptr;
+    float afloat;
+    double adouble;
+    I32 checksum = 0;
+    register U32 culong;
+    double cdouble;
+    static char* bitcount = 0;
+
+    if (GIMME != G_ARRAY) {		/* arrange to do first one only */
+	/*SUPPRESS 530*/
+	for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
+	if (strchr("aAbBhHP", *patend) || *pat == '%') {
+	    patend++;
+	    while (isDIGIT(*patend) || *patend == '*')
+		patend++;
+	}
+	else
+	    patend++;
+    }
+    while (pat < patend) {
+      reparse:
+	datumtype = *pat++;
+	if (pat >= patend)
+	    len = 1;
+	else if (*pat == '*') {
+	    len = strend - strbeg;	/* long enough */
+	    pat++;
+	}
+	else if (isDIGIT(*pat)) {
+	    len = *pat++ - '0';
+	    while (isDIGIT(*pat))
+		len = (len * 10) + (*pat++ - '0');
+	}
+	else
+	    len = (datumtype != '@');
+	switch(datumtype) {
+	default:
+	    break;
+	case '%':
+	    if (len == 1 && pat[-1] != '1')
+		len = 16;
+	    checksum = len;
+	    culong = 0;
+	    cdouble = 0;
+	    if (pat < patend)
+		goto reparse;
+	    break;
+	case '@':
+	    if (len > strend - strbeg)
+		DIE("@ outside of string");
+	    s = strbeg + len;
+	    break;
+	case 'X':
+	    if (len > s - strbeg)
+		DIE("X outside of string");
+	    s -= len;
+	    break;
+	case 'x':
+	    if (len > strend - s)
+		DIE("x outside of string");
+	    s += len;
+	    break;
+	case 'A':
+	case 'a':
+	    if (len > strend - s)
+		len = strend - s;
+	    if (checksum)
+		goto uchar_checksum;
+	    sv = NEWSV(35, len);
+	    sv_setpvn(sv, s, len);
+	    s += len;
+	    if (datumtype == 'A') {
+		aptr = s;	/* borrow register */
+		s = SvPVX(sv) + len - 1;
+		while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
+		    s--;
+		*++s = '\0';
+		SvCUR_set(sv, s - SvPVX(sv));
+		s = aptr;	/* unborrow register */
+	    }
+	    XPUSHs(sv_2mortal(sv));
+	    break;
+	case 'B':
+	case 'b':
+	    if (pat[-1] == '*' || len > (strend - s) * 8)
+		len = (strend - s) * 8;
+	    if (checksum) {
+		if (!bitcount) {
+		    Newz(601, bitcount, 256, char);
+		    for (bits = 1; bits < 256; bits++) {
+			if (bits & 1)	bitcount[bits]++;
+			if (bits & 2)	bitcount[bits]++;
+			if (bits & 4)	bitcount[bits]++;
+			if (bits & 8)	bitcount[bits]++;
+			if (bits & 16)	bitcount[bits]++;
+			if (bits & 32)	bitcount[bits]++;
+			if (bits & 64)	bitcount[bits]++;
+			if (bits & 128)	bitcount[bits]++;
+		    }
+		}
+		while (len >= 8) {
+		    culong += bitcount[*(unsigned char*)s++];
+		    len -= 8;
+		}
+		if (len) {
+		    bits = *s;
+		    if (datumtype == 'b') {
+			while (len-- > 0) {
+			    if (bits & 1) culong++;
+			    bits >>= 1;
+			}
+		    }
+		    else {
+			while (len-- > 0) {
+			    if (bits & 128) culong++;
+			    bits <<= 1;
+			}
+		    }
+		}
+		break;
+	    }
+	    sv = NEWSV(35, len + 1);
+	    SvCUR_set(sv, len);
+	    SvPOK_on(sv);
+	    aptr = pat;			/* borrow register */
+	    pat = SvPVX(sv);
+	    if (datumtype == 'b') {
+		aint = len;
+		for (len = 0; len < aint; len++) {
+		    if (len & 7)		/*SUPPRESS 595*/
+			bits >>= 1;
+		    else
+			bits = *s++;
+		    *pat++ = '0' + (bits & 1);
+		}
+	    }
+	    else {
+		aint = len;
+		for (len = 0; len < aint; len++) {
+		    if (len & 7)
+			bits <<= 1;
+		    else
+			bits = *s++;
+		    *pat++ = '0' + ((bits & 128) != 0);
+		}
+	    }
+	    *pat = '\0';
+	    pat = aptr;			/* unborrow register */
+	    XPUSHs(sv_2mortal(sv));
+	    break;
+	case 'H':
+	case 'h':
+	    if (pat[-1] == '*' || len > (strend - s) * 2)
+		len = (strend - s) * 2;
+	    sv = NEWSV(35, len + 1);
+	    SvCUR_set(sv, len);
+	    SvPOK_on(sv);
+	    aptr = pat;			/* borrow register */
+	    pat = SvPVX(sv);
+	    if (datumtype == 'h') {
+		aint = len;
+		for (len = 0; len < aint; len++) {
+		    if (len & 1)
+			bits >>= 4;
+		    else
+			bits = *s++;
+		    *pat++ = hexdigit[bits & 15];
+		}
+	    }
+	    else {
+		aint = len;
+		for (len = 0; len < aint; len++) {
+		    if (len & 1)
+			bits <<= 4;
+		    else
+			bits = *s++;
+		    *pat++ = hexdigit[(bits >> 4) & 15];
+		}
+	    }
+	    *pat = '\0';
+	    pat = aptr;			/* unborrow register */
+	    XPUSHs(sv_2mortal(sv));
+	    break;
+	case 'c':
+	    if (len > strend - s)
+		len = strend - s;
+	    if (checksum) {
+		while (len-- > 0) {
+		    aint = *s++;
+		    if (aint >= 128)	/* fake up signed chars */
+			aint -= 256;
+		    culong += aint;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    aint = *s++;
+		    if (aint >= 128)	/* fake up signed chars */
+			aint -= 256;
+		    sv = NEWSV(36, 0);
+		    sv_setiv(sv, (I32)aint);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'C':
+	    if (len > strend - s)
+		len = strend - s;
+	    if (checksum) {
+	      uchar_checksum:
+		while (len-- > 0) {
+		    auint = *s++ & 255;
+		    culong += auint;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    auint = *s++ & 255;
+		    sv = NEWSV(37, 0);
+		    sv_setiv(sv, (I32)auint);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 's':
+	    along = (strend - s) / sizeof(I16);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &ashort, 1, I16);
+		    s += sizeof(I16);
+		    culong += ashort;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &ashort, 1, I16);
+		    s += sizeof(I16);
+		    sv = NEWSV(38, 0);
+		    sv_setiv(sv, (I32)ashort);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'v':
+	case 'n':
+	case 'S':
+	    along = (strend - s) / sizeof(U16);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &aushort, 1, U16);
+		    s += sizeof(U16);
+#ifdef HAS_NTOHS
+		    if (datumtype == 'n')
+			aushort = ntohs(aushort);
+#endif
+#ifdef HAS_VTOHS
+		    if (datumtype == 'v')
+			aushort = vtohs(aushort);
+#endif
+		    culong += aushort;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &aushort, 1, U16);
+		    s += sizeof(U16);
+		    sv = NEWSV(39, 0);
+#ifdef HAS_NTOHS
+		    if (datumtype == 'n')
+			aushort = ntohs(aushort);
+#endif
+#ifdef HAS_VTOHS
+		    if (datumtype == 'v')
+			aushort = vtohs(aushort);
+#endif
+		    sv_setiv(sv, (I32)aushort);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'i':
+	    along = (strend - s) / sizeof(int);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &aint, 1, int);
+		    s += sizeof(int);
+		    if (checksum > 32)
+			cdouble += (double)aint;
+		    else
+			culong += aint;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &aint, 1, int);
+		    s += sizeof(int);
+		    sv = NEWSV(40, 0);
+		    sv_setiv(sv, (I32)aint);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'I':
+	    along = (strend - s) / sizeof(unsigned int);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &auint, 1, unsigned int);
+		    s += sizeof(unsigned int);
+		    if (checksum > 32)
+			cdouble += (double)auint;
+		    else
+			culong += auint;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &auint, 1, unsigned int);
+		    s += sizeof(unsigned int);
+		    sv = NEWSV(41, 0);
+		    sv_setiv(sv, (I32)auint);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'l':
+	    along = (strend - s) / sizeof(I32);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &along, 1, I32);
+		    s += sizeof(I32);
+		    if (checksum > 32)
+			cdouble += (double)along;
+		    else
+			culong += along;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &along, 1, I32);
+		    s += sizeof(I32);
+		    sv = NEWSV(42, 0);
+		    sv_setiv(sv, (I32)along);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'V':
+	case 'N':
+	case 'L':
+	    along = (strend - s) / sizeof(U32);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &aulong, 1, U32);
+		    s += sizeof(U32);
+#ifdef HAS_NTOHL
+		    if (datumtype == 'N')
+			aulong = ntohl(aulong);
+#endif
+#ifdef HAS_VTOHL
+		    if (datumtype == 'V')
+			aulong = vtohl(aulong);
+#endif
+		    if (checksum > 32)
+			cdouble += (double)aulong;
+		    else
+			culong += aulong;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &aulong, 1, U32);
+		    s += sizeof(U32);
+		    sv = NEWSV(43, 0);
+#ifdef HAS_NTOHL
+		    if (datumtype == 'N')
+			aulong = ntohl(aulong);
+#endif
+#ifdef HAS_VTOHL
+		    if (datumtype == 'V')
+			aulong = vtohl(aulong);
+#endif
+		    sv_setnv(sv, (double)aulong);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'p':
+	    along = (strend - s) / sizeof(char*);
+	    if (len > along)
+		len = along;
+	    EXTEND(SP, len);
+	    while (len-- > 0) {
+		if (sizeof(char*) > strend - s)
+		    break;
+		else {
+		    Copy(s, &aptr, 1, char*);
+		    s += sizeof(char*);
+		}
+		sv = NEWSV(44, 0);
+		if (aptr)
+		    sv_setpv(sv, aptr);
+		PUSHs(sv_2mortal(sv));
+	    }
+	    break;
+	case 'P':
+	    EXTEND(SP, 1);
+	    if (sizeof(char*) > strend - s)
+		break;
+	    else {
+		Copy(s, &aptr, 1, char*);
+		s += sizeof(char*);
+	    }
+	    sv = NEWSV(44, 0);
+	    if (aptr)
+		sv_setpvn(sv, aptr, len);
+	    PUSHs(sv_2mortal(sv));
+	    break;
+#ifdef HAS_QUAD
+	case 'q':
+	    EXTEND(SP, len);
+	    while (len-- > 0) {
+		if (s + sizeof(Quad_t) > strend)
+		    aquad = 0;
+		else {
+		    Copy(s, &aquad, 1, Quad_t);
+		    s += sizeof(Quad_t);
+		}
+		sv = NEWSV(42, 0);
+		sv_setiv(sv, (IV)aquad);
+		PUSHs(sv_2mortal(sv));
+	    }
+	    break;
+	case 'Q':
+	    EXTEND(SP, len);
+	    while (len-- > 0) {
+		if (s + sizeof(unsigned Quad_t) > strend)
+		    auquad = 0;
+		else {
+		    Copy(s, &auquad, 1, unsigned Quad_t);
+		    s += sizeof(unsigned Quad_t);
+		}
+		sv = NEWSV(43, 0);
+		sv_setiv(sv, (IV)auquad);
+		PUSHs(sv_2mortal(sv));
+	    }
+	    break;
+#endif
+	/* float and double added gnb@melba.bby.oz.au 22/11/89 */
+	case 'f':
+	case 'F':
+	    along = (strend - s) / sizeof(float);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &afloat, 1, float);
+		    s += sizeof(float);
+		    cdouble += afloat;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &afloat, 1, float);
+		    s += sizeof(float);
+		    sv = NEWSV(47, 0);
+		    sv_setnv(sv, (double)afloat);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'd':
+	case 'D':
+	    along = (strend - s) / sizeof(double);
+	    if (len > along)
+		len = along;
+	    if (checksum) {
+		while (len-- > 0) {
+		    Copy(s, &adouble, 1, double);
+		    s += sizeof(double);
+		    cdouble += adouble;
+		}
+	    }
+	    else {
+		EXTEND(SP, len);
+		while (len-- > 0) {
+		    Copy(s, &adouble, 1, double);
+		    s += sizeof(double);
+		    sv = NEWSV(48, 0);
+		    sv_setnv(sv, (double)adouble);
+		    PUSHs(sv_2mortal(sv));
+		}
+	    }
+	    break;
+	case 'u':
+	    along = (strend - s) * 3 / 4;
+	    sv = NEWSV(42, along);
+	    while (s < strend && *s > ' ' && *s < 'a') {
+		I32 a, b, c, d;
+		char hunk[4];
+
+		hunk[3] = '\0';
+		len = (*s++ - ' ') & 077;
+		while (len > 0) {
+		    if (s < strend && *s >= ' ')
+			a = (*s++ - ' ') & 077;
+		    else
+			a = 0;
+		    if (s < strend && *s >= ' ')
+			b = (*s++ - ' ') & 077;
+		    else
+			b = 0;
+		    if (s < strend && *s >= ' ')
+			c = (*s++ - ' ') & 077;
+		    else
+			c = 0;
+		    if (s < strend && *s >= ' ')
+			d = (*s++ - ' ') & 077;
+		    else
+			d = 0;
+		    hunk[0] = a << 2 | b >> 4;
+		    hunk[1] = b << 4 | c >> 2;
+		    hunk[2] = c << 6 | d;
+		    sv_catpvn(sv, hunk, len > 3 ? 3 : len);
+		    len -= 3;
+		}
+		if (*s == '\n')
+		    s++;
+		else if (s[1] == '\n')		/* possible checksum byte */
+		    s += 2;
+	    }
+	    XPUSHs(sv_2mortal(sv));
+	    break;
+	}
+	if (checksum) {
+	    sv = NEWSV(42, 0);
+	    if (strchr("fFdD", datumtype) ||
+	      (checksum > 32 && strchr("iIlLN", datumtype)) ) {
+		double trouble;
+
+		adouble = 1.0;
+		while (checksum >= 16) {
+		    checksum -= 16;
+		    adouble *= 65536.0;
+		}
+		while (checksum >= 4) {
+		    checksum -= 4;
+		    adouble *= 16.0;
+		}
+		while (checksum--)
+		    adouble *= 2.0;
+		along = (1 << checksum) - 1;
+		while (cdouble < 0.0)
+		    cdouble += adouble;
+		cdouble = modf(cdouble / adouble, &trouble) * adouble;
+		sv_setnv(sv, cdouble);
+	    }
+	    else {
+		if (checksum < 32) {
+		    along = (1 << checksum) - 1;
+		    culong &= (U32)along;
+		}
+		sv_setnv(sv, (double)culong);
+	    }
+	    XPUSHs(sv_2mortal(sv));
+	    checksum = 0;
+	}
+    }
+    RETURN;
+}
+
+static void
+doencodes(sv, s, len)
+register SV *sv;
+register char *s;
+register I32 len;
+{
+    char hunk[5];
+
+    *hunk = len + ' ';
+    sv_catpvn(sv, hunk, 1);
+    hunk[4] = '\0';
+    while (len > 0) {
+	hunk[0] = ' ' + (077 & (*s >> 2));
+	hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
+	hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
+	hunk[3] = ' ' + (077 & (s[2] & 077));
+	sv_catpvn(sv, hunk, 4);
+	s += 3;
+	len -= 3;
+    }
+    for (s = SvPVX(sv); *s; s++) {
+	if (*s == ' ')
+	    *s = '`';
+    }
+    sv_catpvn(sv, "\n", 1);
+}
+
+PP(pp_pack)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    register SV *cat = TARG;
+    register I32 items;
+    STRLEN fromlen;
+    register char *pat = SvPVx(*++MARK, fromlen);
+    register char *patend = pat + fromlen;
+    register I32 len;
+    I32 datumtype;
+    SV *fromstr;
+    /*SUPPRESS 442*/
+    static char null10[] = {0,0,0,0,0,0,0,0,0,0};
+    static char *space10 = "          ";
+
+    /* These must not be in registers: */
+    char achar;
+    I16 ashort;
+    int aint;
+    unsigned int auint;
+    I32 along;
+    U32 aulong;
+#ifdef HAS_QUAD
+    Quad_t aquad;
+    unsigned Quad_t auquad;
+#endif
+    char *aptr;
+    float afloat;
+    double adouble;
+
+    items = SP - MARK;
+    MARK++;
+    sv_setpvn(cat, "", 0);
+    while (pat < patend) {
+#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
+	datumtype = *pat++;
+	if (*pat == '*') {
+	    len = strchr("@Xxu", datumtype) ? 0 : items;
+	    pat++;
+	}
+	else if (isDIGIT(*pat)) {
+	    len = *pat++ - '0';
+	    while (isDIGIT(*pat))
+		len = (len * 10) + (*pat++ - '0');
+	}
+	else
+	    len = 1;
+	switch(datumtype) {
+	default:
+	    break;
+	case '%':
+	    DIE("%% may only be used in unpack");
+	case '@':
+	    len -= SvCUR(cat);
+	    if (len > 0)
+		goto grow;
+	    len = -len;
+	    if (len > 0)
+		goto shrink;
+	    break;
+	case 'X':
+	  shrink:
+	    if (SvCUR(cat) < len)
+		DIE("X outside of string");
+	    SvCUR(cat) -= len;
+	    *SvEND(cat) = '\0';
+	    break;
+	case 'x':
+	  grow:
+	    while (len >= 10) {
+		sv_catpvn(cat, null10, 10);
+		len -= 10;
+	    }
+	    sv_catpvn(cat, null10, len);
+	    break;
+	case 'A':
+	case 'a':
+	    fromstr = NEXTFROM;
+	    aptr = SvPV(fromstr, fromlen);
+	    if (pat[-1] == '*')
+		len = fromlen;
+	    if (fromlen > len)
+		sv_catpvn(cat, aptr, len);
+	    else {
+		sv_catpvn(cat, aptr, fromlen);
+		len -= fromlen;
+		if (datumtype == 'A') {
+		    while (len >= 10) {
+			sv_catpvn(cat, space10, 10);
+			len -= 10;
+		    }
+		    sv_catpvn(cat, space10, len);
+		}
+		else {
+		    while (len >= 10) {
+			sv_catpvn(cat, null10, 10);
+			len -= 10;
+		    }
+		    sv_catpvn(cat, null10, len);
+		}
+	    }
+	    break;
+	case 'B':
+	case 'b':
+	    {
+		char *savepat = pat;
+		I32 saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = SvPV(fromstr, fromlen);
+		if (pat[-1] == '*')
+		    len = fromlen;
+		pat = aptr;
+		aint = SvCUR(cat);
+		SvCUR(cat) += (len+7)/8;
+		SvGROW(cat, SvCUR(cat) + 1);
+		aptr = SvPVX(cat) + aint;
+		if (len > fromlen)
+		    len = fromlen;
+		aint = len;
+		items = 0;
+		if (datumtype == 'B') {
+		    for (len = 0; len++ < aint;) {
+			items |= *pat++ & 1;
+			if (len & 7)
+			    items <<= 1;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		else {
+		    for (len = 0; len++ < aint;) {
+			if (*pat++ & 1)
+			    items |= 128;
+			if (len & 7)
+			    items >>= 1;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		if (aint & 7) {
+		    if (datumtype == 'B')
+			items <<= 7 - (aint & 7);
+		    else
+			items >>= 7 - (aint & 7);
+		    *aptr++ = items & 0xff;
+		}
+		pat = SvPVX(cat) + SvCUR(cat);
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'H':
+	case 'h':
+	    {
+		char *savepat = pat;
+		I32 saveitems;
+
+		fromstr = NEXTFROM;
+		saveitems = items;
+		aptr = SvPV(fromstr, fromlen);
+		if (pat[-1] == '*')
+		    len = fromlen;
+		pat = aptr;
+		aint = SvCUR(cat);
+		SvCUR(cat) += (len+1)/2;
+		SvGROW(cat, SvCUR(cat) + 1);
+		aptr = SvPVX(cat) + aint;
+		if (len > fromlen)
+		    len = fromlen;
+		aint = len;
+		items = 0;
+		if (datumtype == 'H') {
+		    for (len = 0; len++ < aint;) {
+			if (isALPHA(*pat))
+			    items |= ((*pat++ & 15) + 9) & 15;
+			else
+			    items |= *pat++ & 15;
+			if (len & 1)
+			    items <<= 4;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		else {
+		    for (len = 0; len++ < aint;) {
+			if (isALPHA(*pat))
+			    items |= (((*pat++ & 15) + 9) & 15) << 4;
+			else
+			    items |= (*pat++ & 15) << 4;
+			if (len & 1)
+			    items >>= 4;
+			else {
+			    *aptr++ = items & 0xff;
+			    items = 0;
+			}
+		    }
+		}
+		if (aint & 1)
+		    *aptr++ = items & 0xff;
+		pat = SvPVX(cat) + SvCUR(cat);
+		while (aptr <= pat)
+		    *aptr++ = '\0';
+
+		pat = savepat;
+		items = saveitems;
+	    }
+	    break;
+	case 'C':
+	case 'c':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = SvIV(fromstr);
+		achar = aint;
+		sv_catpvn(cat, &achar, sizeof(char));
+	    }
+	    break;
+	/* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
+	case 'f':
+	case 'F':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		afloat = (float)SvNV(fromstr);
+		sv_catpvn(cat, (char *)&afloat, sizeof (float));
+	    }
+	    break;
+	case 'd':
+	case 'D':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		adouble = (double)SvNV(fromstr);
+		sv_catpvn(cat, (char *)&adouble, sizeof (double));
+	    }
+	    break;
+	case 'n':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (I16)SvIV(fromstr);
+#ifdef HAS_HTONS
+		ashort = htons(ashort);
+#endif
+		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+	    }
+	    break;
+	case 'v':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (I16)SvIV(fromstr);
+#ifdef HAS_HTOVS
+		ashort = htovs(ashort);
+#endif
+		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+	    }
+	    break;
+	case 'S':
+	case 's':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		ashort = (I16)SvIV(fromstr);
+		sv_catpvn(cat, (char*)&ashort, sizeof(I16));
+	    }
+	    break;
+	case 'I':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auint = U_I(SvNV(fromstr));
+		sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
+	    }
+	    break;
+	case 'i':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aint = SvIV(fromstr);
+		sv_catpvn(cat, (char*)&aint, sizeof(int));
+	    }
+	    break;
+	case 'N':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(SvNV(fromstr));
+#ifdef HAS_HTONL
+		aulong = htonl(aulong);
+#endif
+		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+	    }
+	    break;
+	case 'V':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(SvNV(fromstr));
+#ifdef HAS_HTOVL
+		aulong = htovl(aulong);
+#endif
+		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+	    }
+	    break;
+	case 'L':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aulong = U_L(SvNV(fromstr));
+		sv_catpvn(cat, (char*)&aulong, sizeof(U32));
+	    }
+	    break;
+	case 'l':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		along = SvIV(fromstr);
+		sv_catpvn(cat, (char*)&along, sizeof(I32));
+	    }
+	    break;
+#ifdef HAS_QUAD
+	case 'Q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		auquad = (unsigned Quad_t)SvIV(fromstr);
+		sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
+	    }
+	    break;
+	case 'q':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aquad = (Quad_t)SvIV(fromstr);
+		sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
+	    }
+	    break;
+#endif /* HAS_QUAD */
+	case 'P':
+	    len = 1;		/* assume SV is correct length */
+	    /* FALL THROUGH */
+	case 'p':
+	    while (len-- > 0) {
+		fromstr = NEXTFROM;
+		aptr = SvPV_force(fromstr, na);	/* XXX Error if TEMP? */
+		sv_catpvn(cat, (char*)&aptr, sizeof(char*));
+	    }
+	    break;
+	case 'u':
+	    fromstr = NEXTFROM;
+	    aptr = SvPV(fromstr, fromlen);
+	    SvGROW(cat, fromlen * 4 / 3);
+	    if (len <= 1)
+		len = 45;
+	    else
+		len = len / 3 * 3;
+	    while (fromlen > 0) {
+		I32 todo;
+
+		if (fromlen > len)
+		    todo = len;
+		else
+		    todo = fromlen;
+		doencodes(cat, aptr, todo);
+		fromlen -= todo;
+		aptr += todo;
+	    }
+	    break;
+	}
+    }
+    SvSETMAGIC(cat);
+    SP = ORIGMARK;
+    PUSHs(cat);
+    RETURN;
+}
+#undef NEXTFROM
+
+PP(pp_split)
+{
+    dSP; dTARG;
+    AV *ary;
+    register I32 limit = POPi;			/* note, negative is forever */
+    SV *sv = POPs;
+    STRLEN len;
+    register char *s = SvPV(sv, len);
+    char *strend = s + len;
+    register PMOP *pm = (PMOP*)POPs;
+    register SV *dstr;
+    register char *m;
+    I32 iters = 0;
+    I32 maxiters = (strend - s) + 10;
+    I32 i;
+    char *orig;
+    I32 origlimit = limit;
+    I32 realarray = 0;
+    I32 base;
+    AV *oldstack = stack;
+    register REGEXP *rx = pm->op_pmregexp;
+    I32 gimme = GIMME;
+    I32 oldsave = savestack_ix;
+
+    if (!pm || !s)
+	DIE("panic: do_split");
+    if (pm->op_pmreplroot)
+	ary = GvAVn((GV*)pm->op_pmreplroot);
+    else if (gimme != G_ARRAY)
+	ary = GvAVn(defgv);
+    else
+	ary = Nullav;
+    if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
+	realarray = 1;
+	if (!AvREAL(ary)) {
+	    AvREAL_on(ary);
+	    for (i = AvFILL(ary); i >= 0; i--)
+		AvARRAY(ary)[i] = &sv_undef;	/* don't free mere refs */
+	}
+	av_extend(ary,0);
+	av_clear(ary);
+	/* temporarily switch stacks */
+	SWITCHSTACK(stack, ary);
+    }
+    base = SP - stack_base;
+    orig = s;
+    if (pm->op_pmflags & PMf_SKIPWHITE) {
+	while (isSPACE(*s))
+	    s++;
+    }
+    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+	SAVEINT(multiline);
+	multiline = pm->op_pmflags & PMf_MULTILINE;
+    }
+
+    if (!limit)
+	limit = maxiters + 2;
+    if (pm->op_pmflags & PMf_WHITE) {
+	while (--limit) {
+	    /*SUPPRESS 530*/
+	    for (m = s; m < strend && !isSPACE(*m); m++) ;
+	    if (m >= strend)
+		break;
+	    dstr = NEWSV(30, m-s);
+	    sv_setpvn(dstr, s, m-s);
+	    if (!realarray)
+		sv_2mortal(dstr);
+	    XPUSHs(dstr);
+	    /*SUPPRESS 530*/
+	    for (s = m + 1; s < strend && isSPACE(*s); s++) ;
+	}
+    }
+    else if (strEQ("^", rx->precomp)) {
+	while (--limit) {
+	    /*SUPPRESS 530*/
+	    for (m = s; m < strend && *m != '\n'; m++) ;
+	    m++;
+	    if (m >= strend)
+		break;
+	    dstr = NEWSV(30, m-s);
+	    sv_setpvn(dstr, s, m-s);
+	    if (!realarray)
+		sv_2mortal(dstr);
+	    XPUSHs(dstr);
+	    s = m;
+	}
+    }
+    else if (pm->op_pmshort) {
+	i = SvCUR(pm->op_pmshort);
+	if (i == 1) {
+	    I32 fold = (pm->op_pmflags & PMf_FOLD);
+	    i = *SvPVX(pm->op_pmshort);
+	    if (fold && isUPPER(i))
+		i = toLOWER(i);
+	    while (--limit) {
+		if (fold) {
+		    for ( m = s;
+			  m < strend && *m != i &&
+			    (!isUPPER(*m) || toLOWER(*m) != i);
+			  m++)			/*SUPPRESS 530*/
+			;
+		}
+		else				/*SUPPRESS 530*/
+		    for (m = s; m < strend && *m != i; m++) ;
+		if (m >= strend)
+		    break;
+		dstr = NEWSV(30, m-s);
+		sv_setpvn(dstr, s, m-s);
+		if (!realarray)
+		    sv_2mortal(dstr);
+		XPUSHs(dstr);
+		s = m + 1;
+	    }
+	}
+	else {
+#ifndef lint
+	    while (s < strend && --limit &&
+	      (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
+		    pm->op_pmshort)) )
+#endif
+	    {
+		dstr = NEWSV(31, m-s);
+		sv_setpvn(dstr, s, m-s);
+		if (!realarray)
+		    sv_2mortal(dstr);
+		XPUSHs(dstr);
+		s = m + i;
+	    }
+	}
+    }
+    else {
+	maxiters += (strend - s) * rx->nparens;
+	while (s < strend && --limit &&
+	    pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
+	    if (rx->subbase
+	      && rx->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = rx->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = rx->startp[0];
+	    dstr = NEWSV(32, m-s);
+	    sv_setpvn(dstr, s, m-s);
+	    if (!realarray)
+		sv_2mortal(dstr);
+	    XPUSHs(dstr);
+	    if (rx->nparens) {
+		for (i = 1; i <= rx->nparens; i++) {
+		    s = rx->startp[i];
+		    m = rx->endp[i];
+		    if (m && s) {
+			dstr = NEWSV(33, m-s);
+			sv_setpvn(dstr, s, m-s);
+		    }
+		    else
+			dstr = NEWSV(33, 0);
+		    if (!realarray)
+			sv_2mortal(dstr);
+		    XPUSHs(dstr);
+		}
+	    }
+	    s = rx->endp[0];
+	}
+    }
+    LEAVE_SCOPE(oldsave);
+    iters = (SP - stack_base) - base;
+    if (iters > maxiters)
+	DIE("Split loop");
+    
+    /* keep field after final delim? */
+    if (s < strend || (iters && origlimit)) {
+	dstr = NEWSV(34, strend-s);
+	sv_setpvn(dstr, s, strend-s);
+	if (!realarray)
+	    sv_2mortal(dstr);
+	XPUSHs(dstr);
+	iters++;
+    }
+    else if (!origlimit) {
+	while (iters > 0 && SvCUR(TOPs) == 0)
+	    iters--, SP--;
+    }
+    if (realarray) {
+	SWITCHSTACK(ary, oldstack);
+	if (gimme == G_ARRAY) {
+	    EXTEND(SP, iters);
+	    Copy(AvARRAY(ary), SP + 1, iters, SV*);
+	    SP += iters;
+	    RETURN;
+	}
+    }
+    else {
+	if (gimme == G_ARRAY)
+	    RETURN;
+    }
+    if (iters || !pm->op_pmreplroot) {
+	GETTARGET;
+	PUSHi(iters);
+	RETURN;
+    }
+    RETPUSHUNDEF;
+}
+
diff --git a/gnu/usr.bin/perl/pp.h b/gnu/usr.bin/perl/pp.h
new file mode 100644
index 00000000000..44a3ebeb723
--- /dev/null
+++ b/gnu/usr.bin/perl/pp.h
@@ -0,0 +1,193 @@
+/*    pp.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#define ARGS
+#define ARGSproto void
+#define dARGS
+#define PP(s) OP* s(ARGS) dARGS
+
+#define SP sp
+#define MARK mark
+#define TARG targ
+
+#define PUSHMARK(p) if (++markstack_ptr == markstack_max)	\
+			markstack_grow();			\
+		    *markstack_ptr = (p) - stack_base
+
+#define TOPMARK		(*markstack_ptr)
+#define POPMARK		(*markstack_ptr--)
+
+#define dSP		register SV **sp = stack_sp
+#define dMARK		register SV **mark = stack_base + POPMARK
+#define dORIGMARK	I32 origmark = mark - stack_base
+#define SETORIGMARK	origmark = mark - stack_base
+#define ORIGMARK	(stack_base + origmark)
+
+#define SPAGAIN		sp = stack_sp
+#define MSPAGAIN	sp = stack_sp; mark = ORIGMARK
+
+#define GETTARGETSTACKED targ = (op->op_flags & OPf_STACKED ? POPs : PAD_SV(op->op_targ))
+#define dTARGETSTACKED SV * GETTARGETSTACKED
+
+#define GETTARGET targ = PAD_SV(op->op_targ)
+#define dTARGET SV * GETTARGET
+
+#define GETATARGET targ = (op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(op->op_targ))
+#define dATARGET SV * GETATARGET
+
+#define dTARG SV *targ
+
+#define NORMAL op->op_next
+#define DIE return die
+
+#define PUTBACK		stack_sp = sp
+#define RETURN		return PUTBACK, NORMAL
+#define RETURNOP(o)	return PUTBACK, o
+#define RETURNX(x)	return x, PUTBACK, NORMAL
+
+#define POPs		(*sp--)
+#define POPp		(SvPVx(POPs, na))
+#define POPn		(SvNVx(POPs))
+#define POPi		((IV)SvIVx(POPs))
+#define POPl		((long)SvIVx(POPs))
+
+#define TOPs		(*sp)
+#define TOPp		(SvPV(TOPs, na))
+#define TOPn		(SvNV(TOPs))
+#define TOPi		((IV)SvIV(TOPs))
+#define TOPl		((long)SvIV(TOPs))
+
+/* Go to some pains in the rare event that we must extend the stack. */
+#define EXTEND(p,n)	STMT_START { if (stack_max - p < (n)) {		  	    \
+			    sp = stack_grow(sp,p, (int) (n));		    \
+			} } STMT_END
+
+/* Same thing, but update mark register too. */
+#define MEXTEND(p,n)	STMT_START {if (stack_max - p < (n)) {			    \
+			    int markoff = mark - stack_base;		    \
+			    sp = stack_grow(sp,p,(int) (n));		    \
+			    mark = stack_base + markoff;		    \
+			} } STMT_END
+
+#define PUSHs(s)	(*++sp = (s))
+#define PUSHTARG	STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
+#define PUSHp(p,l)	STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
+#define PUSHn(n)	STMT_START { sv_setnv(TARG, (double)(n)); PUSHTARG; } STMT_END
+#define PUSHi(i)	STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
+
+#define XPUSHs(s)	STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
+#define XPUSHTARG	STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
+#define XPUSHp(p,l)	STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
+#define XPUSHn(n)	STMT_START { sv_setnv(TARG, (double)(n)); XPUSHTARG; } STMT_END
+#define XPUSHi(i)	STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
+
+#define SETs(s)		(*sp = s)
+#define SETTARG		STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
+#define SETp(p,l)	STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
+#define SETn(n)		STMT_START { sv_setnv(TARG, (double)(n)); SETTARG; } STMT_END
+#define SETi(i)		STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
+
+#ifdef OVERLOAD
+#define SETsv(sv)	STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
+#endif /* OVERLOAD */
+
+#define dTOPss		SV *sv = TOPs
+#define dPOPss		SV *sv = POPs
+#define dTOPnv		double value = TOPn
+#define dPOPnv		double value = POPn
+#define dTOPiv		IV value = TOPi
+#define dPOPiv		IV value = POPi
+
+#define dPOPPOPssrl	SV *right = POPs; SV *left = POPs
+#define dPOPPOPnnrl	double right = POPn; double left = POPn
+#define dPOPPOPiirl	IV right = POPi; IV left = POPi
+
+#define dPOPTOPssrl	SV *right = POPs; SV *left = TOPs
+#define dPOPTOPnnrl	double right = POPn; double left = TOPn
+#define dPOPTOPiirl	IV right = POPi; IV left = TOPi
+
+#define RETPUSHYES	RETURNX(PUSHs(&sv_yes))
+#define RETPUSHNO	RETURNX(PUSHs(&sv_no))
+#define RETPUSHUNDEF	RETURNX(PUSHs(&sv_undef))
+
+#define RETSETYES	RETURNX(SETs(&sv_yes))
+#define RETSETNO	RETURNX(SETs(&sv_no))
+#define RETSETUNDEF	RETURNX(SETs(&sv_undef))
+
+#define ARGTARG		op->op_targ
+#define MAXARG		op->op_private
+
+#define SWITCHSTACK(f,t)	AvFILL(f) = sp - stack_base;		\
+				stack_base = AvARRAY(t);		\
+				stack_max = stack_base + AvMAX(t);	\
+				sp = stack_sp = stack_base + AvFILL(t);	\
+				stack = t;
+
+#ifdef OVERLOAD
+
+#define AMGf_noright	1
+#define AMGf_noleft	2
+#define AMGf_assign	4
+#define AMGf_unary	8
+
+#define tryAMAGICbinW(meth,assign,set) STMT_START { \
+          if (amagic_generation) { \
+	    SV* tmpsv; \
+	    SV* right= *(sp); SV* left= *(sp-1);\
+	    if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
+		(tmpsv=amagic_call(left, \
+				   right, \
+				   CAT2(meth,_amg), \
+				   (assign)? AMGf_assign: 0))) {\
+	       SPAGAIN;	\
+	       (void)POPs; set(tmpsv); RETURN; } \
+	  } \
+	} STMT_END
+
+#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
+#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
+
+#define AMG_CALLun(sv,meth) amagic_call(sv,&sv_undef,  \
+					CAT2(meth,_amg),AMGf_noright | AMGf_unary)
+#define AMG_CALLbinL(left,right,meth) \
+            amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
+
+#define tryAMAGICunW(meth,set) STMT_START { \
+          if (amagic_generation) { \
+	    SV* tmpsv; \
+	    SV* arg= *(sp); \
+	    if ((SvAMAGIC(arg))&&\
+		(tmpsv=AMG_CALLun(arg,meth))) {\
+	       SPAGAIN;	\
+	       set(tmpsv); RETURN; } \
+	  } \
+	} STMT_END
+
+#define tryAMAGICun(meth) tryAMAGICunW(meth,SETsv)
+#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs)
+
+#define opASSIGN (op->op_flags & OPf_STACKED)
+
+/* newSVsv does not behave as advertised, so we copy missing
+ * information by hand */
+
+
+#define RvDEEPCP(rv) STMT_START { SV* ref=SvRV(rv);      \
+  if (SvREFCNT(ref)>1) {                 \
+    SvREFCNT_dec(ref);                   \
+    SvRV(rv)=AMG_CALLun(rv,copy);        \
+  } } STMT_END
+#else
+
+#define tryAMAGICbin(a,b)
+#define tryAMAGICbinSET(a,b)
+#define tryAMAGICun(a)
+#define tryAMAGICunSET(a)
+
+#endif /* OVERLOAD */
diff --git a/gnu/usr.bin/perl/pp_ctl.c b/gnu/usr.bin/perl/pp_ctl.c
new file mode 100644
index 00000000000..e57e88a1679
--- /dev/null
+++ b/gnu/usr.bin/perl/pp_ctl.c
@@ -0,0 +1,2493 @@
+/*    pp_ctl.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * Now far ahead the Road has gone,
+ * And I must follow, if I can,
+ * Pursuing it with eager feet,
+ * Until it joins some larger way
+ * Where many paths and errands meet.
+ * And whither then?  I cannot say.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifndef WORD_ALIGN
+#define WORD_ALIGN sizeof(U16)
+#endif
+
+static OP *doeval _((int gimme));
+static OP *dofindlabel _((OP *op, char *label, OP **opstack));
+static void doparseform _((SV *sv));
+static I32 dopoptoeval _((I32 startingblock));
+static I32 dopoptolabel _((char *label));
+static I32 dopoptoloop _((I32 startingblock));
+static I32 dopoptosub _((I32 startingblock));
+static void save_lines _((AV *array, SV *sv));
+static int sortcmp _((const void *, const void *));
+static int sortcv _((const void *, const void *));
+
+static I32 sortcxix;
+
+PP(pp_wantarray)
+{
+    dSP;
+    I32 cxix;
+    EXTEND(SP, 1);
+
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0)
+	RETPUSHUNDEF;
+
+    if (cxstack[cxix].blk_gimme == G_ARRAY)
+	RETPUSHYES;
+    else
+	RETPUSHNO;
+}
+
+PP(pp_regcmaybe)
+{
+    return NORMAL;
+}
+
+PP(pp_regcomp) {
+    dSP;
+    register PMOP *pm = (PMOP*)cLOGOP->op_other;
+    register char *t;
+    SV *tmpstr;
+    STRLEN len;
+
+    tmpstr = POPs;
+    t = SvPV(tmpstr, len);
+
+    /* JMR: Check against the last compiled regexp */
+    if ( ! pm->op_pmregexp  || ! pm->op_pmregexp->precomp
+	|| strnNE(pm->op_pmregexp->precomp, t, len) 
+	|| pm->op_pmregexp->precomp[len]) {
+	if (pm->op_pmregexp) {
+	    pregfree(pm->op_pmregexp);
+	    pm->op_pmregexp = Null(REGEXP*);	/* crucial if regcomp aborts */
+	}
+
+	pm->op_pmflags = pm->op_pmpermflags;	/* reset case sensitivity */
+	pm->op_pmregexp = pregcomp(t, t + len, pm);
+    }
+
+    if (!pm->op_pmregexp->prelen && curpm)
+	pm = curpm;
+    else if (strEQ("\\s+", pm->op_pmregexp->precomp))
+	pm->op_pmflags |= PMf_WHITE;
+
+    if (pm->op_pmflags & PMf_KEEP) {
+	pm->op_pmflags &= ~PMf_RUNTIME;	/* no point compiling again */
+	hoistmust(pm);
+	cLOGOP->op_first->op_next = op->op_next;
+    }
+    RETURN;
+}
+
+PP(pp_substcont)
+{
+    dSP;
+    register PMOP *pm = (PMOP*) cLOGOP->op_other;
+    register CONTEXT *cx = &cxstack[cxstack_ix];
+    register SV *dstr = cx->sb_dstr;
+    register char *s = cx->sb_s;
+    register char *m = cx->sb_m;
+    char *orig = cx->sb_orig;
+    register REGEXP *rx = cx->sb_rx;
+
+    if (cx->sb_iters++) {
+	if (cx->sb_iters > cx->sb_maxiters)
+	    DIE("Substitution loop");
+
+	sv_catsv(dstr, POPs);
+	if (rx->subbase)
+	    Safefree(rx->subbase);
+	rx->subbase = cx->sb_subbase;
+
+	/* Are we done */
+	if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
+				s == m, Nullsv, cx->sb_safebase))
+	{
+	    SV *targ = cx->sb_targ;
+	    sv_catpvn(dstr, s, cx->sb_strend - s);
+
+	    (void)SvOOK_off(targ);
+	    Safefree(SvPVX(targ));
+	    SvPVX(targ) = SvPVX(dstr);
+	    SvCUR_set(targ, SvCUR(dstr));
+	    SvLEN_set(targ, SvLEN(dstr));
+	    SvPVX(dstr) = 0;
+	    sv_free(dstr);
+
+	    (void)SvPOK_only(targ);
+	    SvSETMAGIC(targ);
+	    PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+	    LEAVE_SCOPE(cx->sb_oldsave);
+	    POPSUBST(cx);
+	    RETURNOP(pm->op_next);
+	}
+    }
+    if (rx->subbase && rx->subbase != orig) {
+	m = s;
+	s = orig;
+	cx->sb_orig = orig = rx->subbase;
+	s = orig + (m - s);
+	cx->sb_strend = s + (cx->sb_strend - m);
+    }
+    cx->sb_m = m = rx->startp[0];
+    sv_catpvn(dstr, s, m-s);
+    cx->sb_s = rx->endp[0];
+    cx->sb_subbase = rx->subbase;
+
+    rx->subbase = Nullch;	/* so recursion works */
+    RETURNOP(pm->op_pmreplstart);
+}
+
+PP(pp_formline)
+{
+    dSP; dMARK; dORIGMARK;
+    register SV *form = *++MARK;
+    register U16 *fpc;
+    register char *t;
+    register char *f;
+    register char *s;
+    register char *send;
+    register I32 arg;
+    register SV *sv;
+    char *item;
+    I32 itemsize;
+    I32 fieldsize;
+    I32 lines = 0;
+    bool chopspace = (strchr(chopset, ' ') != Nullch);
+    char *chophere;
+    char *linemark;
+    double value;
+    bool gotsome;
+    STRLEN len;
+
+    if (!SvCOMPILED(form)) {
+	SvREADONLY_off(form);
+	doparseform(form);
+    }
+
+    SvPV_force(formtarget, len);
+    t = SvGROW(formtarget, len + SvCUR(form) + 1);  /* XXX SvCUR bad */
+    t += len;
+    f = SvPV(form, len);
+    /* need to jump to the next word */
+    s = f + len + WORD_ALIGN - SvCUR(form) % WORD_ALIGN;
+
+    fpc = (U16*)s;
+
+    for (;;) {
+	DEBUG_f( {
+	    char *name = "???";
+	    arg = -1;
+	    switch (*fpc) {
+	    case FF_LITERAL:	arg = fpc[1]; name = "LITERAL";	break;
+	    case FF_BLANK:	arg = fpc[1]; name = "BLANK";	break;
+	    case FF_SKIP:	arg = fpc[1]; name = "SKIP";	break;
+	    case FF_FETCH:	arg = fpc[1]; name = "FETCH";	break;
+	    case FF_DECIMAL:	arg = fpc[1]; name = "DECIMAL";	break;
+
+	    case FF_CHECKNL:	name = "CHECKNL";	break;
+	    case FF_CHECKCHOP:	name = "CHECKCHOP";	break;
+	    case FF_SPACE:	name = "SPACE";		break;
+	    case FF_HALFSPACE:	name = "HALFSPACE";	break;
+	    case FF_ITEM:	name = "ITEM";		break;
+	    case FF_CHOP:	name = "CHOP";		break;
+	    case FF_LINEGLOB:	name = "LINEGLOB";	break;
+	    case FF_NEWLINE:	name = "NEWLINE";	break;
+	    case FF_MORE:	name = "MORE";		break;
+	    case FF_LINEMARK:	name = "LINEMARK";	break;
+	    case FF_END:	name = "END";		break;
+	    }
+	    if (arg >= 0)
+		fprintf(stderr, "%-16s%ld\n", name, (long) arg);
+	    else
+		fprintf(stderr, "%-16s\n", name);
+	} )
+	switch (*fpc++) {
+	case FF_LINEMARK:
+	    linemark = t;
+	    lines++;
+	    gotsome = FALSE;
+	    break;
+
+	case FF_LITERAL:
+	    arg = *fpc++;
+	    while (arg--)
+		*t++ = *f++;
+	    break;
+
+	case FF_SKIP:
+	    f += *fpc++;
+	    break;
+
+	case FF_FETCH:
+	    arg = *fpc++;
+	    f += arg;
+	    fieldsize = arg;
+
+	    if (MARK < SP)
+		sv = *++MARK;
+	    else {
+		sv = &sv_no;
+		if (dowarn)
+		    warn("Not enough format arguments");
+	    }
+	    break;
+
+	case FF_CHECKNL:
+	    item = s = SvPV(sv, len);
+	    itemsize = len;
+	    if (itemsize > fieldsize)
+		itemsize = fieldsize;
+	    send = chophere = s + itemsize;
+	    while (s < send) {
+		if (*s & ~31)
+		    gotsome = TRUE;
+		else if (*s == '\n')
+		    break;
+		s++;
+	    }
+	    itemsize = s - item;
+	    break;
+
+	case FF_CHECKCHOP:
+	    item = s = SvPV(sv, len);
+	    itemsize = len;
+	    if (itemsize <= fieldsize) {
+		send = chophere = s + itemsize;
+		while (s < send) {
+		    if (*s == '\r') {
+			itemsize = s - item;
+			break;
+		    }
+		    if (*s++ & ~31)
+			gotsome = TRUE;
+		}
+	    }
+	    else {
+		itemsize = fieldsize;
+		send = chophere = s + itemsize;
+		while (s < send || (s == send && isSPACE(*s))) {
+		    if (isSPACE(*s)) {
+			if (chopspace)
+			    chophere = s;
+			if (*s == '\r')
+			    break;
+		    }
+		    else {
+			if (*s & ~31)
+			    gotsome = TRUE;
+			if (strchr(chopset, *s))
+			    chophere = s + 1;
+		    }
+		    s++;
+		}
+		itemsize = chophere - item;
+	    }
+	    break;
+
+	case FF_SPACE:
+	    arg = fieldsize - itemsize;
+	    if (arg) {
+		fieldsize -= arg;
+		while (arg-- > 0)
+		    *t++ = ' ';
+	    }
+	    break;
+
+	case FF_HALFSPACE:
+	    arg = fieldsize - itemsize;
+	    if (arg) {
+		arg /= 2;
+		fieldsize -= arg;
+		while (arg-- > 0)
+		    *t++ = ' ';
+	    }
+	    break;
+
+	case FF_ITEM:
+	    arg = itemsize;
+	    s = item;
+	    while (arg--) {
+#if 'z' - 'a' != 25
+		int ch = *t++ = *s++;
+		if (!iscntrl(ch))
+		    t[-1] = ' ';
+#else
+		if ( !((*t++ = *s++) & ~31) )
+		    t[-1] = ' ';
+#endif
+
+	    }
+	    break;
+
+	case FF_CHOP:
+	    s = chophere;
+	    if (chopspace) {
+		while (*s && isSPACE(*s))
+		    s++;
+	    }
+	    sv_chop(sv,s);
+	    break;
+
+	case FF_LINEGLOB:
+	    item = s = SvPV(sv, len);
+	    itemsize = len;
+	    if (itemsize) {
+		gotsome = TRUE;
+		send = s + itemsize;
+		while (s < send) {
+		    if (*s++ == '\n') {
+			if (s == send)
+			    itemsize--;
+			else
+			    lines++;
+		    }
+		}
+		SvCUR_set(formtarget, t - SvPVX(formtarget));
+		sv_catpvn(formtarget, item, itemsize);
+		SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
+		t = SvPVX(formtarget) + SvCUR(formtarget);
+	    }
+	    break;
+
+	case FF_DECIMAL:
+	    /* If the field is marked with ^ and the value is undefined,
+	       blank it out. */
+	    arg = *fpc++;
+	    if ((arg & 512) && !SvOK(sv)) {
+		arg = fieldsize;
+		while (arg--)
+		    *t++ = ' ';
+		break;
+	    }
+	    gotsome = TRUE;
+	    value = SvNV(sv);
+	    if (arg & 256) {
+		sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value);
+	    } else {
+		sprintf(t, "%*.0f", (int) fieldsize, value);
+	    }
+	    t += fieldsize;
+	    break;
+
+	case FF_NEWLINE:
+	    f++;
+	    while (t-- > linemark && *t == ' ') ;
+	    t++;
+	    *t++ = '\n';
+	    break;
+
+	case FF_BLANK:
+	    arg = *fpc++;
+	    if (gotsome) {
+		if (arg) {		/* repeat until fields exhausted? */
+		    *t = '\0';
+		    SvCUR_set(formtarget, t - SvPVX(formtarget));
+		    lines += FmLINES(formtarget);
+		    if (lines == 200) {
+			arg = t - linemark;
+			if (strnEQ(linemark, linemark - arg, arg))
+			    DIE("Runaway format");
+		    }
+		    FmLINES(formtarget) = lines;
+		    SP = ORIGMARK;
+		    RETURNOP(cLISTOP->op_first);
+		}
+	    }
+	    else {
+		t = linemark;
+		lines--;
+	    }
+	    break;
+
+	case FF_MORE:
+	    if (itemsize) {
+		arg = fieldsize - itemsize;
+		if (arg) {
+		    fieldsize -= arg;
+		    while (arg-- > 0)
+			*t++ = ' ';
+		}
+		s = t - 3;
+		if (strnEQ(s,"   ",3)) {
+		    while (s > SvPVX(formtarget) && isSPACE(s[-1]))
+			s--;
+		}
+		*s++ = '.';
+		*s++ = '.';
+		*s++ = '.';
+	    }
+	    break;
+
+	case FF_END:
+	    *t = '\0';
+	    SvCUR_set(formtarget, t - SvPVX(formtarget));
+	    FmLINES(formtarget) += lines;
+	    SP = ORIGMARK;
+	    RETPUSHYES;
+	}
+    }
+}
+
+PP(pp_grepstart)
+{
+    dSP;
+    SV *src;
+
+    if (stack_base + *markstack_ptr == sp) {
+	(void)POPMARK;
+	if (GIMME != G_ARRAY)
+	    XPUSHs(&sv_no);
+	RETURNOP(op->op_next->op_next);
+    }
+    stack_sp = stack_base + *markstack_ptr + 1;
+    pp_pushmark();				/* push dst */
+    pp_pushmark();				/* push src */
+    ENTER;					/* enter outer scope */
+
+    SAVETMPS;
+    SAVESPTR(GvSV(defgv));
+
+    ENTER;					/* enter inner scope */
+    SAVESPTR(curpm);
+
+    src = stack_base[*markstack_ptr];
+    SvTEMP_off(src);
+    GvSV(defgv) = src;
+
+    PUTBACK;
+    if (op->op_type == OP_MAPSTART)
+	pp_pushmark();				/* push top */
+    return ((LOGOP*)op->op_next)->op_other;
+}
+
+PP(pp_mapstart)
+{
+    DIE("panic: mapstart");	/* uses grepstart */
+}
+
+PP(pp_mapwhile)
+{
+    dSP;
+    I32 diff = (sp - stack_base) - *markstack_ptr;
+    I32 count;
+    I32 shift;
+    SV** src;
+    SV** dst; 
+
+    ++markstack_ptr[-1];
+    if (diff) {
+	if (diff > markstack_ptr[-1] - markstack_ptr[-2]) {
+	    shift = diff - (markstack_ptr[-1] - markstack_ptr[-2]);
+	    count = (sp - stack_base) - markstack_ptr[-1] + 2;
+	    
+	    EXTEND(sp,shift);
+	    src = sp;
+	    dst = (sp += shift);
+	    markstack_ptr[-1] += shift;
+	    *markstack_ptr += shift;
+	    while (--count)
+		*dst-- = *src--;
+	}
+	dst = stack_base + (markstack_ptr[-2] += diff) - 1; 
+	++diff;
+	while (--diff)
+	    *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs); 
+    }
+    LEAVE;					/* exit inner scope */
+
+    /* All done yet? */
+    if (markstack_ptr[-1] > *markstack_ptr) {
+	I32 items;
+
+	(void)POPMARK;				/* pop top */
+	LEAVE;					/* exit outer scope */
+	(void)POPMARK;				/* pop src */
+	items = --*markstack_ptr - markstack_ptr[-1];
+	(void)POPMARK;				/* pop dst */
+	SP = stack_base + POPMARK;		/* pop original mark */
+	if (GIMME != G_ARRAY) {
+	    dTARGET;
+	    XPUSHi(items);
+	    RETURN;
+	}
+	SP += items;
+	RETURN;
+    }
+    else {
+	SV *src;
+
+	ENTER;					/* enter inner scope */
+	SAVESPTR(curpm);
+
+	src = stack_base[markstack_ptr[-1]];
+	SvTEMP_off(src);
+	GvSV(defgv) = src;
+
+	RETURNOP(cLOGOP->op_other);
+    }
+}
+
+
+PP(pp_sort)
+{
+    dSP; dMARK; dORIGMARK;
+    register SV **up;
+    SV **myorigmark = ORIGMARK;
+    register I32 max;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+    I32 gimme = GIMME;
+    OP* nextop = op->op_next;
+
+    if (gimme != G_ARRAY) {
+	SP = MARK;
+	RETPUSHUNDEF;
+    }
+
+    if (op->op_flags & OPf_STACKED) {
+	ENTER;
+	if (op->op_flags & OPf_SPECIAL) {
+	    OP *kid = cLISTOP->op_first->op_sibling;	/* pass pushmark */
+	    kid = kUNOP->op_first;			/* pass rv2gv */
+	    kid = kUNOP->op_first;			/* pass leave */
+	    sortcop = kid->op_next;
+	    stash = curcop->cop_stash;
+	}
+	else {
+	    cv = sv_2cv(*++MARK, &stash, &gv, 0);
+	    if (!(cv && CvROOT(cv))) {
+		if (gv) {
+		    SV *tmpstr = sv_newmortal();
+		    gv_efullname(tmpstr, gv);
+		    if (cv && CvXSUB(cv))
+			DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr));
+		    DIE("Undefined sort subroutine \"%s\" called",
+			SvPVX(tmpstr));
+		}
+		if (cv) {
+		    if (CvXSUB(cv))
+			DIE("Xsub called in sort");
+		    DIE("Undefined subroutine in sort");
+		}
+		DIE("Not a CODE reference in sort");
+	    }
+	    sortcop = CvSTART(cv);
+	    SAVESPTR(CvROOT(cv)->op_ppaddr);
+	    CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
+	    
+	    SAVESPTR(curpad);
+	    curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+	}
+    }
+    else {
+	sortcop = Nullop;
+	stash = curcop->cop_stash;
+    }
+
+    up = myorigmark + 1;
+    while (MARK < SP) {	/* This may or may not shift down one here. */
+	/*SUPPRESS 560*/
+	if (*up = *++MARK) {			/* Weed out nulls. */
+	    if (!SvPOK(*up))
+		(void)sv_2pv(*up, &na);
+	    else
+		SvTEMP_off(*up);
+	    up++;
+	}
+    }
+    max = --up - myorigmark;
+    if (sortcop) {
+	if (max > 1) {
+	    AV *oldstack;
+	    CONTEXT *cx;
+	    SV** newsp;
+
+	    SAVETMPS;
+	    SAVESPTR(op);
+
+	    oldstack = stack;
+	    if (!sortstack) {
+		sortstack = newAV();
+		AvREAL_off(sortstack);
+		av_extend(sortstack, 32);
+	    }
+	    SWITCHSTACK(stack, sortstack);
+	    if (sortstash != stash) {
+		firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+		secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+		sortstash = stash;
+	    }
+
+	    SAVESPTR(GvSV(firstgv));
+	    SAVESPTR(GvSV(secondgv));
+	    PUSHBLOCK(cx, CXt_LOOP, stack_base);
+	    sortcxix = cxstack_ix;
+
+	    qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
+
+	    POPBLOCK(cx,curpm);
+	    SWITCHSTACK(sortstack, oldstack);
+	}
+	LEAVE;
+    }
+    else {
+	if (max > 1) {
+	    MEXTEND(SP, 20);	/* Can't afford stack realloc on signal. */
+	    qsort((char*)(ORIGMARK+1), max, sizeof(SV*), sortcmp);
+	}
+    }
+    stack_sp = ORIGMARK + max;
+    return nextop;
+}
+
+/* Range stuff. */
+
+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(pp_flip)
+{
+    dSP;
+
+    if (GIMME == G_ARRAY) {
+	RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
+    }
+    else {
+	dTOPss;
+	SV *targ = PAD_SV(op->op_targ);
+
+	if ((op->op_private & OPpFLIP_LINENUM)
+	  ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv))
+	  : SvTRUE(sv) ) {
+	    sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
+	    if (op->op_flags & OPf_SPECIAL) {
+		sv_setiv(targ, 1);
+		RETURN;
+	    }
+	    else {
+		sv_setiv(targ, 0);
+		sp--;
+		RETURNOP(((CONDOP*)cUNOP->op_first)->op_false);
+	    }
+	}
+	sv_setpv(TARG, "");
+	SETs(targ);
+	RETURN;
+    }
+}
+
+PP(pp_flop)
+{
+    dSP;
+
+    if (GIMME == G_ARRAY) {
+	dPOPPOPssrl;
+	register I32 i;
+	register SV *sv;
+	I32 max;
+
+	if (SvNIOKp(left) || !SvPOKp(left) ||
+	  (looks_like_number(left) && *SvPVX(left) != '0') ) {
+	    i = SvIV(left);
+	    max = SvIV(right);
+	    if (max > i)
+		EXTEND(SP, max - i + 1);
+	    while (i <= max) {
+		sv = sv_mortalcopy(&sv_no);
+		sv_setiv(sv,i++);
+		PUSHs(sv);
+	    }
+	}
+	else {
+	    SV *final = sv_mortalcopy(right);
+	    STRLEN len;
+	    char *tmps = SvPV(final, len);
+
+	    sv = sv_mortalcopy(left);
+	    while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
+		strNE(SvPVX(sv),tmps) ) {
+		XPUSHs(sv);
+		sv = sv_2mortal(newSVsv(sv));
+		sv_inc(sv);
+	    }
+	    if (strEQ(SvPVX(sv),tmps))
+		XPUSHs(sv);
+	}
+    }
+    else {
+	dTOPss;
+	SV *targ = PAD_SV(cUNOP->op_first->op_targ);
+	sv_inc(targ);
+	if ((op->op_private & OPpFLIP_LINENUM)
+	  ? last_in_gv && SvIV(sv) == IoLINES(GvIOp(last_in_gv))
+	  : SvTRUE(sv) ) {
+	    sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
+	    sv_catpv(targ, "E0");
+	}
+	SETs(targ);
+    }
+
+    RETURN;
+}
+
+/* Control. */
+
+static I32
+dopoptolabel(label)
+char *label;
+{
+    register I32 i;
+    register CONTEXT *cx;
+
+    for (i = cxstack_ix; i >= 0; i--) {
+	cx = &cxstack[i];
+	switch (cx->cx_type) {
+	case CXt_SUBST:
+	    if (dowarn)
+		warn("Exiting substitution via %s", op_name[op->op_type]);
+	    break;
+	case CXt_SUB:
+	    if (dowarn)
+		warn("Exiting subroutine via %s", op_name[op->op_type]);
+	    break;
+	case CXt_EVAL:
+	    if (dowarn)
+		warn("Exiting eval via %s", op_name[op->op_type]);
+	    break;
+	case CXt_LOOP:
+	    if (!cx->blk_loop.label ||
+	      strNE(label, cx->blk_loop.label) ) {
+		DEBUG_l(deb("(Skipping label #%d %s)\n",
+			i, cx->blk_loop.label));
+		continue;
+	    }
+	    DEBUG_l( deb("(Found label #%d %s)\n", i, label));
+	    return i;
+	}
+    }
+    return i;
+}
+
+I32
+dowantarray()
+{
+    I32 cxix;
+
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0)
+	return G_SCALAR;
+
+    if (cxstack[cxix].blk_gimme == G_ARRAY)
+	return G_ARRAY;
+    else
+	return G_SCALAR;
+}
+
+static I32
+dopoptosub(startingblock)
+I32 startingblock;
+{
+    I32 i;
+    register CONTEXT *cx;
+    for (i = startingblock; i >= 0; i--) {
+	cx = &cxstack[i];
+	switch (cx->cx_type) {
+	default:
+	    continue;
+	case CXt_EVAL:
+	case CXt_SUB:
+	    DEBUG_l( deb("(Found sub #%d)\n", i));
+	    return i;
+	}
+    }
+    return i;
+}
+
+static I32
+dopoptoeval(startingblock)
+I32 startingblock;
+{
+    I32 i;
+    register CONTEXT *cx;
+    for (i = startingblock; i >= 0; i--) {
+	cx = &cxstack[i];
+	switch (cx->cx_type) {
+	default:
+	    continue;
+	case CXt_EVAL:
+	    DEBUG_l( deb("(Found eval #%d)\n", i));
+	    return i;
+	}
+    }
+    return i;
+}
+
+static I32
+dopoptoloop(startingblock)
+I32 startingblock;
+{
+    I32 i;
+    register CONTEXT *cx;
+    for (i = startingblock; i >= 0; i--) {
+	cx = &cxstack[i];
+	switch (cx->cx_type) {
+	case CXt_SUBST:
+	    if (dowarn)
+		warn("Exiting substitition via %s", op_name[op->op_type]);
+	    break;
+	case CXt_SUB:
+	    if (dowarn)
+		warn("Exiting subroutine via %s", op_name[op->op_type]);
+	    break;
+	case CXt_EVAL:
+	    if (dowarn)
+		warn("Exiting eval via %s", op_name[op->op_type]);
+	    break;
+	case CXt_LOOP:
+	    DEBUG_l( deb("(Found loop #%d)\n", i));
+	    return i;
+	}
+    }
+    return i;
+}
+
+void
+dounwind(cxix)
+I32 cxix;
+{
+    register CONTEXT *cx;
+    SV **newsp;
+    I32 optype;
+
+    while (cxstack_ix > cxix) {
+	cx = &cxstack[cxstack_ix--];
+	DEBUG_l(fprintf(stderr, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
+		    block_type[cx->cx_type]));
+	/* Note: we don't need to restore the base context info till the end. */
+	switch (cx->cx_type) {
+	case CXt_SUB:
+	    POPSUB(cx);
+	    break;
+	case CXt_EVAL:
+	    POPEVAL(cx);
+	    break;
+	case CXt_LOOP:
+	    POPLOOP(cx);
+	    break;
+	case CXt_SUBST:
+	    break;
+	}
+    }
+}
+
+#ifdef I_STDARG
+OP *
+die(char* pat, ...)
+#else
+/*VARARGS0*/
+OP *
+die(pat, va_alist)
+    char *pat;
+    va_dcl
+#endif
+{
+    va_list args;
+    char *message;
+    int oldrunlevel = runlevel;
+    int was_in_eval = in_eval;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+#ifdef I_STDARG
+    va_start(args, pat);
+#else
+    va_start(args);
+#endif
+    message = mess(pat, &args);
+    va_end(args);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    restartop = die_where(message);
+    if ((!restartop && was_in_eval) || oldrunlevel > 1)
+	Siglongjmp(top_env, 3);
+    return restartop;
+}
+
+OP *
+die_where(message)
+char *message;
+{
+    if (in_eval) {
+	I32 cxix;
+	register CONTEXT *cx;
+	I32 gimme;
+	SV **newsp;
+
+	if (in_eval & 4) {
+	    SV **svp;
+	    STRLEN klen = strlen(message);
+	    
+	    svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+	    if (svp) {
+		if (!SvIOK(*svp)) {
+		    static char prefix[] = "\t(in cleanup) ";
+		    sv_upgrade(*svp, SVt_IV);
+		    (void)SvIOK_only(*svp);
+		    SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
+		    sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
+		    sv_catpvn(GvSV(errgv), message, klen);
+		}
+		sv_inc(*svp);
+	    }
+	}
+	else
+	    sv_setpv(GvSV(errgv), message);
+	
+	cxix = dopoptoeval(cxstack_ix);
+	if (cxix >= 0) {
+	    I32 optype;
+
+	    if (cxix < cxstack_ix)
+		dounwind(cxix);
+
+	    POPBLOCK(cx,curpm);
+	    if (cx->cx_type != CXt_EVAL) {
+		fprintf(stderr, "panic: die %s", message);
+		my_exit(1);
+	    }
+	    POPEVAL(cx);
+
+	    if (gimme == G_SCALAR)
+		*++newsp = &sv_undef;
+	    stack_sp = newsp;
+
+	    LEAVE;
+
+	    if (optype == OP_REQUIRE)
+		DIE("%s", SvPVx(GvSV(errgv), na));
+	    return pop_return();
+	}
+    }
+    fputs(message, stderr);
+    (void)Fflush(stderr);
+    if (e_tmpname) {
+	if (e_fp) {
+	    fclose(e_fp);
+	    e_fp = Nullfp;
+	}
+	(void)UNLINK(e_tmpname);
+	Safefree(e_tmpname);
+	e_tmpname = Nullch;
+    }
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
+    my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
+    return 0;
+}
+
+PP(pp_xor)
+{
+    dSP; dPOPTOPssrl;
+    if (SvTRUE(left) != SvTRUE(right))
+	RETSETYES;
+    else
+	RETSETNO;
+}
+
+PP(pp_andassign)
+{
+    dSP;
+    if (!SvTRUE(TOPs))
+	RETURN;
+    else
+	RETURNOP(cLOGOP->op_other);
+}
+
+PP(pp_orassign)
+{
+    dSP;
+    if (SvTRUE(TOPs))
+	RETURN;
+    else
+	RETURNOP(cLOGOP->op_other);
+}
+	
+#ifdef DEPRECATED
+PP(pp_entersubr)
+{
+    dSP;
+    SV** mark = (stack_base + *markstack_ptr + 1);
+    SV* cv = *mark;
+    while (mark < sp) {	/* emulate old interface */
+	*mark = mark[1];
+	mark++;
+    }
+    *sp = cv;
+    return pp_entersub();
+}
+#endif
+
+PP(pp_caller)
+{
+    dSP;
+    register I32 cxix = dopoptosub(cxstack_ix);
+    register CONTEXT *cx;
+    I32 dbcxix;
+    SV *sv;
+    I32 count = 0;
+
+    if (MAXARG)
+	count = POPi;
+    EXTEND(SP, 6);
+    for (;;) {
+	if (cxix < 0) {
+	    if (GIMME != G_ARRAY)
+		RETPUSHUNDEF;
+	    RETURN;
+	}
+	if (DBsub && cxix >= 0 &&
+		cxstack[cxix].blk_sub.cv == GvCV(DBsub))
+	    count++;
+	if (!count--)
+	    break;
+	cxix = dopoptosub(cxix - 1);
+    }
+    cx = &cxstack[cxix];
+    if (cxstack[cxix].cx_type == CXt_SUB) {
+        dbcxix = dopoptosub(cxix - 1);
+	/* We expect that cxstack[dbcxix] is CXt_SUB, anyway, the
+	   field below is defined for any cx. */
+	if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
+	    cx = &cxstack[dbcxix];
+    }
+
+    if (GIMME != G_ARRAY) {
+	dTARGET;
+
+	sv_setpv(TARG, HvNAME(cx->blk_oldcop->cop_stash));
+	PUSHs(TARG);
+	RETURN;
+    }
+
+    PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
+    PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
+    PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
+    if (!MAXARG)
+	RETURN;
+    if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
+	sv = NEWSV(49, 0);
+	gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
+	PUSHs(sv_2mortal(sv));
+	PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+    }
+    else {
+	PUSHs(sv_2mortal(newSVpv("(eval)",0)));
+	PUSHs(sv_2mortal(newSViv(0)));
+    }
+    PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
+    if (cx->cx_type == CXt_EVAL) {
+	if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
+	    PUSHs(cx->blk_eval.cur_text);
+	    PUSHs(&sv_no);
+	} 
+	else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */
+	    /* Require, put the name. */
+	    PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0)));
+	    PUSHs(&sv_yes);
+	}
+    }
+    else if (cx->cx_type == CXt_SUB &&
+	    cx->blk_sub.hasargs &&
+	    curcop->cop_stash == debstash)
+    {
+	AV *ary = cx->blk_sub.argarray;
+	int off = AvARRAY(ary) - AvALLOC(ary);
+
+	if (!dbargs) {
+	    GV* tmpgv;
+	    dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
+				SVt_PVAV)));
+	    GvMULTI_on(tmpgv);
+	    AvREAL_off(dbargs);		/* XXX Should be REIFY */
+	}
+
+	if (AvMAX(dbargs) < AvFILL(ary) + off)
+	    av_extend(dbargs, AvFILL(ary) + off);
+	Copy(AvALLOC(ary), AvARRAY(dbargs), AvFILL(ary) + 1 + off, SV*);
+	AvFILL(dbargs) = AvFILL(ary) + off;
+    }
+    RETURN;
+}
+
+static int
+sortcv(a, b)
+const void *a;
+const void *b;
+{
+    SV **str1 = (SV **) a;
+    SV **str2 = (SV **) b;
+    I32 oldsaveix = savestack_ix;
+    I32 oldscopeix = scopestack_ix;
+    I32 result;
+    GvSV(firstgv) = *str1;
+    GvSV(secondgv) = *str2;
+    stack_sp = stack_base;
+    op = sortcop;
+    runops();
+    if (stack_sp != stack_base + 1)
+	croak("Sort subroutine didn't return single value");
+    if (!SvNIOKp(*stack_sp))
+	croak("Sort subroutine didn't return a numeric value");
+    result = SvIV(*stack_sp);
+    while (scopestack_ix > oldscopeix) {
+	LEAVE;
+    }
+    leave_scope(oldsaveix);
+    return result;
+}
+
+static int
+sortcmp(a, b)
+const void *a;
+const void *b;
+{
+    register SV *str1 = *(SV **) a;
+    register SV *str2 = *(SV **) b;
+    I32 retval;
+
+    if (!SvPOKp(str1)) {
+	if (!SvPOKp(str2))
+	    return 0;
+	else
+	    return -1;
+    }
+    if (!SvPOKp(str2))
+	return 1;
+
+    if (SvCUR(str1) < SvCUR(str2)) {
+	/*SUPPRESS 560*/
+	if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
+	    return retval;
+	else
+	    return -1;
+    }
+    /*SUPPRESS 560*/
+    else if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str2)))
+	return retval;
+    else if (SvCUR(str1) == SvCUR(str2))
+	return 0;
+    else
+	return 1;
+}
+
+PP(pp_reset)
+{
+    dSP;
+    char *tmps;
+
+    if (MAXARG < 1)
+	tmps = "";
+    else
+	tmps = POPp;
+    sv_reset(tmps, curcop->cop_stash);
+    PUSHs(&sv_yes);
+    RETURN;
+}
+
+PP(pp_lineseq)
+{
+    return NORMAL;
+}
+
+PP(pp_dbstate)
+{
+    curcop = (COP*)op;
+    TAINT_NOT;		/* Each statement is presumed innocent */
+    stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+    FREETMPS;
+
+    if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace))
+    {
+	SV **sp;
+	register CV *cv;
+	register CONTEXT *cx;
+	I32 gimme = G_ARRAY;
+	I32 hasargs;
+	GV *gv;
+
+	gv = DBgv;
+	cv = GvCV(gv);
+	if (!cv)
+	    DIE("No DB::DB routine defined");
+
+	if (CvDEPTH(cv) >= 1 && !(debug & (1<<30))) /* don't do recursive DB::DB call */
+	    return NORMAL;
+
+	ENTER;
+	SAVETMPS;
+
+	SAVEI32(debug);
+	SAVESPTR(stack_sp);
+	debug = 0;
+	hasargs = 0;
+	sp = stack_sp;
+
+	push_return(op->op_next);
+	PUSHBLOCK(cx, CXt_SUB, sp);
+	PUSHSUB(cx);
+	CvDEPTH(cv)++;
+	(void)SvREFCNT_inc(cv);
+	SAVESPTR(curpad);
+	curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE));
+	RETURNOP(CvSTART(cv));
+    }
+    else
+	return NORMAL;
+}
+
+PP(pp_scope)
+{
+    return NORMAL;
+}
+
+PP(pp_enteriter)
+{
+    dSP; dMARK;
+    register CONTEXT *cx;
+    I32 gimme = GIMME;
+    SV **svp;
+
+    ENTER;
+    SAVETMPS;
+
+    if (op->op_targ)
+	svp = &curpad[op->op_targ];		/* "my" variable */
+    else
+	svp = &GvSV((GV*)POPs);			/* symbol table variable */
+
+    SAVESPTR(*svp);
+
+    ENTER;
+
+    PUSHBLOCK(cx, CXt_LOOP, SP);
+    PUSHLOOP(cx, svp, MARK);
+    if (op->op_flags & OPf_STACKED) {
+	AV* av = (AV*)POPs;
+	cx->blk_loop.iterary = av;
+	cx->blk_loop.iterix = -1;
+    }
+    else {
+	cx->blk_loop.iterary = stack;
+	AvFILL(stack) = sp - stack_base;
+	cx->blk_loop.iterix = MARK - stack_base;
+    }
+
+    RETURN;
+}
+
+PP(pp_enterloop)
+{
+    dSP;
+    register CONTEXT *cx;
+    I32 gimme = GIMME;
+
+    ENTER;
+    SAVETMPS;
+    ENTER;
+
+    PUSHBLOCK(cx, CXt_LOOP, SP);
+    PUSHLOOP(cx, 0, SP);
+
+    RETURN;
+}
+
+PP(pp_leaveloop)
+{
+    dSP;
+    register CONTEXT *cx;
+    I32 gimme;
+    SV **newsp;
+    PMOP *newpm;
+    SV **mark;
+
+    POPBLOCK(cx,newpm);
+    mark = newsp;
+    POPLOOP(cx);
+    if (gimme == G_SCALAR) {
+	if (op->op_private & OPpLEAVE_VOID)
+	    ;
+	else {
+	    if (mark < SP)
+		*++newsp = sv_mortalcopy(*SP);
+	    else
+		*++newsp = &sv_undef;
+	}
+    }
+    else {
+	while (mark < SP)
+	    *++newsp = sv_mortalcopy(*++mark);
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+    sp = newsp;
+    LEAVE;
+    LEAVE;
+
+    RETURN;
+}
+
+PP(pp_return)
+{
+    dSP; dMARK;
+    I32 cxix;
+    register CONTEXT *cx;
+    I32 gimme;
+    SV **newsp;
+    PMOP *newpm;
+    I32 optype = 0;
+
+    if (stack == sortstack) {
+	if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+	    if (cxstack_ix > sortcxix)
+		dounwind(sortcxix);
+	    AvARRAY(stack)[1] = *SP;
+	    stack_sp = stack_base + 1;
+	    return 0;
+	}
+    }
+
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0)
+	DIE("Can't return outside a subroutine");
+    if (cxix < cxstack_ix)
+	dounwind(cxix);
+
+    POPBLOCK(cx,newpm);
+    switch (cx->cx_type) {
+    case CXt_SUB:
+	POPSUB(cx);
+	break;
+    case CXt_EVAL:
+	POPEVAL(cx);
+	if (optype == OP_REQUIRE &&
+	    (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
+	{
+	    char *name = cx->blk_eval.old_name;
+	    (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+	    DIE("%s did not return a true value", name);
+	}
+	break;
+    default:
+	DIE("panic: return");
+	break;
+    }
+
+    if (gimme == G_SCALAR) {
+	if (MARK < SP)
+	    *++newsp = sv_mortalcopy(*SP);
+	else
+	    *++newsp = &sv_undef;
+    }
+    else {
+	while (MARK < SP)
+	    *++newsp = sv_mortalcopy(*++MARK);
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+    stack_sp = newsp;
+
+    LEAVE;
+    return pop_return();
+}
+
+PP(pp_last)
+{
+    dSP;
+    I32 cxix;
+    register CONTEXT *cx;
+    I32 gimme;
+    I32 optype;
+    OP *nextop;
+    SV **newsp;
+    PMOP *newpm;
+    SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp;
+
+    if (op->op_flags & OPf_SPECIAL) {
+	cxix = dopoptoloop(cxstack_ix);
+	if (cxix < 0)
+	    DIE("Can't \"last\" outside a block");
+    }
+    else {
+	cxix = dopoptolabel(cPVOP->op_pv);
+	if (cxix < 0)
+	    DIE("Label not found for \"last %s\"", cPVOP->op_pv);
+    }
+    if (cxix < cxstack_ix)
+	dounwind(cxix);
+
+    POPBLOCK(cx,newpm);
+    switch (cx->cx_type) {
+    case CXt_LOOP:
+	POPLOOP(cx);
+	nextop = cx->blk_loop.last_op->op_next;
+	LEAVE;
+	break;
+    case CXt_EVAL:
+	POPEVAL(cx);
+	nextop = pop_return();
+	break;
+    case CXt_SUB:
+	POPSUB(cx);
+	nextop = pop_return();
+	break;
+    default:
+	DIE("panic: last");
+	break;
+    }
+
+    if (gimme == G_SCALAR) {
+	if (mark < SP)
+	    *++newsp = sv_mortalcopy(*SP);
+	else
+	    *++newsp = &sv_undef;
+    }
+    else {
+	while (mark < SP)
+	    *++newsp = sv_mortalcopy(*++mark);
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+    sp = newsp;
+
+    LEAVE;
+    RETURNOP(nextop);
+}
+
+PP(pp_next)
+{
+    I32 cxix;
+    register CONTEXT *cx;
+    I32 oldsave;
+
+    if (op->op_flags & OPf_SPECIAL) {
+	cxix = dopoptoloop(cxstack_ix);
+	if (cxix < 0)
+	    DIE("Can't \"next\" outside a block");
+    }
+    else {
+	cxix = dopoptolabel(cPVOP->op_pv);
+	if (cxix < 0)
+	    DIE("Label not found for \"next %s\"", cPVOP->op_pv);
+    }
+    if (cxix < cxstack_ix)
+	dounwind(cxix);
+
+    TOPBLOCK(cx);
+    oldsave = scopestack[scopestack_ix - 1];
+    LEAVE_SCOPE(oldsave);
+    return cx->blk_loop.next_op;
+}
+
+PP(pp_redo)
+{
+    I32 cxix;
+    register CONTEXT *cx;
+    I32 oldsave;
+
+    if (op->op_flags & OPf_SPECIAL) {
+	cxix = dopoptoloop(cxstack_ix);
+	if (cxix < 0)
+	    DIE("Can't \"redo\" outside a block");
+    }
+    else {
+	cxix = dopoptolabel(cPVOP->op_pv);
+	if (cxix < 0)
+	    DIE("Label not found for \"redo %s\"", cPVOP->op_pv);
+    }
+    if (cxix < cxstack_ix)
+	dounwind(cxix);
+
+    TOPBLOCK(cx);
+    oldsave = scopestack[scopestack_ix - 1];
+    LEAVE_SCOPE(oldsave);
+    return cx->blk_loop.redo_op;
+}
+
+static OP* lastgotoprobe;
+
+static OP *
+dofindlabel(op,label,opstack)
+OP *op;
+char *label;
+OP **opstack;
+{
+    OP *kid;
+    OP **ops = opstack;
+
+    if (op->op_type == OP_LEAVE ||
+	op->op_type == OP_SCOPE ||
+	op->op_type == OP_LEAVELOOP ||
+	op->op_type == OP_LEAVETRY)
+	    *ops++ = cUNOP->op_first;
+    *ops = 0;
+    if (op->op_flags & OPf_KIDS) {
+	/* First try all the kids at this level, since that's likeliest. */
+	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+		    kCOP->cop_label && strEQ(kCOP->cop_label, label))
+		return kid;
+	}
+	for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+	    if (kid == lastgotoprobe)
+		continue;
+	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
+		if (ops > opstack &&
+		  (ops[-1]->op_type == OP_NEXTSTATE ||
+		   ops[-1]->op_type == OP_DBSTATE))
+		    *ops = kid;
+		else
+		    *ops++ = kid;
+	    }
+	    if (op = dofindlabel(kid,label,ops))
+		return op;
+	}
+    }
+    *ops = 0;
+    return 0;
+}
+
+PP(pp_dump)
+{
+    return pp_goto(ARGS);
+    /*NOTREACHED*/
+}
+
+PP(pp_goto)
+{
+    dSP;
+    OP *retop = 0;
+    I32 ix;
+    register CONTEXT *cx;
+    OP *enterops[64];
+    char *label;
+    int do_dump = (op->op_type == OP_DUMP);
+
+    label = 0;
+    if (op->op_flags & OPf_STACKED) {
+	SV *sv = POPs;
+
+	/* This egregious kludge implements goto &subroutine */
+	if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
+	    I32 cxix;
+	    register CONTEXT *cx;
+	    CV* cv = (CV*)SvRV(sv);
+	    SV** mark;
+	    I32 items = 0;
+	    I32 oldsave;
+
+	    if (!CvROOT(cv) && !CvXSUB(cv)) {
+		if (CvGV(cv)) {
+		    SV *tmpstr = sv_newmortal();
+		    gv_efullname(tmpstr, CvGV(cv));
+		    DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
+		}
+		DIE("Goto undefined subroutine");
+	    }
+
+	    /* First do some returnish stuff. */
+	    cxix = dopoptosub(cxstack_ix);
+	    if (cxix < 0)
+		DIE("Can't goto subroutine outside a subroutine");
+	    if (cxix < cxstack_ix)
+		dounwind(cxix);
+	    TOPBLOCK(cx);
+	    mark = stack_sp;
+	    if (cx->blk_sub.hasargs) {   /* put @_ back onto stack */
+		AV* av = cx->blk_sub.argarray;
+		
+		items = AvFILL(av) + 1;
+		Copy(AvARRAY(av), ++stack_sp, items, SV*);
+		stack_sp += items;
+		GvAV(defgv) = cx->blk_sub.savearray;
+		AvREAL_off(av);
+		av_clear(av);
+	    }
+	    if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
+		SvREFCNT_dec(cx->blk_sub.cv);
+	    oldsave = scopestack[scopestack_ix - 1];
+	    LEAVE_SCOPE(oldsave);
+
+	    /* Now do some callish stuff. */
+	    SAVETMPS;
+	    if (CvXSUB(cv)) {
+		if (CvOLDSTYLE(cv)) {
+		    I32 (*fp3)_((int,int,int));
+		    while (sp > mark) {
+			sp[1] = sp[0];
+			sp--;
+		    }
+		    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
+		    items = (*fp3)(CvXSUBANY(cv).any_i32,
+		                   mark - stack_base + 1,
+				   items);
+		    sp = stack_base + items;
+		}
+		else {
+		    (void)(*CvXSUB(cv))(cv);
+		}
+		LEAVE;
+		return pop_return();
+	    }
+	    else {
+		AV* padlist = CvPADLIST(cv);
+		SV** svp = AvARRAY(padlist);
+		cx->blk_sub.cv = cv;
+		cx->blk_sub.olddepth = CvDEPTH(cv);
+		CvDEPTH(cv)++;
+		if (CvDEPTH(cv) < 2)
+		    (void)SvREFCNT_inc(cv);
+		else {	/* save temporaries on recursion? */
+		    if (CvDEPTH(cv) == 100 && dowarn)
+			warn("Deep recursion on subroutine \"%s\"",
+			    GvENAME(CvGV(cv)));
+		    if (CvDEPTH(cv) > AvFILL(padlist)) {
+			AV *newpad = newAV();
+			SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
+			I32 ix = AvFILL((AV*)svp[1]);
+			svp = AvARRAY(svp[0]);
+			for ( ;ix > 0; ix--) {
+			    if (svp[ix] != &sv_undef) {
+				char *name = SvPVX(svp[ix]);
+				if (SvFLAGS(svp[ix]) & SVf_FAKE) {
+				    /* outer lexical? */
+				    av_store(newpad, ix,
+					SvREFCNT_inc(oldpad[ix]) );
+				}
+				else {		/* our own lexical */
+				    if (*name == '@')
+					av_store(newpad, ix, sv = (SV*)newAV());
+				    else if (*name == '%')
+					av_store(newpad, ix, sv = (SV*)newHV());
+				    else
+					av_store(newpad, ix, sv = NEWSV(0,0));
+				    SvPADMY_on(sv);
+				}
+			    }
+			    else {
+				av_store(newpad, ix, sv = NEWSV(0,0));
+				SvPADTMP_on(sv);
+			    }
+			}
+			if (cx->blk_sub.hasargs) {
+			    AV* av = newAV();
+			    av_extend(av, 0);
+			    av_store(newpad, 0, (SV*)av);
+			    AvFLAGS(av) = AVf_REIFY;
+			}
+			av_store(padlist, CvDEPTH(cv), (SV*)newpad);
+			AvFILL(padlist) = CvDEPTH(cv);
+			svp = AvARRAY(padlist);
+		    }
+		}
+		SAVESPTR(curpad);
+		curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+		if (cx->blk_sub.hasargs) {
+		    AV* av = (AV*)curpad[0];
+		    SV** ary;
+
+		    cx->blk_sub.savearray = GvAV(defgv);
+		    cx->blk_sub.argarray = av;
+		    GvAV(defgv) = cx->blk_sub.argarray;
+		    ++mark;
+
+		    if (items >= AvMAX(av) + 1) {
+			ary = AvALLOC(av);
+			if (AvARRAY(av) != ary) {
+			    AvMAX(av) += AvARRAY(av) - AvALLOC(av);
+			    SvPVX(av) = (char*)ary;
+			}
+			if (items >= AvMAX(av) + 1) {
+			    AvMAX(av) = items - 1;
+			    Renew(ary,items+1,SV*);
+			    AvALLOC(av) = ary;
+			    SvPVX(av) = (char*)ary;
+			}
+		    }
+		    Copy(mark,AvARRAY(av),items,SV*);
+		    AvFILL(av) = items - 1;
+		    
+		    while (items--) {
+			if (*mark)
+			    SvTEMP_off(*mark);
+			mark++;
+		    }
+		}
+		RETURNOP(CvSTART(cv));
+	    }
+	}
+	else
+	    label = SvPV(sv,na);
+    }
+    else if (op->op_flags & OPf_SPECIAL) {
+	if (! do_dump)
+	    DIE("goto must have label");
+    }
+    else
+	label = cPVOP->op_pv;
+
+    if (label && *label) {
+	OP *gotoprobe = 0;
+
+	/* find label */
+
+	lastgotoprobe = 0;
+	*enterops = 0;
+	for (ix = cxstack_ix; ix >= 0; ix--) {
+	    cx = &cxstack[ix];
+	    switch (cx->cx_type) {
+	    case CXt_SUB:
+		gotoprobe = CvROOT(cx->blk_sub.cv);
+		break;
+	    case CXt_EVAL:
+		gotoprobe = eval_root; /* XXX not good for nested eval */
+		break;
+	    case CXt_LOOP:
+		gotoprobe = cx->blk_oldcop->op_sibling;
+		break;
+	    case CXt_SUBST:
+		continue;
+	    case CXt_BLOCK:
+		if (ix)
+		    gotoprobe = cx->blk_oldcop->op_sibling;
+		else
+		    gotoprobe = main_root;
+		break;
+	    default:
+		if (ix)
+		    DIE("panic: goto");
+		else
+		    gotoprobe = main_root;
+		break;
+	    }
+	    retop = dofindlabel(gotoprobe, label, enterops);
+	    if (retop)
+		break;
+	    lastgotoprobe = gotoprobe;
+	}
+	if (!retop)
+	    DIE("Can't find label %s", label);
+
+	/* pop unwanted frames */
+
+	if (ix < cxstack_ix) {
+	    I32 oldsave;
+
+	    if (ix < 0)
+		ix = 0;
+	    dounwind(ix);
+	    TOPBLOCK(cx);
+	    oldsave = scopestack[scopestack_ix];
+	    LEAVE_SCOPE(oldsave);
+	}
+
+	/* push wanted frames */
+
+	if (*enterops && enterops[1]) {
+	    OP *oldop = op;
+	    for (ix = 1; enterops[ix]; ix++) {
+		op = enterops[ix];
+		(*op->op_ppaddr)();
+	    }
+	    op = oldop;
+	}
+    }
+
+    if (do_dump) {
+#ifdef VMS
+	if (!retop) retop = main_start;
+#endif
+	restartop = retop;
+	do_undump = TRUE;
+
+	my_unexec();
+
+	restartop = 0;		/* hmm, must be GNU unexec().. */
+	do_undump = FALSE;
+    }
+
+    if (stack == signalstack) {
+        restartop = retop;
+        Siglongjmp(top_env, 3);
+    }
+
+    RETURNOP(retop);
+}
+
+PP(pp_exit)
+{
+    dSP;
+    I32 anum;
+
+    if (MAXARG < 1)
+	anum = 0;
+    else
+	anum = SvIVx(POPs);
+    my_exit(anum);
+    PUSHs(&sv_undef);
+    RETURN;
+}
+
+#ifdef NOTYET
+PP(pp_nswitch)
+{
+    dSP;
+    double value = SvNVx(GvSV(cCOP->cop_gv));
+    register I32 match = I_32(value);
+
+    if (value < 0.0) {
+	if (((double)match) > value)
+	    --match;		/* was fractional--truncate other way */
+    }
+    match -= cCOP->uop.scop.scop_offset;
+    if (match < 0)
+	match = 0;
+    else if (match > cCOP->uop.scop.scop_max)
+	match = cCOP->uop.scop.scop_max;
+    op = cCOP->uop.scop.scop_next[match];
+    RETURNOP(op);
+}
+
+PP(pp_cswitch)
+{
+    dSP;
+    register I32 match;
+
+    if (multiline)
+	op = op->op_next;			/* can't assume anything */
+    else {
+	match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255;
+	match -= cCOP->uop.scop.scop_offset;
+	if (match < 0)
+	    match = 0;
+	else if (match > cCOP->uop.scop.scop_max)
+	    match = cCOP->uop.scop.scop_max;
+	op = cCOP->uop.scop.scop_next[match];
+    }
+    RETURNOP(op);
+}
+#endif
+
+/* Eval. */
+
+static void
+save_lines(array, sv)
+AV *array;
+SV *sv;
+{
+    register char *s = SvPVX(sv);
+    register char *send = SvPVX(sv) + SvCUR(sv);
+    register char *t;
+    register I32 line = 1;
+
+    while (s && s < send) {
+	SV *tmpstr = NEWSV(85,0);
+
+	sv_upgrade(tmpstr, SVt_PVMG);
+	t = strchr(s, '\n');
+	if (t)
+	    t++;
+	else
+	    t = send;
+
+	sv_setpvn(tmpstr, s, t - s);
+	av_store(array, line++, tmpstr);
+	s = t;
+    }
+}
+
+static OP *
+doeval(gimme)
+int gimme;
+{
+    dSP;
+    OP *saveop = op;
+    HV *newstash;
+    AV* comppadlist;
+
+    in_eval = 1;
+
+    /* set up a scratch pad */
+
+    SAVEINT(padix);
+    SAVESPTR(curpad);
+    SAVESPTR(comppad);
+    SAVESPTR(comppad_name);
+    SAVEINT(comppad_name_fill);
+    SAVEINT(min_intro_pending);
+    SAVEINT(max_intro_pending);
+
+    SAVESPTR(compcv);
+    compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)compcv, SVt_PVCV);
+
+    comppad = newAV();
+    comppad_name = newAV();
+    comppad_name_fill = 0;
+    min_intro_pending = 0;
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
+    padix = 0;
+
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, (SV*)comppad_name);
+    av_store(comppadlist, 1, (SV*)comppad);
+    CvPADLIST(compcv) = comppadlist;
+    SAVEFREESV(compcv);
+
+    /* make sure we compile in the right package */
+
+    newstash = curcop->cop_stash;
+    if (curstash != newstash) {
+	SAVESPTR(curstash);
+	curstash = newstash;
+    }
+    SAVESPTR(beginav);
+    beginav = newAV();
+    SAVEFREESV(beginav);
+
+    /* try to compile it */
+
+    eval_root = Nullop;
+    error_count = 0;
+    curcop = &compiling;
+    curcop->cop_arybase = 0;
+    SvREFCNT_dec(rs);
+    rs = newSVpv("\n", 1);
+    sv_setpv(GvSV(errgv),"");
+    if (yyparse() || error_count || !eval_root) {
+	SV **newsp;
+	I32 gimme;
+	CONTEXT *cx;
+	I32 optype;
+
+	op = saveop;
+	if (eval_root) {
+	    op_free(eval_root);
+	    eval_root = Nullop;
+	}
+	POPBLOCK(cx,curpm);
+	POPEVAL(cx);
+	pop_return();
+	lex_end();
+	LEAVE;
+	if (optype == OP_REQUIRE)
+	    DIE("%s", SvPVx(GvSV(errgv), na));
+	SvREFCNT_dec(rs);
+	rs = SvREFCNT_inc(nrs);
+	RETPUSHUNDEF;
+    }
+    SvREFCNT_dec(rs);
+    rs = SvREFCNT_inc(nrs);
+    compiling.cop_line = 0;
+    SAVEFREEOP(eval_root);
+    if (gimme & G_ARRAY)
+	list(eval_root);
+    else
+	scalar(eval_root);
+
+    DEBUG_x(dump_eval());
+
+    /* compiled okay, so do it */
+
+    RETURNOP(eval_start);
+}
+
+PP(pp_require)
+{
+    dSP;
+    register CONTEXT *cx;
+    SV *sv;
+    char *name;
+    char *tmpname;
+    SV** svp;
+    I32 gimme = G_SCALAR;
+    FILE *tryrsfp = 0;
+
+    sv = POPs;
+    if (SvNIOKp(sv) && !SvPOKp(sv)) {
+	if (atof(patchlevel) + 0.00000999 < SvNV(sv))
+	    DIE("Perl %s required--this is only version %s, stopped",
+		SvPV(sv,na),patchlevel);
+	RETPUSHYES;
+    }
+    name = SvPV(sv, na);
+    if (!*name)
+	DIE("Null filename used");
+    TAINT_PROPER("require");
+    if (op->op_type == OP_REQUIRE &&
+      (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
+      *svp != &sv_undef)
+	RETPUSHYES;
+
+    /* prepare to compile file */
+
+    tmpname = savepv(name);
+    if (*tmpname == '/' ||
+	(*tmpname == '.' && 
+	    (tmpname[1] == '/' ||
+	     (tmpname[1] == '.' && tmpname[2] == '/')))
+#ifdef DOSISH
+      || (tmpname[0] && tmpname[1] == ':')
+#endif
+#ifdef VMS
+	|| (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
+	    (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>')))
+#endif
+    )
+    {
+	tryrsfp = fopen(tmpname,"r");
+    }
+    else {
+	AV *ar = GvAVn(incgv);
+	I32 i;
+
+	for (i = 0; i <= AvFILL(ar); i++) {
+#ifdef VMS
+	    if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
+		continue;
+	    strcat(buf,name);
+#else
+	    (void)sprintf(buf, "%s/%s",
+		SvPVx(*av_fetch(ar, i, TRUE), na), name);
+#endif
+	    tryrsfp = fopen(buf, "r");
+	    if (tryrsfp) {
+		char *s = buf;
+
+		if (*s == '.' && s[1] == '/')
+		    s += 2;
+		Safefree(tmpname);
+		tmpname = savepv(s);
+		break;
+	    }
+	}
+    }
+    SAVESPTR(compiling.cop_filegv);
+    compiling.cop_filegv = gv_fetchfile(tmpname);
+    Safefree(tmpname);
+    tmpname = Nullch;
+    if (!tryrsfp) {
+	if (op->op_type == OP_REQUIRE) {
+	    sprintf(tokenbuf,"Can't locate %s in @INC", name);
+	    if (instr(tokenbuf,".h "))
+		strcat(tokenbuf," (change .h to .ph maybe?)");
+	    if (instr(tokenbuf,".ph "))
+		strcat(tokenbuf," (did you run h2ph?)");
+	    DIE("%s",tokenbuf);
+	}
+
+	RETPUSHUNDEF;
+    }
+
+    /* Assume success here to prevent recursive requirement. */
+    (void)hv_store(GvHVn(incgv), name, strlen(name),
+	newSVsv(GvSV(compiling.cop_filegv)), 0 );
+
+    ENTER;
+    SAVETMPS;
+    lex_start(sv_2mortal(newSVpv("",0)));
+    if (rsfp_filters){
+ 	save_aptr(&rsfp_filters);
+	rsfp_filters = NULL;
+    }
+
+    rsfp = tryrsfp;
+    name = savepv(name);
+    SAVEFREEPV(name);
+    SAVEI32(hints);
+    hints = 0;
+ 
+    /* switch to eval mode */
+
+    push_return(op->op_next);
+    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHEVAL(cx, name, compiling.cop_filegv);
+
+    compiling.cop_line = 0;
+
+    PUTBACK;
+    return doeval(G_SCALAR);
+}
+
+PP(pp_dofile)
+{
+    return pp_require(ARGS);
+}
+
+PP(pp_entereval)
+{
+    dSP;
+    register CONTEXT *cx;
+    dPOPss;
+    I32 gimme = GIMME;
+    char tmpbuf[32];
+    STRLEN len;
+
+    if (!SvPV(sv,len) || !len)
+	RETPUSHUNDEF;
+    TAINT_PROPER("eval");
+
+    ENTER;
+    lex_start(sv);
+    SAVETMPS;
+ 
+    /* switch to eval mode */
+
+    SAVESPTR(compiling.cop_filegv);
+    sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
+    compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+    compiling.cop_line = 1;
+    SAVEDELETE(defstash, savepv(tmpbuf), strlen(tmpbuf));
+    SAVEI32(hints);
+    hints = op->op_targ;
+
+    push_return(op->op_next);
+    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHEVAL(cx, 0, compiling.cop_filegv);
+
+    /* prepare to compile string */
+
+    if (perldb && curstash != debstash)
+	save_lines(GvAV(compiling.cop_filegv), linestr);
+    PUTBACK;
+    return doeval(gimme);
+}
+
+PP(pp_leaveeval)
+{
+    dSP;
+    register SV **mark;
+    SV **newsp;
+    PMOP *newpm;
+    I32 gimme;
+    register CONTEXT *cx;
+    OP *retop;
+    I32 optype;
+
+    POPBLOCK(cx,newpm);
+    POPEVAL(cx);
+    retop = pop_return();
+
+    if (gimme == G_SCALAR) {
+	if (op->op_private & OPpLEAVE_VOID)
+	    MARK = newsp;
+	else {
+	    MARK = newsp + 1;
+	    if (MARK <= SP) {
+		if (SvFLAGS(TOPs) & SVs_TEMP)
+		    *MARK = TOPs;
+		else
+		    *MARK = sv_mortalcopy(TOPs);
+	    }
+	    else {
+		MEXTEND(mark,0);
+		*MARK = &sv_undef;
+	    }
+	}
+	SP = MARK;
+    }
+    else {
+	for (mark = newsp + 1; mark <= SP; mark++)
+	    if (!(SvFLAGS(TOPs) & SVs_TEMP))
+		*mark = sv_mortalcopy(*mark);
+		/* in case LEAVE wipes old return values */
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+
+    if (optype != OP_ENTEREVAL) {
+	char *name = cx->blk_eval.old_name;
+
+	if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
+	    /* Unassume the success we assumed earlier. */
+	    (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+
+	    if (optype == OP_REQUIRE)
+		retop = die("%s did not return a true value", name);
+	}
+    }
+
+    lex_end();
+    LEAVE;
+    sv_setpv(GvSV(errgv),"");
+
+    RETURNOP(retop);
+}
+
+PP(pp_entertry)
+{
+    dSP;
+    register CONTEXT *cx;
+    I32 gimme = GIMME;
+
+    ENTER;
+    SAVETMPS;
+
+    push_return(cLOGOP->op_other->op_next);
+    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHEVAL(cx, 0, 0);
+    eval_root = op;		/* Only needed so that goto works right. */
+
+    in_eval = 1;
+    sv_setpv(GvSV(errgv),"");
+    RETURN;
+}
+
+PP(pp_leavetry)
+{
+    dSP;
+    register SV **mark;
+    SV **newsp;
+    PMOP *newpm;
+    I32 gimme;
+    register CONTEXT *cx;
+    I32 optype;
+
+    POPBLOCK(cx,newpm);
+    POPEVAL(cx);
+    pop_return();
+
+    if (gimme == G_SCALAR) {
+	if (op->op_private & OPpLEAVE_VOID)
+	    MARK = newsp;
+	else {
+	    MARK = newsp + 1;
+	    if (MARK <= SP) {
+		if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
+		    *MARK = TOPs;
+		else
+		    *MARK = sv_mortalcopy(TOPs);
+	    }
+	    else {
+		MEXTEND(mark,0);
+		*MARK = &sv_undef;
+	    }
+	}
+	SP = MARK;
+    }
+    else {
+	for (mark = newsp + 1; mark <= SP; mark++)
+	    if (!(SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)))
+		*mark = sv_mortalcopy(*mark);
+		/* in case LEAVE wipes old return values */
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+
+    LEAVE;
+    sv_setpv(GvSV(errgv),"");
+    RETURN;
+}
+
+static void
+doparseform(sv)
+SV *sv;
+{
+    STRLEN len;
+    register char *s = SvPV_force(sv, len);
+    register char *send = s + len;
+    register char *base;
+    register I32 skipspaces = 0;
+    bool noblank;
+    bool repeat;
+    bool postspace = FALSE;
+    U16 *fops;
+    register U16 *fpc;
+    U16 *linepc;
+    register I32 arg;
+    bool ischop;
+
+    New(804, fops, (send - s)*3+2, U16);    /* Almost certainly too long... */
+    fpc = fops;
+
+    if (s < send) {
+	linepc = fpc;
+	*fpc++ = FF_LINEMARK;
+	noblank = repeat = FALSE;
+	base = s;
+    }
+
+    while (s <= send) {
+	switch (*s++) {
+	default:
+	    skipspaces = 0;
+	    continue;
+
+	case '~':
+	    if (*s == '~') {
+		repeat = TRUE;
+		*s = ' ';
+	    }
+	    noblank = TRUE;
+	    s[-1] = ' ';
+	    /* FALL THROUGH */
+	case ' ': case '\t':
+	    skipspaces++;
+	    continue;
+	    
+	case '\n': case 0:
+	    arg = s - base;
+	    skipspaces++;
+	    arg -= skipspaces;
+	    if (arg) {
+		if (postspace) {
+		    *fpc++ = FF_SPACE;
+		    postspace = FALSE;
+		}
+		*fpc++ = FF_LITERAL;
+		*fpc++ = arg;
+	    }
+	    if (s <= send)
+		skipspaces--;
+	    if (skipspaces) {
+		*fpc++ = FF_SKIP;
+		*fpc++ = skipspaces;
+	    }
+	    skipspaces = 0;
+	    if (s <= send)
+		*fpc++ = FF_NEWLINE;
+	    if (noblank) {
+		*fpc++ = FF_BLANK;
+		if (repeat)
+		    arg = fpc - linepc + 1;
+		else
+		    arg = 0;
+		*fpc++ = arg;
+	    }
+	    if (s < send) {
+		linepc = fpc;
+		*fpc++ = FF_LINEMARK;
+		noblank = repeat = FALSE;
+		base = s;
+	    }
+	    else
+		s++;
+	    continue;
+
+	case '@':
+	case '^':
+	    ischop = s[-1] == '^';
+
+	    if (postspace) {
+		*fpc++ = FF_SPACE;
+		postspace = FALSE;
+	    }
+	    arg = (s - base) - 1;
+	    if (arg) {
+		*fpc++ = FF_LITERAL;
+		*fpc++ = arg;
+	    }
+
+	    base = s - 1;
+	    *fpc++ = FF_FETCH;
+	    if (*s == '*') {
+		s++;
+		*fpc++ = 0;
+		*fpc++ = FF_LINEGLOB;
+	    }
+	    else if (*s == '#' || (*s == '.' && s[1] == '#')) {
+		arg = ischop ? 512 : 0;
+		base = s - 1;
+		while (*s == '#')
+		    s++;
+		if (*s == '.') {
+		    char *f;
+		    s++;
+		    f = s;
+		    while (*s == '#')
+			s++;
+		    arg |= 256 + (s - f);
+		}
+		*fpc++ = s - base;		/* fieldsize for FETCH */
+		*fpc++ = FF_DECIMAL;
+		*fpc++ = arg;
+	    }
+	    else {
+		I32 prespace = 0;
+		bool ismore = FALSE;
+
+		if (*s == '>') {
+		    while (*++s == '>') ;
+		    prespace = FF_SPACE;
+		}
+		else if (*s == '|') {
+		    while (*++s == '|') ;
+		    prespace = FF_HALFSPACE;
+		    postspace = TRUE;
+		}
+		else {
+		    if (*s == '<')
+			while (*++s == '<') ;
+		    postspace = TRUE;
+		}
+		if (*s == '.' && s[1] == '.' && s[2] == '.') {
+		    s += 3;
+		    ismore = TRUE;
+		}
+		*fpc++ = s - base;		/* fieldsize for FETCH */
+
+		*fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
+
+		if (prespace)
+		    *fpc++ = prespace;
+		*fpc++ = FF_ITEM;
+		if (ismore)
+		    *fpc++ = FF_MORE;
+		if (ischop)
+		    *fpc++ = FF_CHOP;
+	    }
+	    base = s;
+	    skipspaces = 0;
+	    continue;
+	}
+    }
+    *fpc++ = FF_END;
+
+    arg = fpc - fops;
+    { /* need to jump to the next word */
+        int z;
+	z = WORD_ALIGN - SvCUR(sv) % WORD_ALIGN;
+	SvGROW(sv, SvCUR(sv) + z + arg * sizeof(U16) + 4);
+	s = SvPVX(sv) + SvCUR(sv) + z;
+    }
+    Copy(fops, s, arg, U16);
+    Safefree(fops);
+    SvCOMPILED_on(sv);
+}
diff --git a/gnu/usr.bin/perl/pp_hot.c b/gnu/usr.bin/perl/pp_hot.c
new file mode 100644
index 00000000000..8fe39f37f7b
--- /dev/null
+++ b/gnu/usr.bin/perl/pp_hot.c
@@ -0,0 +1,1968 @@
+/*    pp_hot.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
+ * shaking the air.
+ *
+ *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
+ *                     Fire, Foes!  Awake!
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* Hot code. */
+
+PP(pp_const)
+{
+    dSP;
+    XPUSHs(cSVOP->op_sv);
+    RETURN;
+}
+
+PP(pp_nextstate)
+{
+    curcop = (COP*)op;
+    TAINT_NOT;		/* Each statement is presumed innocent */
+    stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+    FREETMPS;
+    return NORMAL;
+}
+
+PP(pp_gvsv)
+{
+    dSP;
+    EXTEND(sp,1);
+    if (op->op_private & OPpLVAL_INTRO)
+	PUSHs(save_scalar(cGVOP->op_gv));
+    else
+	PUSHs(GvSV(cGVOP->op_gv));
+    RETURN;
+}
+
+PP(pp_null)
+{
+    return NORMAL;
+}
+
+PP(pp_pushmark)
+{
+    PUSHMARK(stack_sp);
+    return NORMAL;
+}
+
+PP(pp_stringify)
+{
+    dSP; dTARGET;
+    STRLEN len;
+    char *s;
+    s = SvPV(TOPs,len);
+    sv_setpvn(TARG,s,len);
+    SETTARG;
+    RETURN;
+}
+
+PP(pp_gv)
+{
+    dSP;
+    XPUSHs((SV*)cGVOP->op_gv);
+    RETURN;
+}
+
+PP(pp_gelem)
+{
+    GV *gv;
+    SV *sv;
+    SV *ref;
+    char *elem;
+    dSP;
+
+    sv = POPs;
+    elem = SvPV(sv, na);
+    gv = (GV*)POPs;
+    ref = Nullsv;
+    sv = Nullsv;
+    switch (elem ? *elem : '\0')
+    {
+    case 'A':
+	if (strEQ(elem, "ARRAY"))
+	    ref = (SV*)GvAV(gv);
+	break;
+    case 'C':
+	if (strEQ(elem, "CODE"))
+	    ref = (SV*)GvCV(gv);
+	break;
+    case 'F':
+	if (strEQ(elem, "FILEHANDLE"))
+	    ref = (SV*)GvIOp(gv);
+	break;
+    case 'G':
+	if (strEQ(elem, "GLOB"))
+	    ref = (SV*)gv;
+	break;
+    case 'H':
+	if (strEQ(elem, "HASH"))
+	    ref = (SV*)GvHV(gv);
+	break;
+    case 'N':
+	if (strEQ(elem, "NAME"))
+	    sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
+	break;
+    case 'P':
+	if (strEQ(elem, "PACKAGE"))
+	    sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
+	break;
+    case 'S':
+	if (strEQ(elem, "SCALAR"))
+	    ref = GvSV(gv);
+	break;
+    }
+    if (ref)
+	sv = newRV(ref);
+    if (sv)
+	sv_2mortal(sv);
+    else
+	sv = &sv_undef;
+    XPUSHs(sv);
+    RETURN;
+}
+
+PP(pp_and)
+{
+    dSP;
+    if (!SvTRUE(TOPs))
+	RETURN;
+    else {
+	--SP;
+	RETURNOP(cLOGOP->op_other);
+    }
+}
+
+PP(pp_sassign)
+{
+    dSP; dPOPTOPssrl;
+    MAGIC *mg;
+
+    if (op->op_private & OPpASSIGN_BACKWARDS) {
+	SV *temp;
+	temp = left; left = right; right = temp;
+    }
+    if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
+				!((mg = mg_find(left, 't')) && mg->mg_len & 1)))
+    {
+	TAINT_NOT;
+    }
+    SvSetSV(right, left);
+    SvSETMAGIC(right);
+    SETs(right);
+    RETURN;
+}
+
+PP(pp_cond_expr)
+{
+    dSP;
+    if (SvTRUEx(POPs))
+	RETURNOP(cCONDOP->op_true);
+    else
+	RETURNOP(cCONDOP->op_false);
+}
+
+PP(pp_unstack)
+{
+    I32 oldsave;
+    TAINT_NOT;		/* Each statement is presumed innocent */
+    stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
+    FREETMPS;
+    oldsave = scopestack[scopestack_ix - 1];
+    LEAVE_SCOPE(oldsave);
+    return NORMAL;
+}
+
+PP(pp_seq)
+{
+    dSP; tryAMAGICbinSET(seq,0); 
+    {
+      dPOPTOPssrl;
+      SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
+      RETURN;
+    }
+}
+
+PP(pp_concat)
+{
+  dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+  {
+    dPOPTOPssrl;
+    STRLEN len;
+    char *s;
+    if (TARG != left) {
+	s = SvPV(left,len);
+	sv_setpvn(TARG,s,len);
+    }
+    else if (SvGMAGICAL(TARG))
+	mg_get(TARG);
+    else if (!SvOK(TARG)) {
+	s = SvPV_force(TARG, len);
+	sv_setpv(TARG, "");	/* Suppress warning. */
+    }
+    s = SvPV(right,len);
+    sv_catpvn(TARG,s,len);
+    SETTARG;
+    RETURN;
+  }
+}
+
+PP(pp_padsv)
+{
+    dSP; dTARGET;
+    XPUSHs(TARG);
+    if (op->op_flags & OPf_MOD) {
+	if (op->op_private & OPpLVAL_INTRO)
+	    SAVECLEARSV(curpad[op->op_targ]);
+        else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+	    provide_ref(op, curpad[op->op_targ]);
+    }
+    RETURN;
+}
+
+PP(pp_readline)
+{
+    last_in_gv = (GV*)(*stack_sp--);
+    return do_readline();
+}
+
+PP(pp_eq)
+{
+    dSP; tryAMAGICbinSET(eq,0); 
+    {
+      dPOPnv;
+      SETs((TOPn == value) ? &sv_yes : &sv_no);
+      RETURN;
+    }
+}
+
+PP(pp_preinc)
+{
+    dSP;
+    if (SvIOK(TOPs)) {
+	++SvIVX(TOPs);
+	SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+	sv_inc(TOPs);
+    SvSETMAGIC(TOPs);
+    return NORMAL;
+}
+
+PP(pp_or)
+{
+    dSP;
+    if (SvTRUE(TOPs))
+	RETURN;
+    else {
+	--SP;
+	RETURNOP(cLOGOP->op_other);
+    }
+}
+
+PP(pp_add)
+{
+    dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
+    {
+      dPOPTOPnnrl;
+      SETn( left + right );
+      RETURN;
+    }
+}
+
+PP(pp_aelemfast)
+{
+    dSP;
+    AV *av = GvAV((GV*)cSVOP->op_sv);
+    SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
+    PUSHs(svp ? *svp : &sv_undef);
+    RETURN;
+}
+
+PP(pp_join)
+{
+    dSP; dMARK; dTARGET;
+    MARK++;
+    do_join(TARG, *MARK, MARK, SP);
+    SP = MARK;
+    SETs(TARG);
+    RETURN;
+}
+
+PP(pp_pushre)
+{
+    dSP;
+    XPUSHs((SV*)op);
+    RETURN;
+}
+
+/* Oversized hot code. */
+
+PP(pp_print)
+{
+    dSP; dMARK; dORIGMARK;
+    GV *gv;
+    IO *io;
+    register FILE *fp;
+
+    if (op->op_flags & OPf_STACKED)
+	gv = (GV*)*++MARK;
+    else
+	gv = defoutgv;
+    if (!(io = GvIO(gv))) {
+	if (dowarn) {
+	    SV* sv = sv_newmortal();
+            gv_fullname(sv,gv);
+            warn("Filehandle %s never opened", SvPV(sv,na));
+        }
+
+	SETERRNO(EBADF,RMS$_IFI);
+	goto just_say_no;
+    }
+    else if (!(fp = IoOFP(io))) {
+	if (dowarn)  {
+	    SV* sv = sv_newmortal();
+            gv_fullname(sv,gv);
+	    if (IoIFP(io))
+		warn("Filehandle %s opened only for input", SvPV(sv,na));
+	    else
+		warn("print on closed filehandle %s", SvPV(sv,na));
+	}
+	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+	goto just_say_no;
+    }
+    else {
+	MARK++;
+	if (ofslen) {
+	    while (MARK <= SP) {
+		if (!do_print(*MARK, fp))
+		    break;
+		MARK++;
+		if (MARK <= SP) {
+		    if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
+			MARK--;
+			break;
+		    }
+		}
+	    }
+	}
+	else {
+	    while (MARK <= SP) {
+		if (!do_print(*MARK, fp))
+		    break;
+		MARK++;
+	    }
+	}
+	if (MARK <= SP)
+	    goto just_say_no;
+	else {
+	    if (orslen)
+		if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
+		    goto just_say_no;
+
+	    if (IoFLAGS(io) & IOf_FLUSH)
+		if (Fflush(fp) == EOF)
+		    goto just_say_no;
+	}
+    }
+    SP = ORIGMARK;
+    PUSHs(&sv_yes);
+    RETURN;
+
+  just_say_no:
+    SP = ORIGMARK;
+    PUSHs(&sv_undef);
+    RETURN;
+}
+
+PP(pp_rv2av)
+{
+    dSP; dPOPss;
+
+    AV *av;
+
+    if (SvROK(sv)) {
+      wasref:
+	av = (AV*)SvRV(sv);
+	if (SvTYPE(av) != SVt_PVAV)
+	    DIE("Not an ARRAY reference");
+	if (op->op_private & OPpLVAL_INTRO)
+	    av = (AV*)save_svref((SV**)sv);
+	if (op->op_flags & OPf_REF) {
+	    PUSHs((SV*)av);
+	    RETURN;
+	}
+    }
+    else {
+	if (SvTYPE(sv) == SVt_PVAV) {
+	    av = (AV*)sv;
+	    if (op->op_flags & OPf_REF) {
+		PUSHs((SV*)av);
+		RETURN;
+	    }
+	}
+	else {
+	    if (SvTYPE(sv) != SVt_PVGV) {
+		char *sym;
+
+		if (SvGMAGICAL(sv)) {
+		    mg_get(sv);
+		    if (SvROK(sv))
+			goto wasref;
+		}
+		if (!SvOK(sv)) {
+		    if (op->op_flags & OPf_REF ||
+		      op->op_private & HINT_STRICT_REFS)
+			DIE(no_usym, "an ARRAY");
+		    if (GIMME == G_ARRAY)
+			RETURN;
+		    RETPUSHUNDEF;
+		}
+		sym = SvPV(sv,na);
+		if (op->op_private & HINT_STRICT_REFS)
+		    DIE(no_symref, sym, "an ARRAY");
+		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
+	    }
+	    av = GvAVn(sv);
+	    if (op->op_private & OPpLVAL_INTRO)
+		av = save_ary(sv);
+	    if (op->op_flags & OPf_REF) {
+		PUSHs((SV*)av);
+		RETURN;
+	    }
+	}
+    }
+
+    if (GIMME == G_ARRAY) {
+	I32 maxarg = AvFILL(av) + 1;
+	EXTEND(SP, maxarg);
+	Copy(AvARRAY(av), SP+1, maxarg, SV*);
+	SP += maxarg;
+    }
+    else {
+	dTARGET;
+	I32 maxarg = AvFILL(av) + 1;
+	PUSHi(maxarg);
+    }
+    RETURN;
+}
+
+PP(pp_rv2hv)
+{
+
+    dSP; dTOPss;
+
+    HV *hv;
+
+    if (SvROK(sv)) {
+      wasref:
+	hv = (HV*)SvRV(sv);
+	if (SvTYPE(hv) != SVt_PVHV)
+	    DIE("Not a HASH reference");
+	if (op->op_private & OPpLVAL_INTRO)
+	    hv = (HV*)save_svref((SV**)sv);
+	if (op->op_flags & OPf_REF) {
+	    SETs((SV*)hv);
+	    RETURN;
+	}
+    }
+    else {
+	if (SvTYPE(sv) == SVt_PVHV) {
+	    hv = (HV*)sv;
+	    if (op->op_flags & OPf_REF) {
+		SETs((SV*)hv);
+		RETURN;
+	    }
+	}
+	else {
+	    if (SvTYPE(sv) != SVt_PVGV) {
+		char *sym;
+
+		if (SvGMAGICAL(sv)) {
+		    mg_get(sv);
+		    if (SvROK(sv))
+			goto wasref;
+		}
+		if (!SvOK(sv)) {
+		    if (op->op_flags & OPf_REF ||
+		      op->op_private & HINT_STRICT_REFS)
+			DIE(no_usym, "a HASH");
+		    if (GIMME == G_ARRAY) {
+			SP--;
+			RETURN;
+		    }
+		    RETSETUNDEF;
+		}
+		sym = SvPV(sv,na);
+		if (op->op_private & HINT_STRICT_REFS)
+		    DIE(no_symref, sym, "a HASH");
+		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
+	    }
+	    hv = GvHVn(sv);
+	    if (op->op_private & OPpLVAL_INTRO)
+		hv = save_hash(sv);
+	    if (op->op_flags & OPf_REF) {
+		SETs((SV*)hv);
+		RETURN;
+	    }
+	}
+    }
+
+    if (GIMME == G_ARRAY) { /* array wanted */
+	*stack_sp = (SV*)hv;
+	return do_kv(ARGS);
+    }
+    else {
+	dTARGET;
+	if (HvFILL(hv)) {
+	    sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
+	    sv_setpv(TARG, buf);
+	}
+	else
+	    sv_setiv(TARG, 0);
+	SETTARG;
+	RETURN;
+    }
+}
+
+PP(pp_aassign)
+{
+    dSP;
+    SV **lastlelem = stack_sp;
+    SV **lastrelem = stack_base + POPMARK;
+    SV **firstrelem = stack_base + POPMARK + 1;
+    SV **firstlelem = lastrelem + 1;
+
+    register SV **relem;
+    register SV **lelem;
+
+    register SV *sv;
+    register AV *ary;
+
+    HV *hash;
+    I32 i;
+    int magic;
+
+    delaymagic = DM_DELAY;		/* catch simultaneous items */
+
+    /* If there's a common identifier on both sides we have to take
+     * special care that assigning the identifier on the left doesn't
+     * clobber a value on the right that's used later in the list.
+     */
+    if (op->op_private & OPpASSIGN_COMMON) {
+        for (relem = firstrelem; relem <= lastrelem; relem++) {
+            /*SUPPRESS 560*/
+            if (sv = *relem)
+                *relem = sv_mortalcopy(sv);
+        }
+    }
+
+    relem = firstrelem;
+    lelem = firstlelem;
+    ary = Null(AV*);
+    hash = Null(HV*);
+    while (lelem <= lastlelem) {
+	tainted = 0;		/* Each item stands on its own, taintwise. */
+	sv = *lelem++;
+	switch (SvTYPE(sv)) {
+	case SVt_PVAV:
+	    ary = (AV*)sv;
+	    magic = SvMAGICAL(ary) != 0;
+	    
+	    av_clear(ary);
+	    i = 0;
+	    while (relem <= lastrelem) {	/* gobble up all the rest */
+		sv = NEWSV(28,0);
+		assert(*relem);
+		sv_setsv(sv,*relem);
+		*(relem++) = sv;
+		(void)av_store(ary,i++,sv);
+		if (magic)
+		    mg_set(sv);
+		tainted = 0;
+	    }
+	    break;
+	case SVt_PVHV: {
+		char *tmps;
+		SV *tmpstr;
+
+		hash = (HV*)sv;
+		magic = SvMAGICAL(hash) != 0;
+		hv_clear(hash);
+
+		while (relem < lastrelem) {	/* gobble up all the rest */
+		    STRLEN len;
+		    if (*relem)
+			sv = *(relem++);
+		    else
+			sv = &sv_no, relem++;
+		    tmps = SvPV(sv, len);
+		    tmpstr = NEWSV(29,0);
+		    if (*relem)
+			sv_setsv(tmpstr,*relem);	/* value */
+		    *(relem++) = tmpstr;
+		    (void)hv_store(hash,tmps,len,tmpstr,0);
+		    if (magic)
+			mg_set(tmpstr);
+		    tainted = 0;
+		}
+	    }
+	    break;
+	default:
+	    if (SvTHINKFIRST(sv)) {
+		if (SvREADONLY(sv) && curcop != &compiling) {
+		    if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
+			DIE(no_modify);
+		    if (relem <= lastrelem)
+			relem++;
+		    break;
+		}
+		if (SvROK(sv))
+		    sv_unref(sv);
+	    }
+	    if (relem <= lastrelem) {
+		sv_setsv(sv, *relem);
+		*(relem++) = sv;
+	    }
+	    else
+		sv_setsv(sv, &sv_undef);
+	    SvSETMAGIC(sv);
+	    break;
+	}
+    }
+    if (delaymagic & ~DM_DELAY) {
+	if (delaymagic & DM_UID) {
+#ifdef HAS_SETRESUID
+	    (void)setresuid(uid,euid,(Uid_t)-1);
+#else
+#  ifdef HAS_SETREUID
+	    (void)setreuid(uid,euid);
+#  else
+#    ifdef HAS_SETRUID
+	    if ((delaymagic & DM_UID) == DM_RUID) {
+		(void)setruid(uid);
+		delaymagic &= ~DM_RUID;
+	    }
+#    endif /* HAS_SETRUID */
+#    ifdef HAS_SETEUID
+	    if ((delaymagic & DM_UID) == DM_EUID) {
+		(void)seteuid(uid);
+		delaymagic &= ~DM_EUID;
+	    }
+#    endif /* HAS_SETEUID */
+	    if (delaymagic & DM_UID) {
+		if (uid != euid)
+		    DIE("No setreuid available");
+		(void)setuid(uid);
+	    }
+#  endif /* HAS_SETREUID */
+#endif /* HAS_SETRESUID */
+	    uid = (int)getuid();
+	    euid = (int)geteuid();
+	}
+	if (delaymagic & DM_GID) {
+#ifdef HAS_SETRESGID
+	    (void)setresgid(gid,egid,(Gid_t)-1);
+#else
+#  ifdef HAS_SETREGID
+	    (void)setregid(gid,egid);
+#  else
+#    ifdef HAS_SETRGID
+	    if ((delaymagic & DM_GID) == DM_RGID) {
+		(void)setrgid(gid);
+		delaymagic &= ~DM_RGID;
+	    }
+#    endif /* HAS_SETRGID */
+#    ifdef HAS_SETEGID
+	    if ((delaymagic & DM_GID) == DM_EGID) {
+		(void)setegid(gid);
+		delaymagic &= ~DM_EGID;
+	    }
+#    endif /* HAS_SETEGID */
+	    if (delaymagic & DM_GID) {
+		if (gid != egid)
+		    DIE("No setregid available");
+		(void)setgid(gid);
+	    }
+#  endif /* HAS_SETREGID */
+#endif /* HAS_SETRESGID */
+	    gid = (int)getgid();
+	    egid = (int)getegid();
+	}
+	tainting |= (uid && (euid != uid || egid != gid));
+    }
+    delaymagic = 0;
+    if (GIMME == G_ARRAY) {
+	if (ary || hash)
+	    SP = lastrelem;
+	else
+	    SP = firstrelem + (lastlelem - firstlelem);
+	RETURN;
+    }
+    else {
+	dTARGET;
+	SP = firstrelem;
+		
+	SETi(lastrelem - firstrelem + 1);
+	RETURN;
+    }
+}
+
+PP(pp_match)
+{
+    dSP; dTARG;
+    register PMOP *pm = cPMOP;
+    register char *t;
+    register char *s;
+    char *strend;
+    I32 global;
+    I32 safebase;
+    char *truebase;
+    register REGEXP *rx = pm->op_pmregexp;
+    I32 gimme = GIMME;
+    STRLEN len;
+    I32 minmatch = 0;
+    I32 oldsave = savestack_ix;
+
+    if (op->op_flags & OPf_STACKED)
+	TARG = POPs;
+    else {
+	TARG = GvSV(defgv);
+	EXTEND(SP,1);
+    }
+    s = SvPV(TARG, len);
+    strend = s + len;
+    if (!s)
+	DIE("panic: do_match");
+
+    if (pm->op_pmflags & PMf_USED) {
+	if (gimme == G_ARRAY)
+	    RETURN;
+	RETPUSHNO;
+    }
+
+    if (!rx->prelen && curpm) {
+	pm = curpm;
+	rx = pm->op_pmregexp;
+    }
+    truebase = t = s;
+    if (global = pm->op_pmflags & PMf_GLOBAL) {
+	rx->startp[0] = 0;
+	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
+	    MAGIC* mg = mg_find(TARG, 'g');
+	    if (mg && mg->mg_len >= 0) {
+		rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
+		minmatch = (mg->mg_flags & MGf_MINMATCH);
+	    }
+	}
+    }
+    if (!rx->nparens && !global)
+	gimme = G_SCALAR;			/* accidental array context? */
+    safebase = (gimme == G_ARRAY) || global;
+    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+	SAVEINT(multiline);
+	multiline = pm->op_pmflags & PMf_MULTILINE;
+    }
+
+play_it_again:
+    if (global && rx->startp[0]) {
+	t = s = rx->endp[0];
+	if (s > strend)
+	    goto nope;
+	minmatch = (s == rx->startp[0]);
+    }
+    if (pm->op_pmshort) {
+	if (pm->op_pmflags & PMf_SCANFIRST) {
+	    if (SvSCREAM(TARG)) {
+		if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
+		    goto nope;
+		else if (!(s = screaminstr(TARG, pm->op_pmshort)))
+		    goto nope;
+		else if (pm->op_pmflags & PMf_ALL)
+		    goto yup;
+	    }
+	    else if (!(s = fbm_instr((unsigned char*)s,
+	      (unsigned char*)strend, pm->op_pmshort)))
+		goto nope;
+	    else if (pm->op_pmflags & PMf_ALL)
+		goto yup;
+	    if (s && rx->regback >= 0) {
+		++BmUSEFUL(pm->op_pmshort);
+		s -= rx->regback;
+		if (s < t)
+		    s = t;
+	    }
+	    else
+		s = t;
+	}
+	else if (!multiline) {
+	    if (*SvPVX(pm->op_pmshort) != *s ||
+	      bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
+		if (pm->op_pmflags & PMf_FOLD) {
+		    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
+			goto nope;
+		}
+		else
+		    goto nope;
+	    }
+	}
+	if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
+	    SvREFCNT_dec(pm->op_pmshort);
+	    pm->op_pmshort = Nullsv;	/* opt is being useless */
+	}
+    }
+    if (pregexec(rx, s, strend, truebase, minmatch,
+      SvSCREAM(TARG) ? TARG : Nullsv,
+      safebase)) {
+	curpm = pm;
+	if (pm->op_pmflags & PMf_ONCE)
+	    pm->op_pmflags |= PMf_USED;
+	goto gotcha;
+    }
+    else
+	goto ret_no;
+    /*NOTREACHED*/
+
+  gotcha:
+    if (gimme == G_ARRAY) {
+	I32 iters, i, len;
+
+	iters = rx->nparens;
+	if (global && !iters)
+	    i = 1;
+	else
+	    i = 0;
+	EXTEND(SP, iters + i);
+	for (i = !i; i <= iters; i++) {
+	    PUSHs(sv_newmortal());
+	    /*SUPPRESS 560*/
+	    if ((s = rx->startp[i]) && rx->endp[i] ) {
+		len = rx->endp[i] - s;
+		sv_setpvn(*SP, s, len);
+	    }
+	}
+	if (global) {
+	    truebase = rx->subbeg;
+	    if (rx->startp[0] && rx->startp[0] == rx->endp[0])
+		++rx->endp[0];
+	    goto play_it_again;
+	}
+	LEAVE_SCOPE(oldsave);
+	RETURN;
+    }
+    else {
+	if (global) {
+	    MAGIC* mg = 0;
+	    if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
+		mg = mg_find(TARG, 'g');
+	    if (!mg) {
+		sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
+		mg = mg_find(TARG, 'g');
+	    }
+	    if (rx->startp[0]) {
+		mg->mg_len = rx->endp[0] - truebase;
+		if (rx->startp[0] == rx->endp[0])
+		    mg->mg_flags |= MGf_MINMATCH;
+		else
+		    mg->mg_flags &= ~MGf_MINMATCH;
+	    }
+	    else
+		mg->mg_len = -1;
+	}
+	LEAVE_SCOPE(oldsave);
+	RETPUSHYES;
+    }
+
+yup:
+    ++BmUSEFUL(pm->op_pmshort);
+    curpm = pm;
+    if (pm->op_pmflags & PMf_ONCE)
+	pm->op_pmflags |= PMf_USED;
+    if (global) {
+	rx->subbeg = truebase;
+	rx->subend = strend;
+	rx->startp[0] = s;
+	rx->endp[0] = s + SvCUR(pm->op_pmshort);
+	goto gotcha;
+    }
+    if (sawampersand) {
+	char *tmps;
+
+	if (rx->subbase)
+	    Safefree(rx->subbase);
+	tmps = rx->subbase = savepvn(t, strend-t);
+	rx->subbeg = tmps;
+	rx->subend = tmps + (strend-t);
+	tmps = rx->startp[0] = tmps + (s - t);
+	rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
+    }
+    LEAVE_SCOPE(oldsave);
+    RETPUSHYES;
+
+nope:
+    if (pm->op_pmshort)
+	++BmUSEFUL(pm->op_pmshort);
+
+ret_no:
+    if (global) {
+	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
+	    MAGIC* mg = mg_find(TARG, 'g');
+	    if (mg)
+		mg->mg_len = -1;
+	}
+    }
+    LEAVE_SCOPE(oldsave);
+    if (gimme == G_ARRAY)
+	RETURN;
+    RETPUSHNO;
+}
+
+OP *
+do_readline()
+{
+    dSP; dTARGETSTACKED;
+    register SV *sv;
+    STRLEN tmplen = 0;
+    STRLEN offset;
+    FILE *fp;
+    register IO *io = GvIO(last_in_gv);
+    register I32 type = op->op_type;
+
+    fp = Nullfp;
+    if (io) {
+	fp = IoIFP(io);
+	if (!fp) {
+	    if (IoFLAGS(io) & IOf_ARGV) {
+		if (IoFLAGS(io) & IOf_START) {
+		    IoFLAGS(io) &= ~IOf_START;
+		    IoLINES(io) = 0;
+		    if (av_len(GvAVn(last_in_gv)) < 0) {
+			SV *tmpstr = newSVpv("-", 1); /* assume stdin */
+			av_push(GvAVn(last_in_gv), tmpstr);
+		    }
+		}
+		fp = nextargv(last_in_gv);
+		if (!fp) { /* Note: fp != IoIFP(io) */
+		    (void)do_close(last_in_gv, FALSE); /* now it does*/
+		    IoFLAGS(io) |= IOf_START;
+		}
+	    }
+	    else if (type == OP_GLOB) {
+		SV *tmpcmd = NEWSV(55, 0);
+		SV *tmpglob = POPs;
+		ENTER;
+		SAVEFREESV(tmpcmd);
+#ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
+           /* since spawning off a process is a real performance hit */
+		{
+#include <descrip.h>
+#include <lib$routines.h>
+#include <nam.h>
+#include <rmsdef.h>
+		    char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
+		    char vmsspec[NAM$C_MAXRSS+1];
+		    char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
+		    char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
+		    $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
+		    FILE *tmpfp;
+		    STRLEN i;
+		    struct dsc$descriptor_s wilddsc
+		       = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+		    struct dsc$descriptor_vs rsdsc
+		       = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
+		    unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
+
+		    /* We could find out if there's an explicit dev/dir or version
+		       by peeking into lib$find_file's internal context at
+		       ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
+		       but that's unsupported, so I don't want to do it now and
+		       have it bite someone in the future. */
+		    strcat(tmpfnam,tmpnam(NULL));
+		    cp = SvPV(tmpglob,i);
+		    for (; i; i--) {
+		       if (cp[i] == ';') hasver = 1;
+		       if (cp[i] == '.') {
+		           if (sts) hasver = 1;
+		           else sts = 1;
+		       }
+		       if (cp[i] == '/') {
+		          hasdir = isunix = 1;
+		          break;
+		       }
+		       if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
+		           hasdir = 1;
+		           break;
+		       }
+		    }
+		    if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
+		        ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
+		        if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
+		        while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
+		                                    &dfltdsc,NULL,NULL,NULL))&1)) {
+		            end = rstr + (unsigned long int) *rslt;
+		            if (!hasver) while (*end != ';') end--;
+		            *(end++) = '\n';  *end = '\0';
+		            for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
+		            if (hasdir) {
+		              if (isunix) trim_unixpath(rstr,SvPVX(tmpglob));
+		              begin = rstr;
+		            }
+		            else {
+		                begin = end;
+		                while (*(--begin) != ']' && *begin != '>') ;
+		                ++begin;
+		            }
+		            ok = (fputs(begin,tmpfp) != EOF);
+		        }
+		        if (cxt) (void)lib$find_file_end(&cxt);
+		        if (ok && sts != RMS$_NMF &&
+		            sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
+		        if (!ok) {
+		            if (!(sts & 1)) {
+		              SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
+		            }
+		            fclose(tmpfp);
+		            fp = NULL;
+		        }
+		        else {
+		           rewind(tmpfp);
+		           IoTYPE(io) = '<';
+		           IoIFP(io) = fp = tmpfp;
+		        }
+		    }
+		}
+#else /* !VMS */
+#ifdef DOSISH
+		sv_setpv(tmpcmd, "perlglob ");
+		sv_catsv(tmpcmd, tmpglob);
+		sv_catpv(tmpcmd, " |");
+#else
+#ifdef CSH
+		sv_setpvn(tmpcmd, cshname, cshlen);
+		sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
+		sv_catsv(tmpcmd, tmpglob);
+		sv_catpv(tmpcmd, "' 2>/dev/null |");
+#else
+		sv_setpv(tmpcmd, "echo ");
+		sv_catsv(tmpcmd, tmpglob);
+#if 'z' - 'a' == 25
+		sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
+#else
+		sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
+#endif
+#endif /* !CSH */
+#endif /* !MSDOS */
+		(void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+			      FALSE, 0, 0, Nullfp);
+		fp = IoIFP(io);
+#endif /* !VMS */
+		LEAVE;
+	    }
+	}
+	else if (type == OP_GLOB)
+	    SP--;
+    }
+    if (!fp) {
+	if (dowarn && io && !(IoFLAGS(io) & IOf_START))
+	    warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
+	if (GIMME == G_SCALAR) {
+	    (void)SvOK_off(TARG);
+	    PUSHTARG;
+	}
+	RETURN;
+    }
+    if (GIMME == G_ARRAY) {
+	sv = sv_2mortal(NEWSV(57, 80));
+	offset = 0;
+    }
+    else {
+	sv = TARG;
+	(void)SvUPGRADE(sv, SVt_PV);
+	tmplen = SvLEN(sv);	/* remember if already alloced */
+	if (!tmplen)
+	    Sv_Grow(sv, 80);	/* try short-buffering it */
+	if (type == OP_RCATLINE)
+	    offset = SvCUR(sv);
+	else
+	    offset = 0;
+    }
+    for (;;) {
+	if (!sv_gets(sv, fp, offset)) {
+	    clearerr(fp);
+	    if (IoFLAGS(io) & IOf_ARGV) {
+		fp = nextargv(last_in_gv);
+		if (fp)
+		    continue;
+		(void)do_close(last_in_gv, FALSE);
+		IoFLAGS(io) |= IOf_START;
+	    }
+	    else if (type == OP_GLOB) {
+		(void)do_close(last_in_gv, FALSE);
+	    }
+	    if (GIMME == G_SCALAR) {
+		(void)SvOK_off(TARG);
+		PUSHTARG;
+	    }
+	    RETURN;
+	}
+	IoLINES(io)++;
+	XPUSHs(sv);
+	if (tainting) {
+	    tainted = TRUE;
+	    SvTAINT(sv); /* Anything from the outside world...*/
+	}
+	if (type == OP_GLOB) {
+	    char *tmps;
+
+	    if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
+		tmps = SvEND(sv) - 1;
+		if (*tmps == *SvPVX(rs)) {
+		    *tmps = '\0';
+		    SvCUR(sv)--;
+		}
+	    }
+	    for (tmps = SvPVX(sv); *tmps; tmps++)
+		if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
+		    strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
+			break;
+	    if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
+		(void)POPs;		/* Unmatched wildcard?  Chuck it... */
+		continue;
+	    }
+	}
+	if (GIMME == G_ARRAY) {
+	    if (SvLEN(sv) - SvCUR(sv) > 20) {
+		SvLEN_set(sv, SvCUR(sv)+1);
+		Renew(SvPVX(sv), SvLEN(sv), char);
+	    }
+	    sv = sv_2mortal(NEWSV(58, 80));
+	    continue;
+	}
+	else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
+	    /* try to reclaim a bit of scalar space (only on 1st alloc) */
+	    if (SvCUR(sv) < 60)
+		SvLEN_set(sv, 80);
+	    else
+		SvLEN_set(sv, SvCUR(sv)+40);	/* allow some slop */
+	    Renew(SvPVX(sv), SvLEN(sv), char);
+	}
+	RETURN;
+    }
+}
+
+PP(pp_enter)
+{
+    dSP;
+    register CONTEXT *cx;
+    I32 gimme;
+
+    /*
+     * We don't just use the GIMME macro here because it assumes there's
+     * already a context, which ain't necessarily so at initial startup.
+     */
+
+    if (op->op_flags & OPf_KNOW)
+	gimme = op->op_flags & OPf_LIST;
+    else if (cxstack_ix >= 0)
+	gimme = cxstack[cxstack_ix].blk_gimme;
+    else
+	gimme = G_SCALAR;
+
+    ENTER;
+
+    SAVETMPS;
+    PUSHBLOCK(cx, CXt_BLOCK, sp);
+
+    RETURN;
+}
+
+PP(pp_helem)
+{
+    dSP;
+    SV** svp;
+    SV *keysv = POPs;
+    STRLEN keylen;
+    char *key = SvPV(keysv, keylen);
+    HV *hv = (HV*)POPs;
+    I32 lval = op->op_flags & OPf_MOD;
+
+    if (SvTYPE(hv) != SVt_PVHV)
+	RETPUSHUNDEF;
+    svp = hv_fetch(hv, key, keylen, lval);
+    if (lval) {
+	if (!svp || *svp == &sv_undef)
+	    DIE(no_helem, key);
+	if (op->op_private & OPpLVAL_INTRO)
+	    save_svref(svp);
+	else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+	    provide_ref(op, *svp);
+    }
+    PUSHs(svp ? *svp : &sv_undef);
+    RETURN;
+}
+
+PP(pp_leave)
+{
+    dSP;
+    register CONTEXT *cx;
+    register SV **mark;
+    SV **newsp;
+    PMOP *newpm;
+    I32 gimme;
+
+    if (op->op_flags & OPf_SPECIAL) {
+	cx = &cxstack[cxstack_ix];
+	cx->blk_oldpm = curpm;	/* fake block should preserve $1 et al */
+    }
+
+    POPBLOCK(cx,newpm);
+
+    if (op->op_flags & OPf_KNOW)
+	gimme = op->op_flags & OPf_LIST;
+    else if (cxstack_ix >= 0)
+	gimme = cxstack[cxstack_ix].blk_gimme;
+    else
+	gimme = G_SCALAR;
+
+    if (gimme == G_SCALAR) {
+	if (op->op_private & OPpLEAVE_VOID)
+	    SP = newsp;
+	else {
+	    MARK = newsp + 1;
+	    if (MARK <= SP)
+		if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
+		    *MARK = TOPs;
+		else
+		    *MARK = sv_mortalcopy(TOPs);
+	    else {
+		MEXTEND(mark,0);
+		*MARK = &sv_undef;
+	    }
+	    SP = MARK;
+	}
+    }
+    else {
+	for (mark = newsp + 1; mark <= SP; mark++)
+	    if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+		*mark = sv_mortalcopy(*mark);
+		/* in case LEAVE wipes old return values */
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+
+    LEAVE;
+
+    RETURN;
+}
+
+PP(pp_iter)
+{
+    dSP;
+    register CONTEXT *cx;
+    SV *sv;
+    AV* av;
+
+    EXTEND(sp, 1);
+    cx = &cxstack[cxstack_ix];
+    if (cx->cx_type != CXt_LOOP)
+	DIE("panic: pp_iter");
+    av = cx->blk_loop.iterary;
+    if (av == stack && cx->blk_loop.iterix >= cx->blk_oldsp)
+	RETPUSHNO;
+
+    if (cx->blk_loop.iterix >= AvFILL(av))
+	RETPUSHNO;
+
+    if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) {
+	SvTEMP_off(sv);
+	*cx->blk_loop.itervar = sv;
+    }
+    else
+	*cx->blk_loop.itervar = &sv_undef;
+
+    RETPUSHYES;
+}
+
+PP(pp_subst)
+{
+    dSP; dTARG;
+    register PMOP *pm = cPMOP;
+    PMOP *rpm = pm;
+    register SV *dstr;
+    register char *s;
+    char *strend;
+    register char *m;
+    char *c;
+    register char *d;
+    STRLEN clen;
+    I32 iters = 0;
+    I32 maxiters;
+    register I32 i;
+    bool once;
+    char *orig;
+    I32 safebase;
+    register REGEXP *rx = pm->op_pmregexp;
+    STRLEN len;
+    int force_on_match = 0;
+    I32 oldsave = savestack_ix;
+
+    if (pm->op_pmflags & PMf_CONST)	/* known replacement string? */
+	dstr = POPs;
+    if (op->op_flags & OPf_STACKED)
+	TARG = POPs;
+    else {
+	TARG = GvSV(defgv);
+	EXTEND(SP,1);
+    }
+    s = SvPV(TARG, len);
+    if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
+	force_on_match = 1;
+
+  force_it:
+    if (!pm || !s)
+	DIE("panic: do_subst");
+
+    strend = s + len;
+    maxiters = (strend - s) + 10;
+
+    if (!rx->prelen && curpm) {
+	pm = curpm;
+	rx = pm->op_pmregexp;
+    }
+    safebase = ((!rx || !rx->nparens) && !sawampersand);
+    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+	SAVEINT(multiline);
+	multiline = pm->op_pmflags & PMf_MULTILINE;
+    }
+    orig = m = s;
+    if (pm->op_pmshort) {
+	if (pm->op_pmflags & PMf_SCANFIRST) {
+	    if (SvSCREAM(TARG)) {
+		if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
+		    goto nope;
+		else if (!(s = screaminstr(TARG, pm->op_pmshort)))
+		    goto nope;
+	    }
+	    else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
+	      pm->op_pmshort)))
+		goto nope;
+	    if (s && rx->regback >= 0) {
+		++BmUSEFUL(pm->op_pmshort);
+		s -= rx->regback;
+		if (s < m)
+		    s = m;
+	    }
+	    else
+		s = m;
+	}
+	else if (!multiline) {
+	    if (*SvPVX(pm->op_pmshort) != *s ||
+	      bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
+		if (pm->op_pmflags & PMf_FOLD) {
+		    if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
+			goto nope;
+		}
+		else
+		    goto nope;
+	    }
+	}
+	if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
+	    SvREFCNT_dec(pm->op_pmshort);
+	    pm->op_pmshort = Nullsv;	/* opt is being useless */
+	}
+    }
+    once = !(rpm->op_pmflags & PMf_GLOBAL);
+    if (rpm->op_pmflags & PMf_CONST) {	/* known replacement string? */
+	c = SvPV(dstr, clen);
+	if (clen <= rx->minlen) {
+					/* can do inplace substitution */
+	    if (pregexec(rx, s, strend, orig, 0,
+	      SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
+		if (force_on_match) {
+		    force_on_match = 0;
+		    s = SvPV_force(TARG, len);
+		    goto force_it;
+		}
+		if (rx->subbase) 	/* oops, no we can't */
+		    goto long_way;
+		d = s;
+		curpm = pm;
+		SvSCREAM_off(TARG);	/* disable possible screamer */
+		if (once) {
+		    m = rx->startp[0];
+		    d = rx->endp[0];
+		    s = orig;
+		    if (m - s > strend - d) {	/* faster to shorten from end */
+			if (clen) {
+			    Copy(c, m, clen, char);
+			    m += clen;
+			}
+			i = strend - d;
+			if (i > 0) {
+			    Move(d, m, i, char);
+			    m += i;
+			}
+			*m = '\0';
+			SvCUR_set(TARG, m - s);
+			(void)SvPOK_only(TARG);
+			SvSETMAGIC(TARG);
+			PUSHs(&sv_yes);
+			LEAVE_SCOPE(oldsave);
+			RETURN;
+		    }
+		    /*SUPPRESS 560*/
+		    else if (i = m - s) {	/* faster from front */
+			d -= clen;
+			m = d;
+			sv_chop(TARG, d-i);
+			s += i;
+			while (i--)
+			    *--d = *--s;
+			if (clen)
+			    Copy(c, m, clen, char);
+			(void)SvPOK_only(TARG);
+			SvSETMAGIC(TARG);
+			PUSHs(&sv_yes);
+			LEAVE_SCOPE(oldsave);
+			RETURN;
+		    }
+		    else if (clen) {
+			d -= clen;
+			sv_chop(TARG, d);
+			Copy(c, d, clen, char);
+			(void)SvPOK_only(TARG);
+			SvSETMAGIC(TARG);
+			PUSHs(&sv_yes);
+			LEAVE_SCOPE(oldsave);
+			RETURN;
+		    }
+		    else {
+			sv_chop(TARG, d);
+			(void)SvPOK_only(TARG);
+			SvSETMAGIC(TARG);
+			PUSHs(&sv_yes);
+			LEAVE_SCOPE(oldsave);
+			RETURN;
+		    }
+		    /* NOTREACHED */
+		}
+		do {
+		    if (iters++ > maxiters)
+			DIE("Substitution loop");
+		    m = rx->startp[0];
+		    /*SUPPRESS 560*/
+		    if (i = m - s) {
+			if (s != d)
+			    Move(s, d, i, char);
+			d += i;
+		    }
+		    if (clen) {
+			Copy(c, d, clen, char);
+			d += clen;
+		    }
+		    s = rx->endp[0];
+		} while (pregexec(rx, s, strend, orig, s == m,
+		    Nullsv, TRUE));	/* (don't match same null twice) */
+		if (s != d) {
+		    i = strend - s;
+		    SvCUR_set(TARG, d - SvPVX(TARG) + i);
+		    Move(s, d, i+1, char);		/* include the Null */
+		}
+		(void)SvPOK_only(TARG);
+		SvSETMAGIC(TARG);
+		PUSHs(sv_2mortal(newSViv((I32)iters)));
+		LEAVE_SCOPE(oldsave);
+		RETURN;
+	    }
+	    PUSHs(&sv_no);
+	    LEAVE_SCOPE(oldsave);
+	    RETURN;
+	}
+    }
+    else
+	c = Nullch;
+    if (pregexec(rx, s, strend, orig, 0,
+      SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
+    long_way:
+	if (force_on_match) {
+	    force_on_match = 0;
+	    s = SvPV_force(TARG, len);
+	    goto force_it;
+	}
+	dstr = NEWSV(25, sv_len(TARG));
+	sv_setpvn(dstr, m, s-m);
+	curpm = pm;
+	if (!c) {
+	    register CONTEXT *cx;
+	    PUSHSUBST(cx);
+	    RETURNOP(cPMOP->op_pmreplroot);
+	}
+	do {
+	    if (iters++ > maxiters)
+		DIE("Substitution loop");
+	    if (rx->subbase && rx->subbase != orig) {
+		m = s;
+		s = orig;
+		orig = rx->subbase;
+		s = orig + (m - s);
+		strend = s + (strend - m);
+	    }
+	    m = rx->startp[0];
+	    sv_catpvn(dstr, s, m-s);
+	    s = rx->endp[0];
+	    if (clen)
+		sv_catpvn(dstr, c, clen);
+	    if (once)
+		break;
+	} while (pregexec(rx, s, strend, orig, s == m, Nullsv,
+	    safebase));
+	sv_catpvn(dstr, s, strend - s);
+
+	(void)SvOOK_off(TARG);
+	Safefree(SvPVX(TARG));
+	SvPVX(TARG) = SvPVX(dstr);
+	SvCUR_set(TARG, SvCUR(dstr));
+	SvLEN_set(TARG, SvLEN(dstr));
+	SvPVX(dstr) = 0;
+	sv_free(dstr);
+
+	(void)SvPOK_only(TARG);
+	SvSETMAGIC(TARG);
+	PUSHs(sv_2mortal(newSViv((I32)iters)));
+	LEAVE_SCOPE(oldsave);
+	RETURN;
+    }
+    PUSHs(&sv_no);
+    LEAVE_SCOPE(oldsave);
+    RETURN;
+
+nope:
+    ++BmUSEFUL(pm->op_pmshort);
+    PUSHs(&sv_no);
+    LEAVE_SCOPE(oldsave);
+    RETURN;
+}
+
+PP(pp_grepwhile)
+{
+    dSP;
+
+    if (SvTRUEx(POPs))
+	stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
+    ++*markstack_ptr;
+    LEAVE;					/* exit inner scope */
+
+    /* All done yet? */
+    if (stack_base + *markstack_ptr > sp) {
+	I32 items;
+
+	LEAVE;					/* exit outer scope */
+	(void)POPMARK;				/* pop src */
+	items = --*markstack_ptr - markstack_ptr[-1];
+	(void)POPMARK;				/* pop dst */
+	SP = stack_base + POPMARK;		/* pop original mark */
+	if (GIMME != G_ARRAY) {
+	    dTARGET;
+	    XPUSHi(items);
+	    RETURN;
+	}
+	SP += items;
+	RETURN;
+    }
+    else {
+	SV *src;
+
+	ENTER;					/* enter inner scope */
+	SAVESPTR(curpm);
+
+	src = stack_base[*markstack_ptr];
+	SvTEMP_off(src);
+	GvSV(defgv) = src;
+
+	RETURNOP(cLOGOP->op_other);
+    }
+}
+
+PP(pp_leavesub)
+{
+    dSP;
+    SV **mark;
+    SV **newsp;
+    PMOP *newpm;
+    I32 gimme;
+    register CONTEXT *cx;
+
+    POPBLOCK(cx,newpm);
+    POPSUB(cx);
+
+    if (gimme == G_SCALAR) {
+	MARK = newsp + 1;
+	if (MARK <= SP)
+	    if (SvFLAGS(TOPs) & SVs_TEMP)
+		*MARK = TOPs;
+	    else
+		*MARK = sv_mortalcopy(TOPs);
+	else {
+	    MEXTEND(mark,0);
+	    *MARK = &sv_undef;
+	}
+	SP = MARK;
+    }
+    else {
+	for (mark = newsp + 1; mark <= SP; mark++)
+	    if (!(SvFLAGS(*mark) & SVs_TEMP))
+		*mark = sv_mortalcopy(*mark);
+		/* in case LEAVE wipes old return values */
+    }
+
+    if (cx->blk_sub.hasargs) {		/* You don't exist; go away. */
+	AV* av = cx->blk_sub.argarray;
+
+	av_clear(av);
+	AvREAL_off(av);
+    }
+    curpm = newpm;	/* Don't pop $1 et al till now */
+
+    LEAVE;
+    PUTBACK;
+    return pop_return();
+}
+
+PP(pp_entersub)
+{
+    dSP; dPOPss;
+    GV *gv;
+    HV *stash;
+    register CV *cv;
+    register CONTEXT *cx;
+    I32 gimme;
+
+    if (!sv)
+	DIE("Not a CODE reference");
+    switch (SvTYPE(sv)) {
+    default:
+	if (!SvROK(sv)) {
+	    char *sym;
+
+	    if (sv == &sv_yes)		/* unfound import, ignore */
+		RETURN;
+	    if (!SvOK(sv))
+		DIE(no_usym, "a subroutine");
+	    sym = SvPV(sv,na);
+	    if (op->op_private & HINT_STRICT_REFS)
+		DIE(no_symref, sym, "a subroutine");
+	    cv = perl_get_cv(sym, TRUE);
+	    break;
+	}
+	cv = (CV*)SvRV(sv);
+	if (SvTYPE(cv) == SVt_PVCV)
+	    break;
+	/* FALL THROUGH */
+    case SVt_PVHV:
+    case SVt_PVAV:
+	DIE("Not a CODE reference");
+    case SVt_PVCV:
+	cv = (CV*)sv;
+	break;
+    case SVt_PVGV:
+	if (!(cv = GvCV((GV*)sv)))
+	    cv = sv_2cv(sv, &stash, &gv, TRUE);
+	break;
+    }
+
+    ENTER;
+    SAVETMPS;
+
+  retry:
+    if (!cv)
+	DIE("Not a CODE reference");
+
+    if (!CvROOT(cv) && !CvXSUB(cv)) {
+	if (gv = CvGV(cv)) {
+	    SV *tmpstr;
+	    GV *ngv;
+	    if (SvFAKE(cv) && GvCV(gv) != cv) {	/* autoloaded stub? */
+		cv = GvCV(gv);
+		if (SvTYPE(sv) == SVt_PVGV) {
+		    SvREFCNT_dec(GvCV((GV*)sv));
+		    GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
+		}
+		goto retry;
+	    }
+	    tmpstr = sv_newmortal();
+	    gv_efullname(tmpstr, gv);
+	    ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
+	    if (ngv && ngv != gv && (cv = GvCV(ngv))) {	/* One more chance... */
+		gv = ngv;
+		sv_setsv(GvSV(CvGV(cv)), tmpstr);	/* Set CV's $AUTOLOAD */
+		if (tainting)
+		    sv_unmagic(GvSV(CvGV(cv)), 't');
+		goto retry;
+	    }
+	    else
+		DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
+	}
+	DIE("Undefined subroutine called");
+    }
+
+    gimme = GIMME;
+    if ((op->op_private & OPpENTERSUB_DB) && !CvXSUB(cv)) {
+	sv = GvSV(DBsub);
+	save_item(sv);
+	if (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) {
+	    /* GV is potentially non-unique */
+	    sv_setsv(sv, newRV((SV*)cv));
+	}
+	else {
+	    gv = CvGV(cv);
+	    gv_efullname(sv,gv);
+	}
+	cv = GvCV(DBsub);
+	if (!cv)
+	    DIE("No DBsub routine");
+    }
+
+    if (CvXSUB(cv)) {
+	if (CvOLDSTYLE(cv)) {
+	    I32 (*fp3)_((int,int,int));
+	    dMARK;
+	    register I32 items = SP - MARK;
+	    while (sp > mark) {
+		sp[1] = sp[0];
+		sp--;
+	    }
+	    stack_sp = mark + 1;
+	    fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
+	    items = (*fp3)(CvXSUBANY(cv).any_i32, 
+			   MARK - stack_base + 1,
+			   items);
+	    stack_sp = stack_base + items;
+	}
+	else {
+	    I32 markix = TOPMARK;
+
+	    PUTBACK;
+	    (void)(*CvXSUB(cv))(cv);
+
+	    /* Enforce some sanity in scalar context. */
+	    if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
+		if (markix > stack_sp - stack_base)
+		    *(stack_base + markix) = &sv_undef;
+		else
+		    *(stack_base + markix) = *stack_sp;
+		stack_sp = stack_base + markix;
+	    }
+	}
+	LEAVE;
+	return NORMAL;
+    }
+    else {
+	dMARK;
+	register I32 items = SP - MARK;
+	I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
+	AV* padlist = CvPADLIST(cv);
+	SV** svp = AvARRAY(padlist);
+	push_return(op->op_next);
+	PUSHBLOCK(cx, CXt_SUB, MARK);
+	PUSHSUB(cx);
+	CvDEPTH(cv)++;
+	if (CvDEPTH(cv) < 2)
+	    (void)SvREFCNT_inc(cv);
+	else {	/* save temporaries on recursion? */
+	    if (CvDEPTH(cv) == 100 && dowarn)
+		warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
+	    if (CvDEPTH(cv) > AvFILL(padlist)) {
+		AV *av;
+		AV *newpad = newAV();
+		SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
+		I32 ix = AvFILL((AV*)svp[1]);
+		svp = AvARRAY(svp[0]);
+		for ( ;ix > 0; ix--) {
+		    if (svp[ix] != &sv_undef) {
+			char *name = SvPVX(svp[ix]);
+			if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
+			    av_store(newpad, ix,
+				SvREFCNT_inc(oldpad[ix]) );
+			}
+			else {				/* our own lexical */
+			    if (*name == '@')
+				av_store(newpad, ix, sv = (SV*)newAV());
+			    else if (*name == '%')
+				av_store(newpad, ix, sv = (SV*)newHV());
+			    else
+				av_store(newpad, ix, sv = NEWSV(0,0));
+			    SvPADMY_on(sv);
+			}
+		    }
+		    else {
+			av_store(newpad, ix, sv = NEWSV(0,0));
+			SvPADTMP_on(sv);
+		    }
+		}
+		av = newAV();		/* will be @_ */
+		av_extend(av, 0);
+		av_store(newpad, 0, (SV*)av);
+		AvFLAGS(av) = AVf_REIFY;
+		av_store(padlist, CvDEPTH(cv), (SV*)newpad);
+		AvFILL(padlist) = CvDEPTH(cv);
+		svp = AvARRAY(padlist);
+	    }
+	}
+	SAVESPTR(curpad);
+	curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+	if (hasargs) {
+	    AV* av = (AV*)curpad[0];
+	    SV** ary;
+
+	    if (AvREAL(av)) {
+		av_clear(av);
+		AvREAL_off(av);
+	    }
+	    cx->blk_sub.savearray = GvAV(defgv);
+	    cx->blk_sub.argarray = av;
+	    GvAV(defgv) = cx->blk_sub.argarray;
+	    ++MARK;
+
+	    if (items > AvMAX(av) + 1) {
+		ary = AvALLOC(av);
+		if (AvARRAY(av) != ary) {
+		    AvMAX(av) += AvARRAY(av) - AvALLOC(av);
+		    SvPVX(av) = (char*)ary;
+		}
+		if (items > AvMAX(av) + 1) {
+		    AvMAX(av) = items - 1;
+		    Renew(ary,items,SV*);
+		    AvALLOC(av) = ary;
+		    SvPVX(av) = (char*)ary;
+		}
+	    }
+	    Copy(MARK,AvARRAY(av),items,SV*);
+	    AvFILL(av) = items - 1;
+	    
+	    while (items--) {
+		if (*MARK)
+		    SvTEMP_off(*MARK);
+		MARK++;
+	    }
+	}
+	RETURNOP(CvSTART(cv));
+    }
+}
+
+PP(pp_aelem)
+{
+    dSP;
+    SV** svp;
+    I32 elem = POPi;
+    AV *av = (AV*)POPs;
+    I32 lval = op->op_flags & OPf_MOD;
+
+    if (elem > 0)
+	elem -= curcop->cop_arybase;
+    if (SvTYPE(av) != SVt_PVAV)
+	RETPUSHUNDEF;
+    svp = av_fetch(av, elem, lval);
+    if (lval) {
+	if (!svp || *svp == &sv_undef)
+	    DIE(no_aelem, elem);
+	if (op->op_private & OPpLVAL_INTRO)
+	    save_svref(svp);
+	else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
+	    provide_ref(op, *svp);
+    }
+    PUSHs(svp ? *svp : &sv_undef);
+    RETURN;
+}
+
+void
+provide_ref(op, sv)
+OP* op;
+SV* sv;
+{
+    if (SvGMAGICAL(sv))
+	mg_get(sv);
+    if (!SvOK(sv)) {
+	if (SvREADONLY(sv))
+	    croak(no_modify);
+	(void)SvUPGRADE(sv, SVt_RV);
+	SvRV(sv) = (op->op_private & OPpDEREF_HV ?
+		    (SV*)newHV() : (SV*)newAV());
+	SvROK_on(sv);
+	SvSETMAGIC(sv);
+    }
+}
+
+PP(pp_method)
+{
+    dSP;
+    SV* sv;
+    SV* ob;
+    GV* gv;
+    SV* nm;
+
+    nm = TOPs;
+    sv = *(stack_base + TOPMARK + 1);
+    
+    gv = 0;
+    if (SvGMAGICAL(sv))
+        mg_get(sv);
+    if (SvROK(sv))
+	ob = (SV*)SvRV(sv);
+    else {
+	GV* iogv;
+	char* packname = 0;
+
+	if (!SvOK(sv) ||
+	    !(packname = SvPV(sv, na)) ||
+	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
+	    !(ob=(SV*)GvIO(iogv)))
+	{
+	    char *name = SvPV(nm, na);
+	    HV *stash;
+	    if (!packname || !isALPHA(*packname))
+DIE("Can't call method \"%s\" without a package or object reference", name);
+	    if (!(stash = gv_stashpv(packname, FALSE))) {
+		if (gv_stashpv("UNIVERSAL", FALSE))
+		    stash = gv_stashpv(packname, TRUE);
+		else
+		    DIE("Can't call method \"%s\" in empty package \"%s\"",
+			name, packname);
+	    }
+	    gv = gv_fetchmethod(stash,name);
+	    if (!gv)
+		DIE("Can't locate object method \"%s\" via package \"%s\"",
+		    name, packname);
+	    SETs(gv);
+	    RETURN;
+	}
+	*(stack_base + TOPMARK + 1) = sv_2mortal(newRV(iogv));
+    }
+
+    if (!ob || !SvOBJECT(ob)) {
+	char *name = SvPV(nm, na);
+	DIE("Can't call method \"%s\" on unblessed reference", name);
+    }
+
+    if (!gv) {		/* nothing cached */
+	char *name = SvPV(nm, na);
+	gv = gv_fetchmethod(SvSTASH(ob),name);
+	if (!gv)
+	    DIE("Can't locate object method \"%s\" via package \"%s\"",
+		name, HvNAME(SvSTASH(ob)));
+    }
+
+    SETs(gv);
+    RETURN;
+}
+
diff --git a/gnu/usr.bin/perl/pp_sys.c b/gnu/usr.bin/perl/pp_sys.c
new file mode 100644
index 00000000000..ba1f105a06b
--- /dev/null
+++ b/gnu/usr.bin/perl/pp_sys.c
@@ -0,0 +1,4060 @@
+/*    pp_sys.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * But only a short way ahead its floor and the walls on either side were
+ * cloven by a great fissure, out of which the red glare came, now leaping
+ * up, now dying down into darkness; and all the while far below there was
+ * a rumour and a trouble as of great engines throbbing and labouring.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/* XXX Omit this -- it causes too much grief on mixed systems.
+   Next time, I should force broken systems to unset i_unistd in
+   hint files.
+*/
+#if 0
+# ifdef I_UNISTD
+#  include <unistd.h>
+# endif
+#endif
+
+/* Put this after #includes because fork and vfork prototypes may
+   conflict.
+*/
+#ifndef HAS_VFORK
+#   define vfork fork
+#endif
+
+#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
+# include <sys/socket.h>
+# include <netdb.h>
+# ifndef ENOTSOCK
+#  ifdef I_NET_ERRNO
+#   include <net/errno.h>
+#  endif
+# endif
+#endif
+
+#ifdef HAS_SELECT
+#ifdef I_SYS_SELECT
+#ifndef I_SYS_TIME
+#include <sys/select.h>
+#endif
+#endif
+#endif
+
+#ifdef HOST_NOT_FOUND
+extern int h_errno;
+#endif
+
+#ifdef HAS_PASSWD
+# ifdef I_PWD
+#  include <pwd.h>
+# else
+    struct passwd *getpwnam _((char *));
+    struct passwd *getpwuid _((Uid_t));
+# endif
+  struct passwd *getpwent _((void));
+#endif
+
+#ifdef HAS_GROUP
+# ifdef I_GRP
+#  include <grp.h>
+# else
+    struct group *getgrnam _((char *));
+    struct group *getgrgid _((Gid_t));
+# endif
+    struct group *getgrent _((void));
+#endif
+
+#ifdef I_UTIME
+#include <utime.h>
+#endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
+static int dooneliner _((char *cmd, char *filename));
+#endif
+/* Pushy I/O. */
+
+PP(pp_backtick)
+{
+    dSP; dTARGET;
+    FILE *fp;
+    char *tmps = POPp;
+    TAINT_PROPER("``");
+    fp = my_popen(tmps, "r");
+    if (fp) {
+	sv_setpv(TARG, "");	/* note that this preserves previous buffer */
+	if (GIMME == G_SCALAR) {
+	    while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
+		/*SUPPRESS 530*/
+		;
+	    XPUSHs(TARG);
+	}
+	else {
+	    SV *sv;
+
+	    for (;;) {
+		sv = NEWSV(56, 80);
+		if (sv_gets(sv, fp, 0) == Nullch) {
+		    SvREFCNT_dec(sv);
+		    break;
+		}
+		XPUSHs(sv_2mortal(sv));
+		if (SvLEN(sv) - SvCUR(sv) > 20) {
+		    SvLEN_set(sv, SvCUR(sv)+1);
+		    Renew(SvPVX(sv), SvLEN(sv), char);
+		}
+	    }
+	}
+	statusvalue = FIXSTATUS(my_pclose(fp));
+    }
+    else {
+	statusvalue = -1;
+	if (GIMME == G_SCALAR)
+	    RETPUSHUNDEF;
+    }
+
+    RETURN;
+}
+
+PP(pp_glob)
+{
+    OP *result;
+    ENTER;
+
+    SAVESPTR(last_in_gv);	/* We don't want this to be permanent. */
+    last_in_gv = (GV*)*stack_sp--;
+
+    SAVESPTR(rs);		/* This is not permanent, either. */
+    rs = sv_2mortal(newSVpv("", 1));
+#ifndef DOSISH
+#ifndef CSH
+    *SvPVX(rs) = '\n';
+#endif	/* !CSH */
+#endif	/* !MSDOS */
+
+    result = do_readline();
+    LEAVE;
+    return result;
+}
+
+PP(pp_indread)
+{
+    last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
+    return do_readline();
+}
+
+PP(pp_rcatline)
+{
+    last_in_gv = cGVOP->op_gv;
+    return do_readline();
+}
+
+PP(pp_warn)
+{
+    dSP; dMARK;
+    char *tmps;
+    if (SP - MARK != 1) {
+	dTARGET;
+	do_join(TARG, &sv_no, MARK, SP);
+	tmps = SvPV(TARG, na);
+	SP = MARK + 1;
+    }
+    else {
+	tmps = SvPV(TOPs, na);
+    }
+    if (!tmps || !*tmps) {
+	SV *error = GvSV(errgv);
+	(void)SvUPGRADE(error, SVt_PV);
+	if (SvPOK(error) && SvCUR(error))
+	    sv_catpv(error, "\t...caught");
+	tmps = SvPV(error, na);
+    }
+    if (!tmps || !*tmps)
+	tmps = "Warning: something's wrong";
+    warn("%s", tmps);
+    RETSETYES;
+}
+
+PP(pp_die)
+{
+    dSP; dMARK;
+    char *tmps;
+    if (SP - MARK != 1) {
+	dTARGET;
+	do_join(TARG, &sv_no, MARK, SP);
+	tmps = SvPV(TARG, na);
+	SP = MARK + 1;
+    }
+    else {
+	tmps = SvPV(TOPs, na);
+    }
+    if (!tmps || !*tmps) {
+	SV *error = GvSV(errgv);
+	(void)SvUPGRADE(error, SVt_PV);
+	if (SvPOK(error) && SvCUR(error))
+	    sv_catpv(error, "\t...propagated");
+	tmps = SvPV(error, na);
+    }
+    if (!tmps || !*tmps)
+	tmps = "Died";
+    DIE("%s", tmps);
+}
+
+/* I/O. */
+
+PP(pp_open)
+{
+    dSP; dTARGET;
+    GV *gv;
+    SV *sv;
+    char *tmps;
+    STRLEN len;
+
+    if (MAXARG > 1)
+	sv = POPs;
+    else if (SvTYPE(TOPs) == SVt_PVGV)
+	sv = GvSV(TOPs);
+    else
+	DIE(no_usym, "filehandle");
+    gv = (GV*)POPs;
+    tmps = SvPV(sv, len);
+    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) {
+	IoLINES(GvIOp(gv)) = 0;
+	PUSHi( (I32)forkprocess );
+    }
+    else if (forkprocess == 0)		/* we are a new child */
+	PUSHi(0);
+    else
+	RETPUSHUNDEF;
+    RETURN;
+}
+
+PP(pp_close)
+{
+    dSP;
+    GV *gv;
+
+    if (MAXARG == 0)
+	gv = defoutgv;
+    else
+	gv = (GV*)POPs;
+    EXTEND(SP, 1);
+    PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
+    RETURN;
+}
+
+PP(pp_pipe_op)
+{
+    dSP;
+#ifdef HAS_PIPE
+    GV *rgv;
+    GV *wgv;
+    register IO *rstio;
+    register IO *wstio;
+    int fd[2];
+
+    wgv = (GV*)POPs;
+    rgv = (GV*)POPs;
+
+    if (!rgv || !wgv)
+	goto badexit;
+
+    if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+	DIE(no_usym, "filehandle");
+    rstio = GvIOn(rgv);
+    wstio = GvIOn(wgv);
+
+    if (IoIFP(rstio))
+	do_close(rgv, FALSE);
+    if (IoIFP(wstio))
+	do_close(wgv, FALSE);
+
+    if (pipe(fd) < 0)
+	goto badexit;
+
+    IoIFP(rstio) = fdopen(fd[0], "r");
+    IoOFP(wstio) = fdopen(fd[1], "w");
+    IoIFP(wstio) = IoOFP(wstio);
+    IoTYPE(rstio) = '<';
+    IoTYPE(wstio) = '>';
+
+    if (!IoIFP(rstio) || !IoOFP(wstio)) {
+	if (IoIFP(rstio)) fclose(IoIFP(rstio));
+	else close(fd[0]);
+	if (IoOFP(wstio)) fclose(IoOFP(wstio));
+	else close(fd[1]);
+	goto badexit;
+    }
+
+    RETPUSHYES;
+
+badexit:
+    RETPUSHUNDEF;
+#else
+    DIE(no_func, "pipe");
+#endif
+}
+
+PP(pp_fileno)
+{
+    dSP; dTARGET;
+    GV *gv;
+    IO *io;
+    FILE *fp;
+    if (MAXARG < 1)
+	RETPUSHUNDEF;
+    gv = (GV*)POPs;
+    if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
+	RETPUSHUNDEF;
+    PUSHi(fileno(fp));
+    RETURN;
+}
+
+PP(pp_umask)
+{
+    dSP; dTARGET;
+    int anum;
+
+#ifdef HAS_UMASK
+    if (MAXARG < 1) {
+	anum = umask(0);
+	(void)umask(anum);
+    }
+    else
+	anum = umask(POPi);
+    TAINT_PROPER("umask");
+    XPUSHi(anum);
+#else
+    DIE(no_func, "Unsupported function umask");
+#endif
+    RETURN;
+}
+
+PP(pp_binmode)
+{
+    dSP;
+    GV *gv;
+    IO *io;
+    FILE *fp;
+
+    if (MAXARG < 1)
+	RETPUSHUNDEF;
+
+    gv = (GV*)POPs;
+
+    EXTEND(SP, 1);
+    if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
+	RETSETUNDEF;
+
+#ifdef DOSISH
+#ifdef atarist
+    if (!Fflush(fp) && (fp->_flag |= _IOBIN))
+	RETPUSHYES;
+    else
+	RETPUSHUNDEF;
+#else
+    if (setmode(fileno(fp), OP_BINARY) != -1)
+	RETPUSHYES;
+    else
+	RETPUSHUNDEF;
+#endif
+#else
+    RETPUSHYES;
+#endif
+}
+
+PP(pp_tie)
+{
+    dSP;
+    SV *varsv;
+    HV* stash;
+    GV *gv;
+    BINOP myop;
+    SV *sv;
+    SV **mark = stack_base + ++*markstack_ptr;	/* reuse in entersub */
+    I32 markoff = mark - stack_base - 1;
+    char *methname;
+
+    varsv = mark[0];
+    if (SvTYPE(varsv) == SVt_PVHV)
+	methname = "TIEHASH";
+    else if (SvTYPE(varsv) == SVt_PVAV)
+	methname = "TIEARRAY";
+    else if (SvTYPE(varsv) == SVt_PVGV)
+	methname = "TIEHANDLE";
+    else
+	methname = "TIESCALAR";
+
+    stash = gv_stashsv(mark[1], FALSE);
+    if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
+	DIE("Can't locate object method \"%s\" via package \"%s\"",
+		methname, SvPV(mark[1],na));
+
+    Zero(&myop, 1, BINOP);
+    myop.op_last = (OP *) &myop;
+    myop.op_next = Nullop;
+    myop.op_flags = OPf_KNOW|OPf_STACKED;
+
+    ENTER;
+    SAVESPTR(op);
+    op = (OP *) &myop;
+
+    XPUSHs(gv);
+    PUTBACK;
+
+    if (op = pp_entersub())
+        runops();
+    SPAGAIN;
+
+    sv = TOPs;
+    if (sv_isobject(sv)) {
+	if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
+	    sv_unmagic(varsv, 'P');
+	    sv_magic(varsv, sv, 'P', Nullch, 0);
+	}
+	else {
+	    sv_unmagic(varsv, 'q');
+	    sv_magic(varsv, sv, 'q', Nullch, 0);
+	}
+    }
+    LEAVE;
+    SP = stack_base + markoff;
+    PUSHs(sv);
+    RETURN;
+}
+
+PP(pp_untie)
+{
+    dSP;
+    if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
+	sv_unmagic(TOPs, 'P');
+    else
+	sv_unmagic(TOPs, 'q');
+    RETSETYES;
+}
+
+PP(pp_tied)
+{
+    dSP;
+    SV * sv ;
+    MAGIC * mg ;
+
+    sv = POPs;
+    if (SvMAGICAL(sv)) {
+        if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
+            mg = mg_find(sv, 'P') ;
+        else
+            mg = mg_find(sv, 'q') ;
+
+        if (mg)  {
+            PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
+            RETURN ;
+	}
+    }
+
+    RETPUSHUNDEF;
+}
+
+PP(pp_dbmopen)
+{
+    dSP;
+    HV *hv;
+    dPOPPOPssrl;
+    HV* stash;
+    GV *gv;
+    BINOP myop;
+    SV *sv;
+
+    hv = (HV*)POPs;
+
+    sv = sv_mortalcopy(&sv_no);
+    sv_setpv(sv, "AnyDBM_File");
+    stash = gv_stashsv(sv, FALSE);
+    if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
+	PUTBACK;
+	perl_require_pv("AnyDBM_File.pm");
+	SPAGAIN;
+	if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
+	    DIE("No dbm on this machine");
+    }
+
+    Zero(&myop, 1, BINOP);
+    myop.op_last = (OP *) &myop;
+    myop.op_next = Nullop;
+    myop.op_flags = OPf_KNOW|OPf_STACKED;
+
+    ENTER;
+    SAVESPTR(op);
+    op = (OP *) &myop;
+    PUTBACK;
+    pp_pushmark();
+
+    EXTEND(sp, 5);
+    PUSHs(sv);
+    PUSHs(left);
+    if (SvIV(right))
+	PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
+    else
+	PUSHs(sv_2mortal(newSViv(O_RDWR)));
+    PUSHs(right);
+    PUSHs(gv);
+    PUTBACK;
+
+    if (op = pp_entersub())
+        runops();
+    SPAGAIN;
+
+    if (!sv_isobject(TOPs)) {
+	sp--;
+	op = (OP *) &myop;
+	PUTBACK;
+	pp_pushmark();
+
+	PUSHs(sv);
+	PUSHs(left);
+	PUSHs(sv_2mortal(newSViv(O_RDONLY)));
+	PUSHs(right);
+	PUSHs(gv);
+	PUTBACK;
+
+	if (op = pp_entersub())
+	    runops();
+	SPAGAIN;
+    }
+
+    if (sv_isobject(TOPs))
+	sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
+    LEAVE;
+    RETURN;
+}
+
+PP(pp_dbmclose)
+{
+    return pp_untie(ARGS);
+}
+
+PP(pp_sselect)
+{
+    dSP; dTARGET;
+#ifdef HAS_SELECT
+    register I32 i;
+    register I32 j;
+    register char *s;
+    register SV *sv;
+    double value;
+    I32 maxlen = 0;
+    I32 nfound;
+    struct timeval timebuf;
+    struct timeval *tbuf = &timebuf;
+    I32 growsize;
+    char *fd_sets[4];
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+	I32 masksize;
+	I32 offset;
+	I32 k;
+
+#   if BYTEORDER & 0xf0000
+#	define ORDERBYTE (0x88888888 - BYTEORDER)
+#   else
+#	define ORDERBYTE (0x4444 - BYTEORDER)
+#   endif
+
+#endif
+
+    SP -= 4;
+    for (i = 1; i <= 3; i++) {
+	if (!SvPOK(SP[i]))
+	    continue;
+	j = SvCUR(SP[i]);
+	if (maxlen < j)
+	    maxlen = j;
+    }
+
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+#ifdef __linux__
+    growsize = sizeof(fd_set);
+#else
+    growsize = maxlen;		/* little endians can use vecs directly */
+#endif
+#else
+#ifdef NFDBITS
+
+#ifndef NBBY
+#define NBBY 8
+#endif
+
+    masksize = NFDBITS / NBBY;
+#else
+    masksize = sizeof(long);	/* documented int, everyone seems to use long */
+#endif
+    growsize = maxlen + (masksize - (maxlen % masksize));
+    Zero(&fd_sets[0], 4, char*);
+#endif
+
+    sv = SP[4];
+    if (SvOK(sv)) {
+	value = SvNV(sv);
+	if (value < 0.0)
+	    value = 0.0;
+	timebuf.tv_sec = (long)value;
+	value -= (double)timebuf.tv_sec;
+	timebuf.tv_usec = (long)(value * 1000000.0);
+    }
+    else
+	tbuf = Null(struct timeval*);
+
+    for (i = 1; i <= 3; i++) {
+	sv = SP[i];
+	if (!SvOK(sv)) {
+	    fd_sets[i] = 0;
+	    continue;
+	}
+	else if (!SvPOK(sv))
+	    SvPV_force(sv,na);	/* force string conversion */
+	j = SvLEN(sv);
+	if (j < growsize) {
+	    Sv_Grow(sv, growsize);
+	}
+	j = SvCUR(sv);
+	s = SvPVX(sv) + j;
+	while (++j <= growsize) {
+	    *s++ = '\0';
+	}
+
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+	s = SvPVX(sv);
+	New(403, fd_sets[i], growsize, char);
+	for (offset = 0; offset < growsize; offset += masksize) {
+	    for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
+		fd_sets[i][j+offset] = s[(k % masksize) + offset];
+	}
+#else
+	fd_sets[i] = SvPVX(sv);
+#endif
+    }
+
+    nfound = select(
+	maxlen * 8,
+	(Select_fd_set_t) fd_sets[1],
+	(Select_fd_set_t) fd_sets[2],
+	(Select_fd_set_t) fd_sets[3],
+	tbuf);
+    for (i = 1; i <= 3; i++) {
+	if (fd_sets[i]) {
+	    sv = SP[i];
+#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+	    s = SvPVX(sv);
+	    for (offset = 0; offset < growsize; offset += masksize) {
+		for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
+		    s[(k % masksize) + offset] = fd_sets[i][j+offset];
+	    }
+	    Safefree(fd_sets[i]);
+#endif
+	    SvSETMAGIC(sv);
+	}
+    }
+
+    PUSHi(nfound);
+    if (GIMME == G_ARRAY && tbuf) {
+	value = (double)(timebuf.tv_sec) +
+		(double)(timebuf.tv_usec) / 1000000.0;
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setnv(sv, value);
+    }
+    RETURN;
+#else
+    DIE("select not implemented");
+#endif
+}
+
+void
+setdefout(gv)
+GV *gv;
+{
+    if (gv)
+	(void)SvREFCNT_inc(gv);
+    if (defoutgv)
+	SvREFCNT_dec(defoutgv);
+    defoutgv = gv;
+}
+
+PP(pp_select)
+{
+    dSP; dTARGET;
+    GV *newdefout, *egv;
+    HV *hv;
+
+    newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+
+    egv = GvEGV(defoutgv);
+    if (!egv)
+	egv = defoutgv;
+    hv = GvSTASH(egv);
+    if (! hv)
+	XPUSHs(&sv_undef);
+    else {
+	GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+	if (gvp && *gvp == egv)
+	    gv_efullname(TARG, defoutgv);
+	else
+	    sv_setsv(TARG, sv_2mortal(newRV(egv)));
+	XPUSHTARG;
+    }
+
+    if (newdefout) {
+	if (!GvIO(newdefout))
+	    gv_IOadd(newdefout);
+	setdefout(newdefout);
+    }
+
+    RETURN;
+}
+
+PP(pp_getc)
+{
+    dSP; dTARGET;
+    GV *gv;
+
+    if (MAXARG <= 0)
+	gv = stdingv;
+    else
+	gv = (GV*)POPs;
+    if (!gv)
+	gv = argvgv;
+    if (!gv || do_eof(gv)) /* make sure we have fp with something */
+	RETPUSHUNDEF;
+    TAINT_IF(1);
+    sv_setpv(TARG, " ");
+    *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
+    PUSHTARG;
+    RETURN;
+}
+
+PP(pp_read)
+{
+    return pp_sysread(ARGS);
+}
+
+static OP *
+doform(cv,gv,retop)
+CV *cv;
+GV *gv;
+OP *retop;
+{
+    register CONTEXT *cx;
+    I32 gimme = GIMME;
+    AV* padlist = CvPADLIST(cv);
+    SV** svp = AvARRAY(padlist);
+
+    ENTER;
+    SAVETMPS;
+
+    push_return(retop);
+    PUSHBLOCK(cx, CXt_SUB, stack_sp);
+    PUSHFORMAT(cx);
+    SAVESPTR(curpad);
+    curpad = AvARRAY((AV*)svp[1]);
+
+    setdefout(gv);	    /* locally select filehandle so $% et al work */
+    return CvSTART(cv);
+}
+
+PP(pp_enterwrite)
+{
+    dSP;
+    register GV *gv;
+    register IO *io;
+    GV *fgv;
+    CV *cv;
+
+    if (MAXARG == 0)
+	gv = defoutgv;
+    else {
+	gv = (GV*)POPs;
+	if (!gv)
+	    gv = defoutgv;
+    }
+    EXTEND(SP, 1);
+    io = GvIO(gv);
+    if (!io) {
+	RETPUSHNO;
+    }
+    if (IoFMT_GV(io))
+	fgv = IoFMT_GV(io);
+    else
+	fgv = gv;
+
+    cv = GvFORM(fgv);
+
+    if (!cv) {
+	if (fgv) {
+	    SV *tmpsv = sv_newmortal();
+	    gv_efullname(tmpsv, gv);
+	    DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
+	}
+	DIE("Not a format reference");
+    }
+    IoFLAGS(io) &= ~IOf_DIDTOP;
+
+    return doform(cv,gv,op->op_next);
+}
+
+PP(pp_leavewrite)
+{
+    dSP;
+    GV *gv = cxstack[cxstack_ix].blk_sub.gv;
+    register IO *io = GvIOp(gv);
+    FILE *ofp = IoOFP(io);
+    FILE *fp;
+    SV **newsp;
+    I32 gimme;
+    register CONTEXT *cx;
+
+    DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
+	  (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
+    if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
+	formtarget != toptarget)
+    {
+	GV *fgv;
+	CV *cv;
+	if (!IoTOP_GV(io)) {
+	    GV *topgv;
+	    char tmpbuf[256];
+
+	    if (!IoTOP_NAME(io)) {
+		if (!IoFMT_NAME(io))
+		    IoFMT_NAME(io) = savepv(GvNAME(gv));
+		sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
+		topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
+		if ((topgv && GvFORM(topgv)) ||
+		  !gv_fetchpv("top",FALSE,SVt_PVFM))
+		    IoTOP_NAME(io) = savepv(tmpbuf);
+		else
+		    IoTOP_NAME(io) = savepv("top");
+	    }
+	    topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
+	    if (!topgv || !GvFORM(topgv)) {
+		IoLINES_LEFT(io) = 100000000;
+		goto forget_top;
+	    }
+	    IoTOP_GV(io) = topgv;
+	}
+	if (IoFLAGS(io) & IOf_DIDTOP) {	/* Oh dear.  It still doesn't fit. */
+	    I32 lines = IoLINES_LEFT(io);
+	    char *s = SvPVX(formtarget);
+	    if (lines <= 0)		/* Yow, header didn't even fit!!! */
+		goto forget_top;
+	    while (lines-- > 0) {
+		s = strchr(s, '\n');
+		if (!s)
+		    break;
+		s++;
+	    }
+	    if (s) {
+		fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
+		sv_chop(formtarget, s);
+		FmLINES(formtarget) -= IoLINES_LEFT(io);
+	    }
+	}
+	if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
+	    fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
+	IoLINES_LEFT(io) = IoPAGE_LEN(io);
+	IoPAGE(io)++;
+	formtarget = toptarget;
+	IoFLAGS(io) |= IOf_DIDTOP;
+	fgv = IoTOP_GV(io);
+	if (!fgv)
+	    DIE("bad top format reference");
+	cv = GvFORM(fgv);
+	if (!cv) {
+	    SV *tmpsv = sv_newmortal();
+	    gv_efullname(tmpsv, fgv);
+	    DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
+	}
+	return doform(cv,gv,op);
+    }
+
+  forget_top:
+    POPBLOCK(cx,curpm);
+    POPFORMAT(cx);
+    LEAVE;
+
+    fp = IoOFP(io);
+    if (!fp) {
+	if (dowarn) {
+	    if (IoIFP(io))
+		warn("Filehandle only opened for input");
+	    else
+		warn("Write on closed filehandle");
+	}
+	PUSHs(&sv_no);
+    }
+    else {
+	if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
+	    if (dowarn)
+		warn("page overflow");
+	}
+	if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
+		ferror(fp))
+	    PUSHs(&sv_no);
+	else {
+	    FmLINES(formtarget) = 0;
+	    SvCUR_set(formtarget, 0);
+	    *SvEND(formtarget) = '\0';
+	    if (IoFLAGS(io) & IOf_FLUSH)
+		(void)Fflush(fp);
+	    PUSHs(&sv_yes);
+	}
+    }
+    formtarget = bodytarget;
+    PUTBACK;
+    return pop_return();
+}
+
+PP(pp_prtf)
+{
+    dSP; dMARK; dORIGMARK;
+    GV *gv;
+    IO *io;
+    FILE *fp;
+    SV *sv = NEWSV(0,0);
+
+    if (op->op_flags & OPf_STACKED)
+	gv = (GV*)*++MARK;
+    else
+	gv = defoutgv;
+    if (!(io = GvIO(gv))) {
+	if (dowarn) {
+	    gv_fullname(sv,gv);
+	    warn("Filehandle %s never opened", SvPV(sv,na));
+	}
+	SETERRNO(EBADF,RMS$_IFI);
+	goto just_say_no;
+    }
+    else if (!(fp = IoOFP(io))) {
+	if (dowarn)  {
+	    gv_fullname(sv,gv);
+	    if (IoIFP(io))
+		warn("Filehandle %s opened only for input", SvPV(sv,na));
+	    else
+		warn("printf on closed filehandle %s", SvPV(sv,na));
+	}
+	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+	goto just_say_no;
+    }
+    else {
+	do_sprintf(sv, SP - MARK, MARK + 1);
+	if (!do_print(sv, fp))
+	    goto just_say_no;
+
+	if (IoFLAGS(io) & IOf_FLUSH)
+	    if (Fflush(fp) == EOF)
+		goto just_say_no;
+    }
+    SvREFCNT_dec(sv);
+    SP = ORIGMARK;
+    PUSHs(&sv_yes);
+    RETURN;
+
+  just_say_no:
+    SvREFCNT_dec(sv);
+    SP = ORIGMARK;
+    PUSHs(&sv_undef);
+    RETURN;
+}
+
+PP(pp_sysopen)
+{
+    dSP;
+    GV *gv;
+    SV *sv;
+    char *tmps;
+    STRLEN len;
+    int mode, perm;
+
+    if (MAXARG > 3)
+	perm = POPi;
+    else
+	perm = 0666;
+    mode = POPi;
+    sv = POPs;
+    gv = (GV *)POPs;
+
+    tmps = SvPV(sv, len);
+    if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
+	IoLINES(GvIOp(gv)) = 0;
+	PUSHs(&sv_yes);
+    }
+    else {
+	PUSHs(&sv_undef);
+    }
+    RETURN;
+}
+
+PP(pp_sysread)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    int offset;
+    GV *gv;
+    IO *io;
+    char *buffer;
+    int length;
+    int bufsize;
+    SV *bufsv;
+    STRLEN blen;
+
+    gv = (GV*)*++MARK;
+    if (!gv)
+	goto say_undef;
+    bufsv = *++MARK;
+    buffer = SvPV_force(bufsv, blen);
+    length = SvIVx(*++MARK);
+    if (length < 0)
+	DIE("Negative length");
+    SETERRNO(0,0);
+    if (MARK < SP)
+	offset = SvIVx(*++MARK);
+    else
+	offset = 0;
+    io = GvIO(gv);
+    if (!io || !IoIFP(io))
+	goto say_undef;
+#ifdef HAS_SOCKET
+    if (op->op_type == OP_RECV) {
+	bufsize = sizeof buf;
+	buffer = SvGROW(bufsv, length+1);
+	length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
+	    (struct sockaddr *)buf, &bufsize);
+	if (length < 0)
+	    RETPUSHUNDEF;
+	SvCUR_set(bufsv, length);
+	*SvEND(bufsv) = '\0';
+	(void)SvPOK_only(bufsv);
+	SvSETMAGIC(bufsv);
+	if (tainting)
+	    sv_magic(bufsv, Nullsv, 't', Nullch, 0);
+	SP = ORIGMARK;
+	sv_setpvn(TARG, buf, bufsize);
+	PUSHs(TARG);
+	RETURN;
+    }
+#else
+    if (op->op_type == OP_RECV)
+	DIE(no_sock_func, "recv");
+#endif
+    buffer = SvGROW(bufsv, length+offset+1);
+    if (op->op_type == OP_SYSREAD) {
+	length = read(fileno(IoIFP(io)), buffer+offset, length);
+    }
+    else
+#ifdef HAS_SOCKET__bad_code_maybe
+    if (IoTYPE(io) == 's') {
+	bufsize = sizeof buf;
+	length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
+	    (struct sockaddr *)buf, &bufsize);
+    }
+    else
+#endif
+	length = fread(buffer+offset, 1, length, IoIFP(io));
+    if (length < 0)
+	goto say_undef;
+    SvCUR_set(bufsv, length+offset);
+    *SvEND(bufsv) = '\0';
+    (void)SvPOK_only(bufsv);
+    SvSETMAGIC(bufsv);
+    if (tainting)
+	sv_magic(bufsv, Nullsv, 't', Nullch, 0);
+    SP = ORIGMARK;
+    PUSHi(length);
+    RETURN;
+
+  say_undef:
+    SP = ORIGMARK;
+    RETPUSHUNDEF;
+}
+
+PP(pp_syswrite)
+{
+    return pp_send(ARGS);
+}
+
+PP(pp_send)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    GV *gv;
+    IO *io;
+    int offset;
+    SV *bufsv;
+    char *buffer;
+    int length;
+    STRLEN blen;
+
+    gv = (GV*)*++MARK;
+    if (!gv)
+	goto say_undef;
+    bufsv = *++MARK;
+    buffer = SvPV(bufsv, blen);
+    length = SvIVx(*++MARK);
+    if (length < 0)
+	DIE("Negative length");
+    SETERRNO(0,0);
+    io = GvIO(gv);
+    if (!io || !IoIFP(io)) {
+	length = -1;
+	if (dowarn) {
+	    if (op->op_type == OP_SYSWRITE)
+		warn("Syswrite on closed filehandle");
+	    else
+		warn("Send on closed socket");
+	}
+    }
+    else if (op->op_type == OP_SYSWRITE) {
+	if (MARK < SP)
+	    offset = SvIVx(*++MARK);
+	else
+	    offset = 0;
+	if (length > blen - offset)
+	    length = blen - offset;
+	length = write(fileno(IoIFP(io)), buffer+offset, length);
+    }
+#ifdef HAS_SOCKET
+    else if (SP > MARK) {
+	char *sockbuf;
+	STRLEN mlen;
+	sockbuf = SvPVx(*++MARK, mlen);
+	length = sendto(fileno(IoIFP(io)), buffer, blen, length,
+				(struct sockaddr *)sockbuf, mlen);
+    }
+    else
+	length = send(fileno(IoIFP(io)), buffer, blen, length);
+#else
+    else
+	DIE(no_sock_func, "send");
+#endif
+    if (length < 0)
+	goto say_undef;
+    SP = ORIGMARK;
+    PUSHi(length);
+    RETURN;
+
+  say_undef:
+    SP = ORIGMARK;
+    RETPUSHUNDEF;
+}
+
+PP(pp_recv)
+{
+    return pp_sysread(ARGS);
+}
+
+PP(pp_eof)
+{
+    dSP;
+    GV *gv;
+
+    if (MAXARG <= 0)
+	gv = last_in_gv;
+    else
+	gv = last_in_gv = (GV*)POPs;
+    PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
+    RETURN;
+}
+
+PP(pp_tell)
+{
+    dSP; dTARGET;
+    GV *gv;
+
+    if (MAXARG <= 0)
+	gv = last_in_gv;
+    else
+	gv = last_in_gv = (GV*)POPs;
+    PUSHi( do_tell(gv) );
+    RETURN;
+}
+
+PP(pp_seek)
+{
+    dSP;
+    GV *gv;
+    int whence = POPi;
+    long offset = POPl;
+
+    gv = last_in_gv = (GV*)POPs;
+    PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
+    RETURN;
+}
+
+PP(pp_truncate)
+{
+    dSP;
+    Off_t len = (Off_t)POPn;
+    int result = 1;
+    GV *tmpgv;
+
+    SETERRNO(0,0);
+#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
+#ifdef HAS_TRUNCATE
+    if (op->op_flags & OPf_SPECIAL) {
+	tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
+	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
+	  ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+	    result = 0;
+    }
+    else if (truncate(POPp, len) < 0)
+	result = 0;
+#else
+    if (op->op_flags & OPf_SPECIAL) {
+	tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
+	if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
+	  chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
+	    result = 0;
+    }
+    else {
+	int tmpfd;
+
+	if ((tmpfd = open(POPp, 0)) < 0)
+	    result = 0;
+	else {
+	    if (chsize(tmpfd, len) < 0)
+		result = 0;
+	    close(tmpfd);
+	}
+    }
+#endif
+
+    if (result)
+	RETPUSHYES;
+    if (!errno)
+	SETERRNO(EBADF,RMS$_IFI);
+    RETPUSHUNDEF;
+#else
+    DIE("truncate not implemented");
+#endif
+}
+
+PP(pp_fcntl)
+{
+    return pp_ioctl(ARGS);
+}
+
+PP(pp_ioctl)
+{
+    dSP; dTARGET;
+    SV *argsv = POPs;
+    unsigned int func = U_I(POPn);
+    int optype = op->op_type;
+    char *s;
+    int retval;
+    GV *gv = (GV*)POPs;
+    IO *io = GvIOn(gv);
+
+    if (!io || !argsv || !IoIFP(io)) {
+	SETERRNO(EBADF,RMS$_IFI);	/* well, sort of... */
+	RETPUSHUNDEF;
+    }
+
+    if (SvPOK(argsv) || !SvNIOK(argsv)) {
+	STRLEN len;
+	s = SvPV_force(argsv, len);
+	retval = IOCPARM_LEN(func);
+	if (len < retval) {
+	    s = Sv_Grow(argsv, retval+1);
+	    SvCUR_set(argsv, retval);
+	}
+
+	s[SvCUR(argsv)] = 17;	/* a little sanity check here */
+    }
+    else {
+	retval = SvIV(argsv);
+#ifdef DOSISH
+	s = (char*)(long)retval;	/* ouch */
+#else
+	s = (char*)retval;		/* ouch */
+#endif
+    }
+
+    TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
+
+    if (optype == OP_IOCTL)
+#ifdef HAS_IOCTL
+	retval = ioctl(fileno(IoIFP(io)), func, s);
+#else
+	DIE("ioctl is not implemented");
+#endif
+    else
+#if defined(DOSISH) && !defined(OS2)
+	DIE("fcntl is not implemented");
+#else
+#   ifdef HAS_FCNTL
+#     if defined(OS2) && defined(__EMX__)
+	retval = fcntl(fileno(IoIFP(io)), func, (int)s);
+#     else
+	retval = fcntl(fileno(IoIFP(io)), func, s);
+#     endif 
+#   else
+	DIE("fcntl is not implemented");
+#   endif
+#endif
+
+    if (SvPOK(argsv)) {
+	if (s[SvCUR(argsv)] != 17)
+	    DIE("Possible memory corruption: %s overflowed 3rd argument",
+		op_name[optype]);
+	s[SvCUR(argsv)] = 0;		/* put our null back */
+	SvSETMAGIC(argsv);		/* Assume it has changed */
+    }
+
+    if (retval == -1)
+	RETPUSHUNDEF;
+    if (retval != 0) {
+	PUSHi(retval);
+    }
+    else {
+	PUSHp("0 but true", 10);
+    }
+    RETURN;
+}
+
+PP(pp_flock)
+{
+    dSP; dTARGET;
+    I32 value;
+    int argtype;
+    GV *gv;
+    FILE *fp;
+
+#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+#  define flock lockf_emulate_flock
+#endif
+
+#if defined(HAS_FLOCK) || defined(flock)
+    argtype = POPi;
+    if (MAXARG <= 0)
+	gv = last_in_gv;
+    else
+	gv = (GV*)POPs;
+    if (gv && GvIO(gv))
+	fp = IoIFP(GvIOp(gv));
+    else
+	fp = Nullfp;
+    if (fp) {
+	value = (I32)(flock(fileno(fp), argtype) >= 0);
+    }
+    else
+	value = 0;
+    PUSHi(value);
+    RETURN;
+#else
+    DIE(no_func, "flock()");
+#endif
+}
+
+/* Sockets. */
+
+PP(pp_socket)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    GV *gv;
+    register IO *io;
+    int protocol = POPi;
+    int type = POPi;
+    int domain = POPi;
+    int fd;
+
+    gv = (GV*)POPs;
+
+    if (!gv) {
+	SETERRNO(EBADF,LIB$_INVARG);
+	RETPUSHUNDEF;
+    }
+
+    io = GvIOn(gv);
+    if (IoIFP(io))
+	do_close(gv, FALSE);
+
+    TAINT_PROPER("socket");
+    fd = socket(domain, type, protocol);
+    if (fd < 0)
+	RETPUSHUNDEF;
+    IoIFP(io) = fdopen(fd, "r");	/* stdio gets confused about sockets */
+    IoOFP(io) = fdopen(fd, "w");
+    IoTYPE(io) = 's';
+    if (!IoIFP(io) || !IoOFP(io)) {
+	if (IoIFP(io)) fclose(IoIFP(io));
+	if (IoOFP(io)) fclose(IoOFP(io));
+	if (!IoIFP(io) && !IoOFP(io)) close(fd);
+	RETPUSHUNDEF;
+    }
+
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "socket");
+#endif
+}
+
+PP(pp_sockpair)
+{
+    dSP;
+#ifdef HAS_SOCKETPAIR
+    GV *gv1;
+    GV *gv2;
+    register IO *io1;
+    register IO *io2;
+    int protocol = POPi;
+    int type = POPi;
+    int domain = POPi;
+    int fd[2];
+
+    gv2 = (GV*)POPs;
+    gv1 = (GV*)POPs;
+    if (!gv1 || !gv2)
+	RETPUSHUNDEF;
+
+    io1 = GvIOn(gv1);
+    io2 = GvIOn(gv2);
+    if (IoIFP(io1))
+	do_close(gv1, FALSE);
+    if (IoIFP(io2))
+	do_close(gv2, FALSE);
+
+    TAINT_PROPER("socketpair");
+    if (socketpair(domain, type, protocol, fd) < 0)
+	RETPUSHUNDEF;
+    IoIFP(io1) = fdopen(fd[0], "r");
+    IoOFP(io1) = fdopen(fd[0], "w");
+    IoTYPE(io1) = 's';
+    IoIFP(io2) = fdopen(fd[1], "r");
+    IoOFP(io2) = fdopen(fd[1], "w");
+    IoTYPE(io2) = 's';
+    if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
+	if (IoIFP(io1)) fclose(IoIFP(io1));
+	if (IoOFP(io1)) fclose(IoOFP(io1));
+	if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
+	if (IoIFP(io2)) fclose(IoIFP(io2));
+	if (IoOFP(io2)) fclose(IoOFP(io2));
+	if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
+	RETPUSHUNDEF;
+    }
+
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "socketpair");
+#endif
+}
+
+PP(pp_bind)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    SV *addrsv = POPs;
+    char *addr;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+    STRLEN len;
+
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    addr = SvPV(addrsv, len);
+    TAINT_PROPER("bind");
+    if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+	RETPUSHYES;
+    else
+	RETPUSHUNDEF;
+
+nuts:
+    if (dowarn)
+	warn("bind() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+    RETPUSHUNDEF;
+#else
+    DIE(no_sock_func, "bind");
+#endif
+}
+
+PP(pp_connect)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    SV *addrsv = POPs;
+    char *addr;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+    STRLEN len;
+
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    addr = SvPV(addrsv, len);
+    TAINT_PROPER("connect");
+    if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+	RETPUSHYES;
+    else
+	RETPUSHUNDEF;
+
+nuts:
+    if (dowarn)
+	warn("connect() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+    RETPUSHUNDEF;
+#else
+    DIE(no_sock_func, "connect");
+#endif
+}
+
+PP(pp_listen)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    int backlog = POPi;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    if (listen(fileno(IoIFP(io)), backlog) >= 0)
+	RETPUSHYES;
+    else
+	RETPUSHUNDEF;
+
+nuts:
+    if (dowarn)
+	warn("listen() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+    RETPUSHUNDEF;
+#else
+    DIE(no_sock_func, "listen");
+#endif
+}
+
+PP(pp_accept)
+{
+    dSP; dTARGET;
+#ifdef HAS_SOCKET
+    GV *ngv;
+    GV *ggv;
+    register IO *nstio;
+    register IO *gstio;
+    struct sockaddr saddr;	/* use a struct to avoid alignment problems */
+    int len = sizeof saddr;
+    int fd;
+
+    ggv = (GV*)POPs;
+    ngv = (GV*)POPs;
+
+    if (!ngv)
+	goto badexit;
+    if (!ggv)
+	goto nuts;
+
+    gstio = GvIO(ggv);
+    if (!gstio || !IoIFP(gstio))
+	goto nuts;
+
+    nstio = GvIOn(ngv);
+    if (IoIFP(nstio))
+	do_close(ngv, FALSE);
+
+    fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
+    if (fd < 0)
+	goto badexit;
+    IoIFP(nstio) = fdopen(fd, "r");
+    IoOFP(nstio) = fdopen(fd, "w");
+    IoTYPE(nstio) = 's';
+    if (!IoIFP(nstio) || !IoOFP(nstio)) {
+	if (IoIFP(nstio)) fclose(IoIFP(nstio));
+	if (IoOFP(nstio)) fclose(IoOFP(nstio));
+	if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
+	goto badexit;
+    }
+
+    PUSHp((char *)&saddr, len);
+    RETURN;
+
+nuts:
+    if (dowarn)
+	warn("accept() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+
+badexit:
+    RETPUSHUNDEF;
+
+#else
+    DIE(no_sock_func, "accept");
+#endif
+}
+
+PP(pp_shutdown)
+{
+    dSP; dTARGET;
+#ifdef HAS_SOCKET
+    int how = POPi;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
+    RETURN;
+
+nuts:
+    if (dowarn)
+	warn("shutdown() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+    RETPUSHUNDEF;
+#else
+    DIE(no_sock_func, "shutdown");
+#endif
+}
+
+PP(pp_gsockopt)
+{
+#ifdef HAS_SOCKET
+    return pp_ssockopt(ARGS);
+#else
+    DIE(no_sock_func, "getsockopt");
+#endif
+}
+
+PP(pp_ssockopt)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    int optype = op->op_type;
+    SV *sv;
+    int fd;
+    unsigned int optname;
+    unsigned int lvl;
+    GV *gv;
+    register IO *io;
+    int aint;
+
+    if (optype == OP_GSOCKOPT)
+	sv = sv_2mortal(NEWSV(22, 257));
+    else
+	sv = POPs;
+    optname = (unsigned int) POPi;
+    lvl = (unsigned int) POPi;
+
+    gv = (GV*)POPs;
+    io = GvIOn(gv);
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    fd = fileno(IoIFP(io));
+    switch (optype) {
+    case OP_GSOCKOPT:
+	SvGROW(sv, 257);
+	(void)SvPOK_only(sv);
+	SvCUR_set(sv,256);
+	*SvEND(sv) ='\0';
+	aint = SvCUR(sv);
+	if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
+	    goto nuts2;
+	SvCUR_set(sv,aint);
+	*SvEND(sv) ='\0';
+	PUSHs(sv);
+	break;
+    case OP_SSOCKOPT: {
+	    STRLEN len = 0;
+	    char *buf = 0;
+	    if (SvPOKp(sv))
+		buf = SvPV(sv, len);
+	    else if (SvOK(sv)) {
+		aint = (int)SvIV(sv);
+		buf = (char*)&aint;
+		len = sizeof(int);
+	    }
+	    if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
+		goto nuts2;
+	    PUSHs(&sv_yes);
+	}
+	break;
+    }
+    RETURN;
+
+nuts:
+    if (dowarn)
+	warn("[gs]etsockopt() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+nuts2:
+    RETPUSHUNDEF;
+
+#else
+    DIE(no_sock_func, "setsockopt");
+#endif
+}
+
+PP(pp_getsockname)
+{
+#ifdef HAS_SOCKET
+    return pp_getpeername(ARGS);
+#else
+    DIE(no_sock_func, "getsockname");
+#endif
+}
+
+PP(pp_getpeername)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    int optype = op->op_type;
+    SV *sv;
+    int fd;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+    int aint;
+
+    if (!io || !IoIFP(io))
+	goto nuts;
+
+    sv = sv_2mortal(NEWSV(22, 257));
+    (void)SvPOK_only(sv);
+    SvCUR_set(sv,256);
+    *SvEND(sv) ='\0';
+    aint = SvCUR(sv);
+    fd = fileno(IoIFP(io));
+    switch (optype) {
+    case OP_GETSOCKNAME:
+	if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
+	    goto nuts2;
+	break;
+    case OP_GETPEERNAME:
+	if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
+	    goto nuts2;
+	break;
+    }
+    SvCUR_set(sv,aint);
+    *SvEND(sv) ='\0';
+    PUSHs(sv);
+    RETURN;
+
+nuts:
+    if (dowarn)
+	warn("get{sock, peer}name() on closed fd");
+    SETERRNO(EBADF,SS$_IVCHAN);
+nuts2:
+    RETPUSHUNDEF;
+
+#else
+    DIE(no_sock_func, "getpeername");
+#endif
+}
+
+/* Stat calls. */
+
+PP(pp_lstat)
+{
+    return pp_stat(ARGS);
+}
+
+PP(pp_stat)
+{
+    dSP;
+    GV *tmpgv;
+    I32 max = 13;
+
+    if (op->op_flags & OPf_REF) {
+	tmpgv = cGVOP->op_gv;
+      do_fstat:
+	if (tmpgv != defgv) {
+	    laststype = OP_STAT;
+	    statgv = tmpgv;
+	    sv_setpv(statname, "");
+	    if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
+	      Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
+		max = 0;
+		laststatval = -1;
+	    }
+	}
+	else if (laststatval < 0)
+	    max = 0;
+    }
+    else {
+	SV* sv = POPs;
+	if (SvTYPE(sv) == SVt_PVGV) {
+	    tmpgv = (GV*)sv;
+	    goto do_fstat;
+	}
+	else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+	    tmpgv = (GV*)SvRV(sv);
+	    goto do_fstat;
+	}
+	sv_setpv(statname, SvPV(sv,na));
+	statgv = Nullgv;
+#ifdef HAS_LSTAT
+	laststype = op->op_type;
+	if (op->op_type == OP_LSTAT)
+	    laststatval = lstat(SvPV(statname, na), &statcache);
+	else
+#endif
+	    laststatval = Stat(SvPV(statname, na), &statcache);
+	if (laststatval < 0) {
+	    if (dowarn && strchr(SvPV(statname, na), '\n'))
+		warn(warn_nl, "stat");
+	    max = 0;
+	}
+    }
+
+    EXTEND(SP, 13);
+    if (GIMME != G_ARRAY) {
+	if (max)
+	    RETPUSHYES;
+	else
+	    RETPUSHUNDEF;
+    }
+    if (max) {
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
+#ifdef USE_STAT_BLOCKS
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
+	PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
+#else
+	PUSHs(sv_2mortal(newSVpv("", 0)));
+	PUSHs(sv_2mortal(newSVpv("", 0)));
+#endif
+    }
+    RETURN;
+}
+
+PP(pp_ftrread)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IRUSR, 0, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftrwrite)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IWUSR, 0, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftrexec)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IXUSR, 0, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_fteread)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IRUSR, 1, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftewrite)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IWUSR, 1, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_fteexec)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (cando(S_IXUSR, 1, &statcache))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftis)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    RETPUSHYES;
+}
+
+PP(pp_fteowned)
+{
+    return pp_ftrowned(ARGS);
+}
+
+PP(pp_ftrowned)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftzero)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (!statcache.st_size)
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftsize)
+{
+    I32 result = my_stat(ARGS);
+    dSP; dTARGET;
+    if (result < 0)
+	RETPUSHUNDEF;
+    PUSHi(statcache.st_size);
+    RETURN;
+}
+
+PP(pp_ftmtime)
+{
+    I32 result = my_stat(ARGS);
+    dSP; dTARGET;
+    if (result < 0)
+	RETPUSHUNDEF;
+    PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
+    RETURN;
+}
+
+PP(pp_ftatime)
+{
+    I32 result = my_stat(ARGS);
+    dSP; dTARGET;
+    if (result < 0)
+	RETPUSHUNDEF;
+    PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
+    RETURN;
+}
+
+PP(pp_ftctime)
+{
+    I32 result = my_stat(ARGS);
+    dSP; dTARGET;
+    if (result < 0)
+	RETPUSHUNDEF;
+    PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
+    RETURN;
+}
+
+PP(pp_ftsock)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISSOCK(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftchr)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISCHR(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftblk)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISBLK(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftfile)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISREG(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftdir)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISDIR(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftpipe)
+{
+    I32 result = my_stat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISFIFO(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftlink)
+{
+    I32 result = my_lstat(ARGS);
+    dSP;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (S_ISLNK(statcache.st_mode))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+PP(pp_ftsuid)
+{
+    dSP;
+#ifdef S_ISUID
+    I32 result = my_stat(ARGS);
+    SPAGAIN;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (statcache.st_mode & S_ISUID)
+	RETPUSHYES;
+#endif
+    RETPUSHNO;
+}
+
+PP(pp_ftsgid)
+{
+    dSP;
+#ifdef S_ISGID
+    I32 result = my_stat(ARGS);
+    SPAGAIN;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (statcache.st_mode & S_ISGID)
+	RETPUSHYES;
+#endif
+    RETPUSHNO;
+}
+
+PP(pp_ftsvtx)
+{
+    dSP;
+#ifdef S_ISVTX
+    I32 result = my_stat(ARGS);
+    SPAGAIN;
+    if (result < 0)
+	RETPUSHUNDEF;
+    if (statcache.st_mode & S_ISVTX)
+	RETPUSHYES;
+#endif
+    RETPUSHNO;
+}
+
+PP(pp_fttty)
+{
+    dSP;
+    int fd;
+    GV *gv;
+    char *tmps;
+    if (op->op_flags & OPf_REF) {
+	gv = cGVOP->op_gv;
+	tmps = "";
+    }
+    else
+	gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
+    if (GvIO(gv) && IoIFP(GvIOp(gv)))
+	fd = fileno(IoIFP(GvIOp(gv)));
+    else if (isDIGIT(*tmps))
+	fd = atoi(tmps);
+    else
+	RETPUSHUNDEF;
+    if (isatty(fd))
+	RETPUSHYES;
+    RETPUSHNO;
+}
+
+#if defined(atarist) /* this will work with atariST. Configure will
+			make guesses for other systems. */
+# define FILE_base(f) ((f)->_base)
+# define FILE_ptr(f) ((f)->_ptr)
+# define FILE_cnt(f) ((f)->_cnt)
+# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
+#endif
+
+PP(pp_fttext)
+{
+    dSP;
+    I32 i;
+    I32 len;
+    I32 odd = 0;
+    STDCHAR tbuf[512];
+    register STDCHAR *s;
+    register IO *io;
+    SV *sv;
+
+    if (op->op_flags & OPf_REF) {
+	EXTEND(SP, 1);
+	if (cGVOP->op_gv == defgv) {
+	    if (statgv)
+		io = GvIO(statgv);
+	    else {
+		sv = statname;
+		goto really_filename;
+	    }
+	}
+	else {
+	    statgv = cGVOP->op_gv;
+	    sv_setpv(statname, "");
+	    io = GvIO(statgv);
+	}
+	if (io && IoIFP(io)) {
+#ifdef FILE_base
+	    Fstat(fileno(IoIFP(io)), &statcache);
+	    if (S_ISDIR(statcache.st_mode))	/* handle NFS glitch */
+		if (op->op_type == OP_FTTEXT)
+		    RETPUSHNO;
+		else
+		    RETPUSHYES;
+	    if (FILE_cnt(IoIFP(io)) <= 0) {
+		i = getc(IoIFP(io));
+		if (i != EOF)
+		    (void)ungetc(i, IoIFP(io));
+	    }
+	    if (FILE_cnt(IoIFP(io)) <= 0)	/* null file is anything */
+		RETPUSHYES;
+	    len = FILE_bufsiz(IoIFP(io));
+	    s = FILE_base(IoIFP(io));
+#else
+	    DIE("-T and -B not implemented on filehandles");
+#endif
+	}
+	else {
+	    if (dowarn)
+		warn("Test on unopened file <%s>",
+		  GvENAME(cGVOP->op_gv));
+	    SETERRNO(EBADF,RMS$_IFI);
+	    RETPUSHUNDEF;
+	}
+    }
+    else {
+	sv = POPs;
+	statgv = Nullgv;
+	sv_setpv(statname, SvPV(sv, na));
+      really_filename:
+#ifdef HAS_OPEN3
+	i = open(SvPV(sv, na), O_RDONLY, 0);
+#else
+	i = open(SvPV(sv, na), 0);
+#endif
+	if (i < 0) {
+	    if (dowarn && strchr(SvPV(sv, na), '\n'))
+		warn(warn_nl, "open");
+	    RETPUSHUNDEF;
+	}
+	Fstat(i, &statcache);
+	len = read(i, tbuf, 512);
+	(void)close(i);
+	if (len <= 0) {
+	    if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
+		RETPUSHNO;		/* special case NFS directories */
+	    RETPUSHYES;		/* null file is anything */
+	}
+	s = tbuf;
+    }
+
+    /* now scan s to look for textiness */
+    /*   XXX ASCII dependent code */
+
+    for (i = 0; i < len; i++, s++) {
+	if (!*s) {			/* null never allowed in text */
+	    odd += len;
+	    break;
+	}
+	else if (*s & 128)
+	    odd++;
+	else if (*s < 32 &&
+	  *s != '\n' && *s != '\r' && *s != '\b' &&
+	  *s != '\t' && *s != '\f' && *s != 27)
+	    odd++;
+    }
+
+    if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
+	RETPUSHNO;
+    else
+	RETPUSHYES;
+}
+
+PP(pp_ftbinary)
+{
+    return pp_fttext(ARGS);
+}
+
+/* File calls. */
+
+PP(pp_chdir)
+{
+    dSP; dTARGET;
+    char *tmps;
+    SV **svp;
+
+    if (MAXARG < 1)
+	tmps = Nullch;
+    else
+	tmps = POPp;
+    if (!tmps || !*tmps) {
+	svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
+	if (svp)
+	    tmps = SvPV(*svp, na);
+    }
+    if (!tmps || !*tmps) {
+	svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
+	if (svp)
+	    tmps = SvPV(*svp, na);
+    }
+    TAINT_PROPER("chdir");
+    PUSHi( chdir(tmps) >= 0 );
+#ifdef VMS
+    /* Clear the DEFAULT element of ENV so we'll get the new value
+     * in the future. */
+    hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
+#endif
+    RETURN;
+}
+
+PP(pp_chown)
+{
+    dSP; dMARK; dTARGET;
+    I32 value;
+#ifdef HAS_CHOWN
+    value = (I32)apply(op->op_type, MARK, SP);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function chown");
+#endif
+}
+
+PP(pp_chroot)
+{
+    dSP; dTARGET;
+    char *tmps;
+#ifdef HAS_CHROOT
+    tmps = POPp;
+    TAINT_PROPER("chroot");
+    PUSHi( chroot(tmps) >= 0 );
+    RETURN;
+#else
+    DIE(no_func, "chroot");
+#endif
+}
+
+PP(pp_unlink)
+{
+    dSP; dMARK; dTARGET;
+    I32 value;
+    value = (I32)apply(op->op_type, MARK, SP);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+}
+
+PP(pp_chmod)
+{
+    dSP; dMARK; dTARGET;
+    I32 value;
+    value = (I32)apply(op->op_type, MARK, SP);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+}
+
+PP(pp_utime)
+{
+    dSP; dMARK; dTARGET;
+    I32 value;
+    value = (I32)apply(op->op_type, MARK, SP);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+}
+
+PP(pp_rename)
+{
+    dSP; dTARGET;
+    int anum;
+
+    char *tmps2 = POPp;
+    char *tmps = SvPV(TOPs, na);
+    TAINT_PROPER("rename");
+#ifdef HAS_RENAME
+    anum = rename(tmps, tmps2);
+#else
+    if (same_dirent(tmps2, tmps))	/* can always rename to same name */
+	anum = 1;
+    else {
+	if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+	    (void)UNLINK(tmps2);
+	if (!(anum = link(tmps, tmps2)))
+	    anum = UNLINK(tmps);
+    }
+#endif
+    SETi( anum >= 0 );
+    RETURN;
+}
+
+PP(pp_link)
+{
+    dSP; dTARGET;
+#ifdef HAS_LINK
+    char *tmps2 = POPp;
+    char *tmps = SvPV(TOPs, na);
+    TAINT_PROPER("link");
+    SETi( link(tmps, tmps2) >= 0 );
+#else
+    DIE(no_func, "Unsupported function link");
+#endif
+    RETURN;
+}
+
+PP(pp_symlink)
+{
+    dSP; dTARGET;
+#ifdef HAS_SYMLINK
+    char *tmps2 = POPp;
+    char *tmps = SvPV(TOPs, na);
+    TAINT_PROPER("symlink");
+    SETi( symlink(tmps, tmps2) >= 0 );
+    RETURN;
+#else
+    DIE(no_func, "symlink");
+#endif
+}
+
+PP(pp_readlink)
+{
+    dSP; dTARGET;
+#ifdef HAS_SYMLINK
+    char *tmps;
+    int len;
+    tmps = POPp;
+    len = readlink(tmps, buf, sizeof buf);
+    EXTEND(SP, 1);
+    if (len < 0)
+	RETPUSHUNDEF;
+    PUSHp(buf, len);
+    RETURN;
+#else
+    EXTEND(SP, 1);
+    RETSETUNDEF;		/* just pretend it's a normal file */
+#endif
+}
+
+#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
+static int
+dooneliner(cmd, filename)
+char *cmd;
+char *filename;
+{
+    char mybuf[8192];
+    char *s,
+	 *save_filename = filename;
+    int anum = 1;
+    FILE *myfp;
+
+    strcpy(mybuf, cmd);
+    strcat(mybuf, " ");
+    for (s = mybuf+strlen(mybuf); *filename; ) {
+	*s++ = '\\';
+	*s++ = *filename++;
+    }
+    strcpy(s, " 2>&1");
+    myfp = my_popen(mybuf, "r");
+    if (myfp) {
+	*mybuf = '\0';
+	s = fgets(mybuf, sizeof mybuf, myfp);
+	(void)my_pclose(myfp);
+	if (s != Nullch) {
+	    for (errno = 1; errno < sys_nerr; errno++) {
+#ifdef HAS_SYS_ERRLIST
+		if (instr(mybuf, sys_errlist[errno]))	/* you don't see this */
+		    return 0;
+#else
+		char *errmsg;				/* especially if it isn't there */
+
+		if (instr(mybuf,
+		          (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
+		    return 0;
+#endif
+	    }
+	    SETERRNO(0,0);
+#ifndef EACCES
+#define EACCES EPERM
+#endif
+	    if (instr(mybuf, "cannot make"))
+		SETERRNO(EEXIST,RMS$_FEX);
+	    else if (instr(mybuf, "existing file"))
+		SETERRNO(EEXIST,RMS$_FEX);
+	    else if (instr(mybuf, "ile exists"))
+		SETERRNO(EEXIST,RMS$_FEX);
+	    else if (instr(mybuf, "non-exist"))
+		SETERRNO(ENOENT,RMS$_FNF);
+	    else if (instr(mybuf, "does not exist"))
+		SETERRNO(ENOENT,RMS$_FNF);
+	    else if (instr(mybuf, "not empty"))
+		SETERRNO(EBUSY,SS$_DEVOFFLINE);
+	    else if (instr(mybuf, "cannot access"))
+		SETERRNO(EACCES,RMS$_PRV);
+	    else
+		SETERRNO(EPERM,RMS$_PRV);
+	    return 0;
+	}
+	else {	/* some mkdirs return no failure indication */
+	    anum = (Stat(save_filename, &statbuf) >= 0);
+	    if (op->op_type == OP_RMDIR)
+		anum = !anum;
+	    if (anum)
+		SETERRNO(0,0);
+	    else
+		SETERRNO(EACCES,RMS$_PRV);	/* a guess */
+	}
+	return anum;
+    }
+    else
+	return 0;
+}
+#endif
+
+PP(pp_mkdir)
+{
+    dSP; dTARGET;
+    int mode = POPi;
+#ifndef HAS_MKDIR
+    int oldumask;
+#endif
+    char *tmps = SvPV(TOPs, na);
+
+    TAINT_PROPER("mkdir");
+#ifdef HAS_MKDIR
+    SETi( mkdir(tmps, mode) >= 0 );
+#else
+    SETi( dooneliner("mkdir", tmps) );
+    oldumask = umask(0);
+    umask(oldumask);
+    chmod(tmps, (mode & ~oldumask) & 0777);
+#endif
+    RETURN;
+}
+
+PP(pp_rmdir)
+{
+    dSP; dTARGET;
+    char *tmps;
+
+    tmps = POPp;
+    TAINT_PROPER("rmdir");
+#ifdef HAS_RMDIR
+    XPUSHi( rmdir(tmps) >= 0 );
+#else
+    XPUSHi( dooneliner("rmdir", tmps) );
+#endif
+    RETURN;
+}
+
+/* Directory calls. */
+
+PP(pp_open_dir)
+{
+    dSP;
+#if defined(Direntry_t) && defined(HAS_READDIR)
+    char *dirname = POPp;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io)
+	goto nope;
+
+    if (IoDIRP(io))
+	closedir(IoDIRP(io));
+    if (!(IoDIRP(io) = opendir(dirname)))
+	goto nope;
+
+    RETPUSHYES;
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_DIR);
+    RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "opendir");
+#endif
+}
+
+PP(pp_readdir)
+{
+    dSP;
+#if defined(Direntry_t) && defined(HAS_READDIR)
+#ifndef I_DIRENT
+    Direntry_t *readdir _((DIR *));
+#endif
+    register Direntry_t *dp;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoDIRP(io))
+	goto nope;
+
+    if (GIMME == G_ARRAY) {
+	/*SUPPRESS 560*/
+	while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
+#ifdef DIRNAMLEN
+	    XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
+#else
+	    XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
+#endif
+	}
+    }
+    else {
+	if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
+	    goto nope;
+#ifdef DIRNAMLEN
+	XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
+#else
+	XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
+#endif
+    }
+    RETURN;
+
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_ISI);
+    if (GIMME == G_ARRAY)
+	RETURN;
+    else
+	RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "readdir");
+#endif
+}
+
+PP(pp_telldir)
+{
+    dSP; dTARGET;
+#if defined(HAS_TELLDIR) || defined(telldir)
+#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
+    long telldir _((DIR *));
+#endif
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoDIRP(io))
+	goto nope;
+
+    PUSHi( telldir(IoDIRP(io)) );
+    RETURN;
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_ISI);
+    RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "telldir");
+#endif
+}
+
+PP(pp_seekdir)
+{
+    dSP;
+#if defined(HAS_SEEKDIR) || defined(seekdir)
+    long along = POPl;
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoDIRP(io))
+	goto nope;
+
+    (void)seekdir(IoDIRP(io), along);
+
+    RETPUSHYES;
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_ISI);
+    RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "seekdir");
+#endif
+}
+
+PP(pp_rewinddir)
+{
+    dSP;
+#if defined(HAS_REWINDDIR) || defined(rewinddir)
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoDIRP(io))
+	goto nope;
+
+    (void)rewinddir(IoDIRP(io));
+    RETPUSHYES;
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_ISI);
+    RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "rewinddir");
+#endif
+}
+
+PP(pp_closedir)
+{
+    dSP;
+#if defined(Direntry_t) && defined(HAS_READDIR)
+    GV *gv = (GV*)POPs;
+    register IO *io = GvIOn(gv);
+
+    if (!io || !IoDIRP(io))
+	goto nope;
+
+#ifdef VOID_CLOSEDIR
+    closedir(IoDIRP(io));
+#else
+    if (closedir(IoDIRP(io)) < 0) {
+	IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
+	goto nope;
+    }
+#endif
+    IoDIRP(io) = 0;
+
+    RETPUSHYES;
+nope:
+    if (!errno)
+	SETERRNO(EBADF,RMS$_IFI);
+    RETPUSHUNDEF;
+#else
+    DIE(no_dir_func, "closedir");
+#endif
+}
+
+/* Process control. */
+
+PP(pp_fork)
+{
+    dSP; dTARGET;
+    int childpid;
+    GV *tmpgv;
+
+    EXTEND(SP, 1);
+#ifdef HAS_FORK
+    childpid = fork();
+    if (childpid < 0)
+	RETSETUNDEF;
+    if (!childpid) {
+	/*SUPPRESS 560*/
+	if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
+	    sv_setiv(GvSV(tmpgv), (I32)getpid());
+	hv_clear(pidstatus);	/* no kids, so don't wait for 'em */
+    }
+    PUSHi(childpid);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function fork");
+#endif
+}
+
+PP(pp_wait)
+{
+    dSP; dTARGET;
+    int childpid;
+    int argflags;
+    I32 value;
+
+    EXTEND(SP, 1);
+#ifdef HAS_WAIT
+    childpid = wait(&argflags);
+    if (childpid > 0)
+	pidgone(childpid, argflags);
+    value = (I32)childpid;
+    statusvalue = FIXSTATUS(argflags);
+    PUSHi(value);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function wait");
+#endif
+}
+
+PP(pp_waitpid)
+{
+    dSP; dTARGET;
+    int childpid;
+    int optype;
+    int argflags;
+    I32 value;
+
+#ifdef HAS_WAIT
+    optype = POPi;
+    childpid = TOPi;
+    childpid = wait4pid(childpid, &argflags, optype);
+    value = (I32)childpid;
+    statusvalue = FIXSTATUS(argflags);
+    SETi(value);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function wait");
+#endif
+}
+
+PP(pp_system)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    I32 value;
+    int childpid;
+    int result;
+    int status;
+    Signal_t (*ihand)();     /* place to save signal during system() */
+    Signal_t (*qhand)();     /* place to save signal during system() */
+
+#if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
+    if (SP - MARK == 1) {
+	if (tainting) {
+	    char *junk = SvPV(TOPs, na);
+	    TAINT_ENV();
+	    TAINT_PROPER("system");
+	}
+    }
+    while ((childpid = vfork()) == -1) {
+	if (errno != EAGAIN) {
+	    value = -1;
+	    SP = ORIGMARK;
+	    PUSHi(value);
+	    RETURN;
+	}
+	sleep(5);
+    }
+    if (childpid > 0) {
+	ihand = signal(SIGINT, SIG_IGN);
+	qhand = signal(SIGQUIT, SIG_IGN);
+	do {
+	    result = wait4pid(childpid, &status, 0);
+	} while (result == -1 && errno == EINTR);
+	(void)signal(SIGINT, ihand);
+	(void)signal(SIGQUIT, qhand);
+	statusvalue = FIXSTATUS(status);
+	if (result < 0)
+	    value = -1;
+	else {
+	    value = (I32)((unsigned int)status & 0xffff);
+	}
+	do_execfree();	/* free any memory child malloced on vfork */
+	SP = ORIGMARK;
+	PUSHi(value);
+	RETURN;
+    }
+    if (op->op_flags & OPf_STACKED) {
+	SV *really = *++MARK;
+	value = (I32)do_aexec(really, MARK, SP);
+    }
+    else if (SP - MARK != 1)
+	value = (I32)do_aexec(Nullsv, MARK, SP);
+    else {
+	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+    }
+    _exit(-1);
+#else /* ! FORK or VMS or OS/2 */
+    if (op->op_flags & OPf_STACKED) {
+	SV *really = *++MARK;
+	value = (I32)do_aspawn(really, MARK, SP);
+    }
+    else if (SP - MARK != 1)
+	value = (I32)do_aspawn(Nullsv, MARK, SP);
+    else {
+	value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
+    }
+    statusvalue = FIXSTATUS(value);
+    do_execfree();
+    SP = ORIGMARK;
+    PUSHi(value);
+#endif /* !FORK or VMS */
+    RETURN;
+}
+
+PP(pp_exec)
+{
+    dSP; dMARK; dORIGMARK; dTARGET;
+    I32 value;
+
+    if (op->op_flags & OPf_STACKED) {
+	SV *really = *++MARK;
+	value = (I32)do_aexec(really, MARK, SP);
+    }
+    else if (SP - MARK != 1)
+#ifdef VMS
+	value = (I32)vms_do_aexec(Nullsv, MARK, SP);
+#else
+	value = (I32)do_aexec(Nullsv, MARK, SP);
+#endif
+    else {
+	if (tainting) {
+	    char *junk = SvPV(*SP, na);
+	    TAINT_ENV();
+	    TAINT_PROPER("exec");
+	}
+#ifdef VMS
+	value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
+#else
+	value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
+#endif
+    }
+    SP = ORIGMARK;
+    PUSHi(value);
+    RETURN;
+}
+
+PP(pp_kill)
+{
+    dSP; dMARK; dTARGET;
+    I32 value;
+#ifdef HAS_KILL
+    value = (I32)apply(op->op_type, MARK, SP);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function kill");
+#endif
+}
+
+PP(pp_getppid)
+{
+#ifdef HAS_GETPPID
+    dSP; dTARGET;
+    XPUSHi( getppid() );
+    RETURN;
+#else
+    DIE(no_func, "getppid");
+#endif
+}
+
+PP(pp_getpgrp)
+{
+#ifdef HAS_GETPGRP
+    dSP; dTARGET;
+    int pid;
+    I32 value;
+
+    if (MAXARG < 1)
+	pid = 0;
+    else
+	pid = SvIVx(POPs);
+#ifdef BSD_GETPGRP
+    value = (I32)BSD_GETPGRP(pid);
+#else
+    if (pid != 0)
+	DIE("POSIX getpgrp can't take an argument");
+    value = (I32)getpgrp();
+#endif
+    XPUSHi(value);
+    RETURN;
+#else
+    DIE(no_func, "getpgrp()");
+#endif
+}
+
+PP(pp_setpgrp)
+{
+#ifdef HAS_SETPGRP
+    dSP; dTARGET;
+    int pgrp;
+    int pid;
+    if (MAXARG < 2) {
+	pgrp = 0;
+	pid = 0;
+    }
+    else {
+	pgrp = POPi;
+	pid = TOPi;
+    }
+
+    TAINT_PROPER("setpgrp");
+#ifdef BSD_SETPGRP
+    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
+#else
+    if ((pgrp != 0) || (pid != 0)) {
+	DIE("POSIX setpgrp can't take an argument");
+    }
+    SETi( setpgrp() >= 0 );
+#endif /* USE_BSDPGRP */
+    RETURN;
+#else
+    DIE(no_func, "setpgrp()");
+#endif
+}
+
+PP(pp_getpriority)
+{
+    dSP; dTARGET;
+    int which;
+    int who;
+#ifdef HAS_GETPRIORITY
+    who = POPi;
+    which = TOPi;
+    SETi( getpriority(which, who) );
+    RETURN;
+#else
+    DIE(no_func, "getpriority()");
+#endif
+}
+
+PP(pp_setpriority)
+{
+    dSP; dTARGET;
+    int which;
+    int who;
+    int niceval;
+#ifdef HAS_SETPRIORITY
+    niceval = POPi;
+    who = POPi;
+    which = TOPi;
+    TAINT_PROPER("setpriority");
+    SETi( setpriority(which, who, niceval) >= 0 );
+    RETURN;
+#else
+    DIE(no_func, "setpriority()");
+#endif
+}
+
+/* Time calls. */
+
+PP(pp_time)
+{
+    dSP; dTARGET;
+    XPUSHi( time(Null(Time_t*)) );
+    RETURN;
+}
+
+#ifndef HZ
+#define HZ 60
+#endif
+
+PP(pp_tms)
+{
+    dSP;
+
+#if defined(MSDOS) || !defined(HAS_TIMES)
+    DIE("times not implemented");
+#else
+    EXTEND(SP, 4);
+
+#ifndef VMS
+    (void)times(&timesbuf);
+#else
+    (void)times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
+                                          /* struct tms, though same data   */
+                                          /* is returned.                   */
+#undef HZ
+#define HZ CLK_TCK
+#endif
+
+    PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
+    if (GIMME == G_ARRAY) {
+	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
+	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
+	PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
+    }
+    RETURN;
+#endif /* MSDOS */
+}
+
+PP(pp_localtime)
+{
+    return pp_gmtime(ARGS);
+}
+
+PP(pp_gmtime)
+{
+    dSP;
+    Time_t when;
+    struct tm *tmbuf;
+    static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
+    static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
+			      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
+
+    if (MAXARG < 1)
+	(void)time(&when);
+    else
+	when = (Time_t)SvIVx(POPs);
+
+    if (op->op_type == OP_LOCALTIME)
+	tmbuf = localtime(&when);
+    else
+	tmbuf = gmtime(&when);
+
+    EXTEND(SP, 9);
+    if (GIMME != G_ARRAY) {
+	dTARGET;
+	char mybuf[30];
+	if (!tmbuf)
+	    RETPUSHUNDEF;
+	sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
+	    dayname[tmbuf->tm_wday],
+	    monname[tmbuf->tm_mon],
+	    tmbuf->tm_mday,
+	    tmbuf->tm_hour,
+	    tmbuf->tm_min,
+	    tmbuf->tm_sec,
+	    tmbuf->tm_year + 1900);
+	PUSHp(mybuf, strlen(mybuf));
+    }
+    else if (tmbuf) {
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
+	PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
+    }
+    RETURN;
+}
+
+PP(pp_alarm)
+{
+    dSP; dTARGET;
+    int anum;
+#ifdef HAS_ALARM
+    anum = POPi;
+    anum = alarm((unsigned int)anum);
+    EXTEND(SP, 1);
+    if (anum < 0)
+	RETPUSHUNDEF;
+    PUSHi((I32)anum);
+    RETURN;
+#else
+    DIE(no_func, "Unsupported function alarm");
+#endif
+}
+
+PP(pp_sleep)
+{
+    dSP; dTARGET;
+    I32 duration;
+    Time_t lasttime;
+    Time_t when;
+
+    (void)time(&lasttime);
+    if (MAXARG < 1)
+	pause();
+    else {
+	duration = POPi;
+	sleep((unsigned int)duration);
+    }
+    (void)time(&when);
+    XPUSHi(when - lasttime);
+    RETURN;
+}
+
+/* Shared memory. */
+
+PP(pp_shmget)
+{
+    return pp_semget(ARGS);
+}
+
+PP(pp_shmctl)
+{
+    return pp_semctl(ARGS);
+}
+
+PP(pp_shmread)
+{
+    return pp_shmwrite(ARGS);
+}
+
+PP(pp_shmwrite)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    return pp_semget(ARGS);
+#endif
+}
+
+/* Message passing. */
+
+PP(pp_msgget)
+{
+    return pp_semget(ARGS);
+}
+
+PP(pp_msgctl)
+{
+    return pp_semctl(ARGS);
+}
+
+PP(pp_msgsnd)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    return pp_semget(ARGS);
+#endif
+}
+
+PP(pp_msgrcv)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    return pp_semget(ARGS);
+#endif
+}
+
+/* Semaphores. */
+
+PP(pp_semget)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    int anum = do_ipcget(op->op_type, MARK, SP);
+    SP = MARK;
+    if (anum == -1)
+	RETPUSHUNDEF;
+    PUSHi(anum);
+    RETURN;
+#else
+    DIE("System V IPC is not implemented on this machine");
+#endif
+}
+
+PP(pp_semctl)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    int anum = do_ipcctl(op->op_type, MARK, SP);
+    SP = MARK;
+    if (anum == -1)
+	RETSETUNDEF;
+    if (anum != 0) {
+	PUSHi(anum);
+    }
+    else {
+	PUSHp("0 but true",10);
+    }
+    RETURN;
+#else
+    return pp_semget(ARGS);
+#endif
+}
+
+PP(pp_semop)
+{
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+    dSP; dMARK; dTARGET;
+    I32 value = (I32)(do_semop(MARK, SP) >= 0);
+    SP = MARK;
+    PUSHi(value);
+    RETURN;
+#else
+    return pp_semget(ARGS);
+#endif
+}
+
+/* Get system info. */
+
+PP(pp_ghbyname)
+{
+#ifdef HAS_SOCKET
+    return pp_ghostent(ARGS);
+#else
+    DIE(no_sock_func, "gethostbyname");
+#endif
+}
+
+PP(pp_ghbyaddr)
+{
+#ifdef HAS_SOCKET
+    return pp_ghostent(ARGS);
+#else
+    DIE(no_sock_func, "gethostbyaddr");
+#endif
+}
+
+PP(pp_ghostent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    I32 which = op->op_type;
+    register char **elem;
+    register SV *sv;
+    struct hostent *gethostbyname();
+    struct hostent *gethostbyaddr();
+#ifdef HAS_GETHOSTENT
+    struct hostent *gethostent();
+#endif
+    struct hostent *hent;
+    unsigned long len;
+
+    EXTEND(SP, 10);
+    if (which == OP_GHBYNAME) {
+	hent = gethostbyname(POPp);
+    }
+    else if (which == OP_GHBYADDR) {
+	int addrtype = POPi;
+	SV *addrsv = POPs;
+	STRLEN addrlen;
+	char *addr = SvPV(addrsv, addrlen);
+
+	hent = gethostbyaddr(addr, addrlen, addrtype);
+    }
+    else
+#ifdef HAS_GETHOSTENT
+	hent = gethostent();
+#else
+	DIE("gethostent not implemented");
+#endif
+
+#ifdef HOST_NOT_FOUND
+    if (!hent)
+	statusvalue = FIXSTATUS(h_errno);
+#endif
+
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (hent) {
+	    if (which == OP_GHBYNAME) {
+		if (hent->h_addr)
+		    sv_setpvn(sv, hent->h_addr, hent->h_length);
+	    }
+	    else
+		sv_setpv(sv, (char*)hent->h_name);
+	}
+	RETURN;
+    }
+
+    if (hent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, (char*)hent->h_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	for (elem = hent->h_aliases; elem && *elem; elem++) {
+	    sv_catpv(sv, *elem);
+	    if (elem[1])
+		sv_catpvn(sv, " ", 1);
+	}
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)hent->h_addrtype);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	len = hent->h_length;
+	sv_setiv(sv, (I32)len);
+#ifdef h_addr
+	for (elem = hent->h_addr_list; elem && *elem; elem++) {
+	    XPUSHs(sv = sv_mortalcopy(&sv_no));
+	    sv_setpvn(sv, *elem, len);
+	}
+#else
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	if (hent->h_addr)
+	    sv_setpvn(sv, hent->h_addr, len);
+#endif /* h_addr */
+    }
+    RETURN;
+#else
+    DIE(no_sock_func, "gethostent");
+#endif
+}
+
+PP(pp_gnbyname)
+{
+#ifdef HAS_SOCKET
+    return pp_gnetent(ARGS);
+#else
+    DIE(no_sock_func, "getnetbyname");
+#endif
+}
+
+PP(pp_gnbyaddr)
+{
+#ifdef HAS_SOCKET
+    return pp_gnetent(ARGS);
+#else
+    DIE(no_sock_func, "getnetbyaddr");
+#endif
+}
+
+PP(pp_gnetent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    I32 which = op->op_type;
+    register char **elem;
+    register SV *sv;
+    struct netent *getnetbyname();
+    struct netent *getnetbyaddr();
+    struct netent *getnetent();
+    struct netent *nent;
+
+    if (which == OP_GNBYNAME)
+	nent = getnetbyname(POPp);
+    else if (which == OP_GNBYADDR) {
+	int addrtype = POPi;
+	unsigned long addr = U_L(POPn);
+	nent = getnetbyaddr((long)addr, addrtype);
+    }
+    else
+	nent = getnetent();
+
+    EXTEND(SP, 4);
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (nent) {
+	    if (which == OP_GNBYNAME)
+		sv_setiv(sv, (I32)nent->n_net);
+	    else
+		sv_setpv(sv, nent->n_name);
+	}
+	RETURN;
+    }
+
+    if (nent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, nent->n_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	for (elem = nent->n_aliases; *elem; elem++) {
+	    sv_catpv(sv, *elem);
+	    if (elem[1])
+		sv_catpvn(sv, " ", 1);
+	}
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)nent->n_addrtype);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)nent->n_net);
+    }
+
+    RETURN;
+#else
+    DIE(no_sock_func, "getnetent");
+#endif
+}
+
+PP(pp_gpbyname)
+{
+#ifdef HAS_SOCKET
+    return pp_gprotoent(ARGS);
+#else
+    DIE(no_sock_func, "getprotobyname");
+#endif
+}
+
+PP(pp_gpbynumber)
+{
+#ifdef HAS_SOCKET
+    return pp_gprotoent(ARGS);
+#else
+    DIE(no_sock_func, "getprotobynumber");
+#endif
+}
+
+PP(pp_gprotoent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    I32 which = op->op_type;
+    register char **elem;
+    register SV *sv;
+    struct protoent *getprotobyname();
+    struct protoent *getprotobynumber();
+    struct protoent *getprotoent();
+    struct protoent *pent;
+
+    if (which == OP_GPBYNAME)
+	pent = getprotobyname(POPp);
+    else if (which == OP_GPBYNUMBER)
+	pent = getprotobynumber(POPi);
+    else
+	pent = getprotoent();
+
+    EXTEND(SP, 3);
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (pent) {
+	    if (which == OP_GPBYNAME)
+		sv_setiv(sv, (I32)pent->p_proto);
+	    else
+		sv_setpv(sv, pent->p_name);
+	}
+	RETURN;
+    }
+
+    if (pent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pent->p_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	for (elem = pent->p_aliases; *elem; elem++) {
+	    sv_catpv(sv, *elem);
+	    if (elem[1])
+		sv_catpvn(sv, " ", 1);
+	}
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)pent->p_proto);
+    }
+
+    RETURN;
+#else
+    DIE(no_sock_func, "getprotoent");
+#endif
+}
+
+PP(pp_gsbyname)
+{
+#ifdef HAS_SOCKET
+    return pp_gservent(ARGS);
+#else
+    DIE(no_sock_func, "getservbyname");
+#endif
+}
+
+PP(pp_gsbyport)
+{
+#ifdef HAS_SOCKET
+    return pp_gservent(ARGS);
+#else
+    DIE(no_sock_func, "getservbyport");
+#endif
+}
+
+PP(pp_gservent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    I32 which = op->op_type;
+    register char **elem;
+    register SV *sv;
+    struct servent *getservbyname();
+    struct servent *getservbynumber();
+    struct servent *getservent();
+    struct servent *sent;
+
+    if (which == OP_GSBYNAME) {
+	char *proto = POPp;
+	char *name = POPp;
+
+	if (proto && !*proto)
+	    proto = Nullch;
+
+	sent = getservbyname(name, proto);
+    }
+    else if (which == OP_GSBYPORT) {
+	char *proto = POPp;
+	int port = POPi;
+
+	sent = getservbyport(port, proto);
+    }
+    else
+	sent = getservent();
+
+    EXTEND(SP, 4);
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (sent) {
+	    if (which == OP_GSBYNAME) {
+#ifdef HAS_NTOHS
+		sv_setiv(sv, (I32)ntohs(sent->s_port));
+#else
+		sv_setiv(sv, (I32)(sent->s_port));
+#endif
+	    }
+	    else
+		sv_setpv(sv, sent->s_name);
+	}
+	RETURN;
+    }
+
+    if (sent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, sent->s_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	for (elem = sent->s_aliases; *elem; elem++) {
+	    sv_catpv(sv, *elem);
+	    if (elem[1])
+		sv_catpvn(sv, " ", 1);
+	}
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef HAS_NTOHS
+	sv_setiv(sv, (I32)ntohs(sent->s_port));
+#else
+	sv_setiv(sv, (I32)(sent->s_port));
+#endif
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, sent->s_proto);
+    }
+
+    RETURN;
+#else
+    DIE(no_sock_func, "getservent");
+#endif
+}
+
+PP(pp_shostent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    sethostent(TOPi);
+    RETSETYES;
+#else
+    DIE(no_sock_func, "sethostent");
+#endif
+}
+
+PP(pp_snetent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    setnetent(TOPi);
+    RETSETYES;
+#else
+    DIE(no_sock_func, "setnetent");
+#endif
+}
+
+PP(pp_sprotoent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    setprotoent(TOPi);
+    RETSETYES;
+#else
+    DIE(no_sock_func, "setprotoent");
+#endif
+}
+
+PP(pp_sservent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    setservent(TOPi);
+    RETSETYES;
+#else
+    DIE(no_sock_func, "setservent");
+#endif
+}
+
+PP(pp_ehostent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    endhostent();
+    EXTEND(sp,1);
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "endhostent");
+#endif
+}
+
+PP(pp_enetent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    endnetent();
+    EXTEND(sp,1);
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "endnetent");
+#endif
+}
+
+PP(pp_eprotoent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    endprotoent();
+    EXTEND(sp,1);
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "endprotoent");
+#endif
+}
+
+PP(pp_eservent)
+{
+    dSP;
+#ifdef HAS_SOCKET
+    endservent();
+    EXTEND(sp,1);
+    RETPUSHYES;
+#else
+    DIE(no_sock_func, "endservent");
+#endif
+}
+
+PP(pp_gpwnam)
+{
+#ifdef HAS_PASSWD
+    return pp_gpwent(ARGS);
+#else
+    DIE(no_func, "getpwnam");
+#endif
+}
+
+PP(pp_gpwuid)
+{
+#ifdef HAS_PASSWD
+    return pp_gpwent(ARGS);
+#else
+    DIE(no_func, "getpwuid");
+#endif
+}
+
+PP(pp_gpwent)
+{
+    dSP;
+#ifdef HAS_PASSWD
+    I32 which = op->op_type;
+    register SV *sv;
+    struct passwd *pwent;
+
+    if (which == OP_GPWNAM)
+	pwent = getpwnam(POPp);
+    else if (which == OP_GPWUID)
+	pwent = getpwuid(POPi);
+    else
+	pwent = (struct passwd *)getpwent();
+
+    EXTEND(SP, 10);
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (pwent) {
+	    if (which == OP_GPWNAM)
+		sv_setiv(sv, (I32)pwent->pw_uid);
+	    else
+		sv_setpv(sv, pwent->pw_name);
+	}
+	RETURN;
+    }
+
+    if (pwent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pwent->pw_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pwent->pw_passwd);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)pwent->pw_uid);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)pwent->pw_gid);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWCHANGE
+	sv_setiv(sv, (I32)pwent->pw_change);
+#else
+#ifdef PWQUOTA
+	sv_setiv(sv, (I32)pwent->pw_quota);
+#else
+#ifdef PWAGE
+	sv_setpv(sv, pwent->pw_age);
+#endif
+#endif
+#endif
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWCLASS
+	sv_setpv(sv, pwent->pw_class);
+#else
+#ifdef PWCOMMENT
+	sv_setpv(sv, pwent->pw_comment);
+#endif
+#endif
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pwent->pw_gecos);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pwent->pw_dir);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, pwent->pw_shell);
+#ifdef PWEXPIRE
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)pwent->pw_expire);
+#endif
+    }
+    RETURN;
+#else
+    DIE(no_func, "getpwent");
+#endif
+}
+
+PP(pp_spwent)
+{
+    dSP;
+#ifdef HAS_PASSWD
+    setpwent();
+    RETPUSHYES;
+#else
+    DIE(no_func, "setpwent");
+#endif
+}
+
+PP(pp_epwent)
+{
+    dSP;
+#ifdef HAS_PASSWD
+    endpwent();
+    RETPUSHYES;
+#else
+    DIE(no_func, "endpwent");
+#endif
+}
+
+PP(pp_ggrnam)
+{
+#ifdef HAS_GROUP
+    return pp_ggrent(ARGS);
+#else
+    DIE(no_func, "getgrnam");
+#endif
+}
+
+PP(pp_ggrgid)
+{
+#ifdef HAS_GROUP
+    return pp_ggrent(ARGS);
+#else
+    DIE(no_func, "getgrgid");
+#endif
+}
+
+PP(pp_ggrent)
+{
+    dSP;
+#ifdef HAS_GROUP
+    I32 which = op->op_type;
+    register char **elem;
+    register SV *sv;
+    struct group *grent;
+
+    if (which == OP_GGRNAM)
+	grent = (struct group *)getgrnam(POPp);
+    else if (which == OP_GGRGID)
+	grent = (struct group *)getgrgid(POPi);
+    else
+	grent = (struct group *)getgrent();
+
+    EXTEND(SP, 4);
+    if (GIMME != G_ARRAY) {
+	PUSHs(sv = sv_newmortal());
+	if (grent) {
+	    if (which == OP_GGRNAM)
+		sv_setiv(sv, (I32)grent->gr_gid);
+	    else
+		sv_setpv(sv, grent->gr_name);
+	}
+	RETURN;
+    }
+
+    if (grent) {
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, grent->gr_name);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setpv(sv, grent->gr_passwd);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	sv_setiv(sv, (I32)grent->gr_gid);
+	PUSHs(sv = sv_mortalcopy(&sv_no));
+	for (elem = grent->gr_mem; *elem; elem++) {
+	    sv_catpv(sv, *elem);
+	    if (elem[1])
+		sv_catpvn(sv, " ", 1);
+	}
+    }
+
+    RETURN;
+#else
+    DIE(no_func, "getgrent");
+#endif
+}
+
+PP(pp_sgrent)
+{
+    dSP;
+#ifdef HAS_GROUP
+    setgrent();
+    RETPUSHYES;
+#else
+    DIE(no_func, "setgrent");
+#endif
+}
+
+PP(pp_egrent)
+{
+    dSP;
+#ifdef HAS_GROUP
+    endgrent();
+    RETPUSHYES;
+#else
+    DIE(no_func, "endgrent");
+#endif
+}
+
+PP(pp_getlogin)
+{
+    dSP; dTARGET;
+#ifdef HAS_GETLOGIN
+    char *tmps;
+    EXTEND(SP, 1);
+    if (!(tmps = getlogin()))
+	RETPUSHUNDEF;
+    PUSHp(tmps, strlen(tmps));
+    RETURN;
+#else
+    DIE(no_func, "getlogin");
+#endif
+}
+
+/* Miscellaneous. */
+
+PP(pp_syscall)
+{
+#ifdef HAS_SYSCALL
+    dSP; dMARK; dORIGMARK; dTARGET;
+    register I32 items = SP - MARK;
+    unsigned long a[20];
+    register I32 i = 0;
+    I32 retval = -1;
+    MAGIC *mg;
+
+    if (tainting) {
+	while (++MARK <= SP) {
+	    if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
+	      (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
+		tainted = TRUE;
+	}
+	MARK = ORIGMARK;
+	TAINT_PROPER("syscall");
+    }
+
+    /* This probably won't work on machines where sizeof(long) != sizeof(int)
+     * or where sizeof(long) != sizeof(char*).  But such machines will
+     * not likely have syscall implemented either, so who cares?
+     */
+    while (++MARK <= SP) {
+	if (SvNIOK(*MARK) || !i)
+	    a[i++] = SvIV(*MARK);
+	else if (*MARK == &sv_undef)
+	    a[i++] = 0;
+	else 
+	    a[i++] = (unsigned long)SvPV_force(*MARK, na);
+	if (i > 15)
+	    break;
+    }
+    switch (items) {
+    default:
+	DIE("Too many args to syscall");
+    case 0:
+	DIE("Too few args to syscall");
+    case 1:
+	retval = syscall(a[0]);
+	break;
+    case 2:
+	retval = syscall(a[0],a[1]);
+	break;
+    case 3:
+	retval = syscall(a[0],a[1],a[2]);
+	break;
+    case 4:
+	retval = syscall(a[0],a[1],a[2],a[3]);
+	break;
+    case 5:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4]);
+	break;
+    case 6:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
+	break;
+    case 7:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
+	break;
+    case 8:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
+	break;
+#ifdef atarist
+    case 9:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
+	break;
+    case 10:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
+	break;
+    case 11:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
+	  a[10]);
+	break;
+    case 12:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
+	  a[10],a[11]);
+	break;
+    case 13:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
+	  a[10],a[11],a[12]);
+	break;
+    case 14:
+	retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
+	  a[10],a[11],a[12],a[13]);
+	break;
+#endif /* atarist */
+    }
+    SP = ORIGMARK;
+    PUSHi(retval);
+    RETURN;
+#else
+    DIE(no_func, "syscall");
+#endif
+}
+
+#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+
+/*  XXX Emulate flock() with lockf().  This is just to increase
+    portability of scripts.  The calls are not completely
+    interchangeable.  What's really needed is a good file
+    locking module.
+*/
+
+/*  We might need <unistd.h> because it sometimes defines the lockf()
+    constants.  Unfortunately, <unistd.h> causes troubles on some mixed
+    (BSD/POSIX) systems, such as SunOS 4.1.3.  We could just try including
+    <unistd.h> here in this part of the file, but that might
+    conflict with various other #defines and includes above, such as
+	#define vfork fork above.
+
+   Further, the lockf() constants aren't POSIX, so they might not be
+   visible if we're compiling with _POSIX_SOURCE defined.  Thus, we'll
+   just stick in the SVID values and be done with it.  Sigh.
+*/
+
+# ifndef F_ULOCK
+#  define F_ULOCK	0	/* Unlock a previously locked region */
+# endif
+# ifndef F_LOCK
+#  define F_LOCK	1	/* Lock a region for exclusive use */
+# endif
+# ifndef F_TLOCK
+#  define F_TLOCK	2	/* Test and lock a region for exclusive use */
+# endif
+# ifndef F_TEST
+#  define F_TEST	3	/* Test a region for other processes locks */
+# endif
+
+/* These are the flock() constants.  Since this sytems doesn't have
+   flock(), the values of the constants are probably not available.
+*/
+# ifndef LOCK_SH
+#  define LOCK_SH 1
+# endif
+# ifndef LOCK_EX
+#  define LOCK_EX 2
+# endif
+# ifndef LOCK_NB
+#  define LOCK_NB 4
+# endif
+# ifndef LOCK_UN
+#  define LOCK_UN 8
+# endif
+
+int
+lockf_emulate_flock (fd, operation)
+int fd;
+int operation;
+{
+    int i;
+    switch (operation) {
+
+	/* LOCK_SH - get a shared lock */
+	case LOCK_SH:
+	/* LOCK_EX - get an exclusive lock */
+	case LOCK_EX:
+	    i = lockf (fd, F_LOCK, 0);
+	    break;
+
+	/* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
+	case LOCK_SH|LOCK_NB:
+	/* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
+	case LOCK_EX|LOCK_NB:
+	    i = lockf (fd, F_TLOCK, 0);
+	    if (i == -1)
+		if ((errno == EAGAIN) || (errno == EACCES))
+		    errno = EWOULDBLOCK;
+	    break;
+
+	/* LOCK_UN - unlock */
+	case LOCK_UN:
+	    i = lockf (fd, F_ULOCK, 0);
+	    break;
+
+	/* Default - can't decipher operation */
+	default:
+	    i = -1;
+	    errno = EINVAL;
+	    break;
+    }
+    return (i);
+}
+#endif
diff --git a/gnu/usr.bin/perl/proto.h b/gnu/usr.bin/perl/proto.h
new file mode 100644
index 00000000000..542d5663fdc
--- /dev/null
+++ b/gnu/usr.bin/perl/proto.h
@@ -0,0 +1,472 @@
+#ifndef NEXT30_NO_ATTRIBUTE
+#ifndef HASATTRIBUTE       /* disable GNU-cc attribute checking? */
+#ifdef  __attribute__      /* Avoid possible redefinition errors */
+#undef  __attribute__
+#endif
+#define __attribute__(attr)
+#endif 
+#endif
+#ifdef OVERLOAD
+SV*	amagic_call _((SV* left,SV* right,int method,int dir));
+bool Gv_AMupdate _((HV* stash));
+#endif /* OVERLOAD */
+OP*	append_elem _((I32 optype, OP* head, OP* tail));
+OP*	append_list _((I32 optype, LISTOP* first, LISTOP* last));
+I32	apply _((I32 type, SV** mark, SV** sp));
+void	assertref _((OP* op));
+void	av_clear _((AV* ar));
+void	av_extend _((AV* ar, I32 key));
+AV*	av_fake _((I32 size, SV** svp));
+SV**	av_fetch _((AV* ar, I32 key, I32 lval));
+void	av_fill _((AV* ar, I32 fill));
+I32	av_len _((AV* ar));
+AV*	av_make _((I32 size, SV** svp));
+SV*	av_pop _((AV* ar));
+void	av_push _((AV* ar, SV* val));
+SV*	av_shift _((AV* ar));
+SV**	av_store _((AV* ar, I32 key, SV* val));
+void	av_undef _((AV* ar));
+void	av_unshift _((AV* ar, I32 num));
+OP*	bind_match _((I32 type, OP* left, OP* pat));
+OP*	block_end _((int line, int floor, OP* seq));
+int	block_start _((void));
+void	calllist _((AV* list));
+I32	cando _((I32 bit, I32 effective, struct stat* statbufp));
+#ifndef CASTNEGFLOAT
+U32	cast_ulong _((double f));
+#endif
+#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
+I32	chsize _((int fd, Off_t length));
+#endif
+OP *	ck_gvconst _((OP * o));
+OP *	ck_retarget _((OP *op));
+OP*	convert _((I32 optype, I32 flags, OP* op));
+char*	cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen));
+void	croak _((char* pat,...)) __attribute__((format(printf,1,2),noreturn));
+CV*	cv_clone _((CV* proto));
+void	cv_undef _((CV* cv));
+#ifdef DEBUGGING
+void	cx_dump _((CONTEXT* cs));
+#endif
+SV *	filter_add _((filter_t funcp, SV *datasv));
+void	filter_del _((filter_t funcp));
+I32	filter_read _((int idx, SV *buffer, int maxlen));
+I32	cxinc _((void));
+void	deb _((char* pat,...)) __attribute__((format(printf,1,2)));
+void	deb_growlevel _((void));
+I32	debop _((OP* op));
+I32	debstackptrs _((void));
+#ifdef DEBUGGING
+void	debprofdump _((void));
+#endif
+I32	debstack _((void));
+void	deprecate _((char* s));
+OP*	die _((char* pat,...)) __attribute__((format(printf,1,2)));
+OP*	die_where _((char* message));
+void	dounwind _((I32 cxix));
+bool	do_aexec _((SV* really, SV** mark, SV** sp));
+void    do_chop _((SV* asv, SV* sv));
+bool	do_close _((GV* gv, bool explicit));
+bool	do_eof _((GV* gv));
+bool	do_exec _((char* cmd));
+void	do_execfree _((void));
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+I32	do_ipcctl _((I32 optype, SV** mark, SV** sp));
+I32	do_ipcget _((I32 optype, SV** mark, SV** sp));
+#endif
+void	do_join _((SV* sv, SV* del, SV** mark, SV** sp));
+OP*	do_kv _((void));
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+I32	do_msgrcv _((SV** mark, SV** sp));
+I32	do_msgsnd _((SV** mark, SV** sp));
+#endif
+bool	do_open _((GV* gv, char* name, I32 len,
+		   int as_raw, int rawmode, int rawperm, FILE* supplied_fp));
+void	do_pipe _((SV* sv, GV* rgv, GV* wgv));
+bool	do_print _((SV* sv, FILE* fp));
+OP *	do_readline _((void));
+I32	do_chomp _((SV* sv));
+bool	do_seek _((GV* gv, long pos, int whence));
+#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+I32	do_semop _((SV** mark, SV** sp));
+I32	do_shmio _((I32 optype, SV** mark, SV** sp));
+#endif
+void	do_sprintf _((SV* sv, I32 len, SV** sarg));
+long	do_tell _((GV* gv));
+I32	do_trans _((SV* sv, OP* arg));
+void	do_vecset _((SV* sv));
+void	do_vop _((I32 optype, SV* sv, SV* left, SV* right));
+I32	dowantarray _((void));
+void	dump_all _((void));
+void	dump_eval _((void));
+#ifdef DUMP_FDS  /* See util.c */
+int	dump_fds _((char* s));
+#endif
+void	dump_form _((GV* gv));
+void	dump_gv _((GV* gv));
+#ifdef MYMALLOC
+void	dump_mstats _((char* s));
+#endif
+void	dump_op _((OP* arg));
+void	dump_pm _((PMOP* pm));
+void	dump_packsubs _((HV* stash));
+void	dump_sub _((GV* gv));
+void	fbm_compile _((SV* sv, I32 iflag));
+char*	fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
+OP*	force_list _((OP* arg));
+OP*	fold_constants _((OP * arg));
+void	free_tmps _((void));
+OP*	gen_constant_list _((OP* op));
+void	gp_free _((GV* gv));
+GP*	gp_ref _((GP* gp));
+GV*	gv_AVadd _((GV* gv));
+GV*	gv_HVadd _((GV* gv));
+GV*	gv_IOadd _((GV* gv));
+void	gv_check _((HV* stash));
+void	gv_efullname _((SV* sv, GV* gv));
+GV*	gv_fetchfile _((char* name));
+GV*	gv_fetchmeth _((HV* stash, char* name, STRLEN len, I32 level));
+GV*	gv_fetchmethod _((HV* stash, char* name));
+GV*	gv_fetchpv _((char* name, I32 add, I32 sv_type));
+void	gv_fullname _((SV* sv, GV* gv));
+void	gv_init _((GV *gv, HV *stash, char *name, STRLEN len, int multi));
+HV*	gv_stashpv _((char* name, I32 create));
+HV*	gv_stashsv _((SV* sv, I32 create));
+void	he_delayfree _((HE* hent));
+void	he_free _((HE* hent));
+void	hoistmust _((PMOP* pm));
+void	hv_clear _((HV* tb));
+SV*	hv_delete _((HV* tb, char* key, U32 klen, I32 flags));
+bool	hv_exists _((HV* tb, char* key, U32 klen));
+SV**	hv_fetch _((HV* tb, char* key, U32 klen, I32 lval));
+I32	hv_iterinit _((HV* tb));
+char*	hv_iterkey _((HE* entry, I32* retlen));
+HE*	hv_iternext _((HV* tb));
+SV *	hv_iternextsv _((HV* hv, char** key, I32* retlen));
+SV*	hv_iterval _((HV* tb, HE* entry));
+void	hv_magic _((HV* hv, GV* gv, int how));
+SV**	hv_store _((HV* tb, char* key, U32 klen, SV* val, U32 hash));
+void	hv_undef _((HV* tb));
+I32	ibcmp _((U8* a, U8* b, I32 len));
+I32	ingroup _((I32 testgid, I32 effective));
+char*	instr _((char* big, char* little));
+bool	io_close _((IO* io));
+OP*	invert _((OP* cmd));
+OP*	jmaybe _((OP* arg));
+I32	keyword _((char* d, I32 len));
+void	leave_scope _((I32 base));
+void	lex_end _((void));
+void	lex_start _((SV *line));
+OP*	linklist _((OP* op));
+OP*	list _((OP* o));
+OP*	listkids _((OP* o));
+OP*	localize _((OP* arg, I32 lexical));
+I32	looks_like_number _((SV* sv));
+int	magic_clearenv	_((SV* sv, MAGIC* mg));
+int	magic_clearpack	_((SV* sv, MAGIC* mg));
+int	magic_existspack	_((SV* sv, MAGIC* mg));
+int	magic_get	_((SV* sv, MAGIC* mg));
+int	magic_getarylen	_((SV* sv, MAGIC* mg));
+int	magic_getpack	_((SV* sv, MAGIC* mg));
+int	magic_getglob	_((SV* sv, MAGIC* mg));
+int	magic_getpos	_((SV* sv, MAGIC* mg));
+int	magic_gettaint	_((SV* sv, MAGIC* mg));
+int	magic_getuvar	_((SV* sv, MAGIC* mg));
+U32	magic_len	_((SV* sv, MAGIC* mg));
+int	magic_nextpack	_((SV* sv, MAGIC* mg, SV* key));
+int	magic_set	_((SV* sv, MAGIC* mg));
+#ifdef OVERLOAD
+int	magic_setamagic	_((SV* sv, MAGIC* mg));
+#endif /* OVERLOAD */
+int	magic_setarylen	_((SV* sv, MAGIC* mg));
+int	magic_setbm	_((SV* sv, MAGIC* mg));
+int	magic_setdbline	_((SV* sv, MAGIC* mg));
+int	magic_setenv	_((SV* sv, MAGIC* mg));
+int	magic_setisa	_((SV* sv, MAGIC* mg));
+int	magic_setglob	_((SV* sv, MAGIC* mg));
+int	magic_setmglob	_((SV* sv, MAGIC* mg));
+int	magic_setpack	_((SV* sv, MAGIC* mg));
+int	magic_setpos	_((SV* sv, MAGIC* mg));
+int	magic_setsig	_((SV* sv, MAGIC* mg));
+int	magic_setsubstr	_((SV* sv, MAGIC* mg));
+int	magic_settaint	_((SV* sv, MAGIC* mg));
+int	magic_setuvar	_((SV* sv, MAGIC* mg));
+int	magic_setvec	_((SV* sv, MAGIC* mg));
+int	magic_wipepack	_((SV* sv, MAGIC* mg));
+void	magicname _((char* sym, char* name, I32 namlen));
+int	main _((int argc, char** argv, char** env));
+#if !defined(STANDARD_C)
+Malloc_t	malloc _((MEM_SIZE nbytes));
+#endif
+#if defined(MYMALLOC) && defined(HIDEMYMALLOC)
+extern Malloc_t malloc _((MEM_SIZE nbytes));
+extern Malloc_t realloc _((Malloc_t, MEM_SIZE));
+extern Free_t   free _((Malloc_t));
+#endif
+void	markstack_grow _((void));
+char*	mess _((char* pat, va_list* args));
+int	mg_clear _((SV* sv));
+int	mg_copy _((SV *, SV *, char *, STRLEN));
+MAGIC*	mg_find _((SV* sv, int type));
+int	mg_free _((SV* sv));
+int	mg_get _((SV* sv));
+U32	mg_len _((SV* sv));
+void	mg_magical _((SV* sv));
+int	mg_set _((SV* sv));
+OP*	mod _((OP* op, I32 type));
+char*	moreswitches _((char* s));
+OP *	my _(( OP *));
+char*	my_bcopy _((char* from, char* to, I32 len));
+#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
+char*	my_bzero _((char* loc, I32 len));
+#endif
+void	my_exit _((U32 status)) __attribute__((noreturn));
+I32	my_lstat _((void));
+#ifndef HAS_MEMCMP
+I32	my_memcmp _((unsigned char* s1, unsigned char* s2, I32 len));
+#endif
+I32	my_pclose _((FILE* ptr));
+FILE*	my_popen _((char* cmd, char* mode));
+void	my_setenv _((char* nam, char* val));
+I32	my_stat _((void));
+#ifdef MYSWAP
+short	my_swap _((short s));
+long	my_htonl _((long l));
+long	my_ntohl _((long l));
+#endif
+void	my_unexec _((void));
+OP*	newANONLIST _((OP* op));
+OP*	newANONHASH _((OP* op));
+OP*	newANONSUB _((I32 floor, OP* proto, OP* block));
+OP*	newASSIGNOP _((I32 flags, OP* left, I32 optype, OP* right));
+OP*	newCONDOP _((I32 flags, OP* expr, OP* trueop, OP* falseop));
+void	newFORM _((I32 floor, OP* op, OP* block));
+OP*	newFOROP _((I32 flags, char* label, line_t forline, OP* scalar, OP* expr, OP*block, OP*cont));
+OP*	newLOGOP _((I32 optype, I32 flags, OP* left, OP* right));
+OP*	newLOOPEX _((I32 type, OP* label));
+OP*	newLOOPOP _((I32 flags, I32 debuggable, OP* expr, OP* block));
+OP*	newNULLLIST _((void));
+OP*	newOP _((I32 optype, I32 flags));
+void	newPROG _((OP* op));
+OP*	newRANGE _((I32 flags, OP* left, OP* right));
+OP*	newSLICEOP _((I32 flags, OP* subscript, OP* list));
+OP*	newSTATEOP _((I32 flags, char* label, OP* o));
+CV*	newSUB _((I32 floor, OP* op, OP* proto, OP* block));
+CV*	newXS _((char *name, void (*subaddr)(CV* cv), char *filename));
+#ifdef DEPRECATED
+CV*	newXSUB _((char *name, I32 ix, I32 (*subaddr)(int,int,int), char *filename));
+#endif
+AV*	newAV _((void));
+OP*	newAVREF _((OP* o));
+OP*	newBINOP _((I32 type, I32 flags, OP* first, OP* last));
+OP*	newCVREF _((I32 flags, OP* o));
+OP*	newGVOP _((I32 type, I32 flags, GV* gv));
+GV*	newGVgen _((char *pack));
+OP*	newGVREF _((I32 type, OP* o));
+OP*	newHVREF _((OP* o));
+HV*	newHV _((void));
+IO*	newIO _((void));
+OP*	newLISTOP _((I32 type, I32 flags, OP* first, OP* last));
+OP*	newPMOP _((I32 type, I32 flags));
+OP*	newPVOP _((I32 type, I32 flags, char* pv));
+SV*	newRV _((SV* ref));
+#ifdef LEAKTEST
+SV*	newSV _((I32 x, STRLEN len));
+#else
+SV*	newSV _((STRLEN len));
+#endif
+OP*	newSVREF _((OP* o));
+OP*	newSVOP _((I32 type, I32 flags, SV* sv));
+SV*	newSViv _((IV i));
+SV*	newSVnv _((double n));
+SV*	newSVpv _((char* s, STRLEN len));
+SV*	newSVrv _((SV* rv, char* classname));
+SV*	newSVsv _((SV* old));
+OP*	newUNOP _((I32 type, I32 flags, OP* first));
+OP *	newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop, OP* expr, OP* block, OP* cont));
+FILE*	nextargv _((GV* gv));
+char*	ninstr _((char* big, char* bigend, char* little, char* lend));
+OP *	oopsCV _((OP* o));
+void	op_free _((OP* arg));
+void	package _((OP* op));
+PADOFFSET	pad_alloc _((I32 optype, U32 tmptype));
+PADOFFSET	pad_allocmy _((char* name));
+PADOFFSET	pad_findmy _((char* name));
+OP*	oopsAV _((OP* o));
+OP*	oopsHV _((OP* o));
+void	pad_leavemy _((I32 fill));
+SV*	pad_sv _((PADOFFSET po));
+void	pad_free _((PADOFFSET po));
+void	pad_reset _((void));
+void	pad_swipe _((PADOFFSET po));
+void	peep _((OP* op));
+PerlInterpreter*	perl_alloc _((void));
+I32	perl_call_argv _((char* subname, I32 flags, char** argv));
+I32	perl_call_method _((char* methname, I32 flags));
+I32	perl_call_pv _((char* subname, I32 flags));
+I32	perl_call_sv _((SV* sv, I32 flags));
+void	perl_construct _((PerlInterpreter* sv_interp));
+void	perl_destruct _((PerlInterpreter* sv_interp));
+I32	perl_eval_sv _((SV* sv, I32 flags));
+void	perl_free _((PerlInterpreter* sv_interp));
+SV*	perl_get_sv _((char* name, I32 create));
+AV*	perl_get_av _((char* name, I32 create));
+HV*	perl_get_hv _((char* name, I32 create));
+CV*	perl_get_cv _((char* name, I32 create));
+int	perl_init_i18nl14n _((int printwarn));
+int	perl_parse _((PerlInterpreter* sv_interp, void(*xsinit)(void), int argc, char** argv, char** env));
+void	perl_require_pv _((char* pv));
+#define perl_requirepv perl_require_pv
+int	perl_run _((PerlInterpreter* sv_interp));
+void	pidgone _((int pid, int status));
+void	pmflag _((U16* pmfl, int ch));
+OP*	pmruntime _((OP* pm, OP* expr, OP* repl));
+OP*	pmtrans _((OP* op, OP* expr, OP* repl));
+OP*	pop_return _((void));
+void	pop_scope _((void));
+OP*	prepend_elem _((I32 optype, OP* head, OP* tail));
+void	provide_ref _((OP* op, SV* sv));
+void	push_return _((OP* op));
+void	push_scope _((void));
+regexp*	pregcomp _((char* exp, char* xend, PMOP* pm));
+OP*	ref _((OP* op, I32 type));
+OP*	refkids _((OP* op, I32 type));
+void	regdump _((regexp* r));
+I32	pregexec _((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, I32 safebase));
+void	pregfree _((struct regexp* r));
+char*	regnext _((char* p));
+char*	regprop _((char* op));
+void	repeatcpy _((char* to, char* from, I32 len, I32 count));
+char*	rninstr _((char* big, char* bigend, char* little, char* lend));
+int	runops _((void));
+#ifndef safemalloc
+void	safefree _((char* where));
+char*	safemalloc _((MEM_SIZE size));
+#ifndef MSDOS
+char*	saferealloc _((char* where, MEM_SIZE size));
+#else
+char*	saferealloc _((char* where, unsigned long size));
+#endif
+#endif
+#ifdef LEAKTEST
+void	safexfree _((char* where));
+char*	safexmalloc _((I32 x, MEM_SIZE size));
+char*	safexrealloc _((char* where, MEM_SIZE size));
+#endif
+#ifndef HAS_RENAME
+I32	same_dirent _((char* a, char* b));
+#endif
+char*	savepv _((char* sv));
+char*	savepvn _((char* sv, I32 len));
+void	savestack_grow _((void));
+void	save_aptr _((AV** aptr));
+AV*	save_ary _((GV* gv));
+void	save_clearsv _((SV** svp));
+void	save_delete _((HV* hv, char* key, I32 klen));
+#ifndef titan  /* TitanOS cc can't handle this */
+void	save_destructor _((void (*f)(void*), void* p));
+#endif /* titan */
+void	save_freesv _((SV* sv));
+void	save_freeop _((OP* op));
+void	save_freepv _((char* pv));
+HV*	save_hash _((GV* gv));
+void	save_hptr _((HV** hptr));
+void	save_I32 _((I32* intp));
+void	save_int _((int* intp));
+void	save_item _((SV* item));
+void	save_list _((SV** sarg, I32 maxsarg));
+void	save_long _((long *longp));
+void	save_nogv _((GV* gv));
+SV*	save_scalar _((GV* gv));
+void	save_pptr _((char **pptr));
+void	save_sptr _((SV** sptr));
+SV*	save_svref _((SV** sptr));
+OP*	sawparens _((OP* o));
+OP*	scalar _((OP* o));
+OP*	scalarkids _((OP* op));
+OP*	scalarseq _((OP* o));
+OP*	scalarvoid _((OP* op));
+unsigned long	scan_hex _((char* start, I32 len, I32* retlen));
+char*	scan_num _((char* s));
+unsigned long	scan_oct _((char* start, I32 len, I32* retlen));
+OP*	scope _((OP* o));
+char*	screaminstr _((SV* bigsv, SV* littlesv));
+#ifndef VMS
+I32	setenv_getix _((char* nam));
+#endif
+void	setdefout _((GV *gv));
+Signal_t sighandler _((int sig));
+SV**	stack_grow _((SV** sp, SV**p, int n));
+int	start_subparse _((void));
+bool	sv_2bool _((SV* sv));
+CV*	sv_2cv _((SV* sv, HV** st, GV** gvp, I32 lref));
+IO*	sv_2io _((SV* sv));
+IV	sv_2iv _((SV* sv));
+SV*	sv_2mortal _((SV* sv));
+double	sv_2nv _((SV* sv));
+char*	sv_2pv _((SV* sv, STRLEN* lp));
+void	sv_add_arena _((char* ptr, U32 size, U32 flags));
+int	sv_backoff _((SV* sv));
+SV*	sv_bless _((SV* sv, HV* stash));
+void	sv_catpv _((SV* sv, char* ptr));
+void	sv_catpvn _((SV* sv, char* ptr, STRLEN len));
+void	sv_catsv _((SV* dsv, SV* ssv));
+void	sv_chop _((SV* sv, char* ptr));
+void	sv_clean_all _((void));
+void	sv_clean_objs _((void));
+void	sv_clear _((SV* sv));
+I32	sv_cmp _((SV* sv1, SV* sv2));
+void	sv_dec _((SV* sv));
+void	sv_dump _((SV* sv));
+I32	sv_eq _((SV* sv1, SV* sv2));
+void	sv_free _((SV* sv));
+void	sv_free_arenas _((void));
+char*	sv_gets _((SV* sv, FILE* fp, I32 append));
+#ifndef DOSISH
+char*	sv_grow _((SV* sv, I32 newlen));
+#else
+char*	sv_grow _((SV* sv, unsigned long newlen));
+#endif
+void	sv_inc _((SV* sv));
+void	sv_insert _((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen));
+int	sv_isa _((SV* sv, char* name));
+int	sv_isobject _((SV* sv));
+STRLEN	sv_len _((SV* sv));
+void	sv_magic _((SV* sv, SV* obj, int how, char* name, I32 namlen));
+SV*	sv_mortalcopy _((SV* oldsv));
+SV*	sv_newmortal _((void));
+SV*	sv_newref _((SV* sv));
+char *	sv_peek _((SV* sv));
+char *	sv_pvn_force _((SV* sv, STRLEN* lp));
+char*	sv_reftype _((SV* sv, int ob));
+void	sv_replace _((SV* sv, SV* nsv));
+void	sv_report_used _((void));
+void	sv_reset _((char* s, HV* stash));
+void	sv_setiv _((SV* sv, IV num));
+void	sv_setnv _((SV* sv, double num));
+SV*	sv_setref_iv _((SV *rv, char *classname, IV iv));
+SV*	sv_setref_nv _((SV *rv, char *classname, double nv));
+SV*	sv_setref_pv _((SV *rv, char *classname, void* pv));
+SV*	sv_setref_pvn _((SV *rv, char *classname, char* pv, I32 n));
+void	sv_setpv _((SV* sv, char* ptr));
+void	sv_setpvn _((SV* sv, char* ptr, STRLEN len));
+void	sv_setsv _((SV* dsv, SV* ssv));
+int	sv_unmagic _((SV* sv, int type));
+void	sv_unref _((SV* sv));
+bool	sv_upgrade _((SV* sv, U32 mt));
+void	sv_usepvn _((SV* sv, char* ptr, STRLEN len));
+void	taint_env _((void));
+void	taint_not _((char *s));
+void	taint_proper _((char* f, char* s));
+#ifdef UNLINK_ALL_VERSIONS
+I32	unlnk _((char* f));
+#endif
+void	utilize _((int aver, I32 floor, OP* id, OP* arg));
+I32	wait4pid _((int pid, int* statusp, int flags));
+void	warn _((char* pat,...)) __attribute__((format(printf,1,2)));
+void	watch _((char **addr));
+I32	whichsig _((char* sig));
+int	yyerror _((char* s));
+int	yylex _((void));
+int	yyparse _((void));
+int	yywarn _((char* s));
diff --git a/gnu/usr.bin/perl/regcomp.c b/gnu/usr.bin/perl/regcomp.c
new file mode 100644
index 00000000000..d120eb7bdfc
--- /dev/null
+++ b/gnu/usr.bin/perl/regcomp.c
@@ -0,0 +1,1653 @@
+/*    regcomp.c
+ */
+
+/*
+ * "A fair jaw-cracker dwarf-language must be."  --Samwise Gamgee
+ */
+
+/* NOTE: this is derived from Henry Spencer's regexp code, and should not
+ * confused with the original package (see point 3 below).  Thanks, Henry!
+ */
+
+/* Additional note: this code is very heavily munged from Henry's version
+ * in places.  In some spots I've traded clarity for efficiency, so don't
+ * blame Henry for some of the lack of readability.
+ */
+
+/* The names of the functions have been changed from regcomp and
+ * regexec to  pregcomp and pregexec in order to avoid conflicts
+ * with the POSIX routines of the same names.
+*/
+
+/*SUPPRESS 112*/
+/*
+ * pregcomp and pregexec -- regsub and regerror are not used in perl
+ *
+ *	Copyright (c) 1986 by University of Toronto.
+ *	Written by Henry Spencer.  Not derived from licensed software.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. 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.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ *
+ ****    Alterations to Henry's code are...
+ ****
+ ****    Copyright (c) 1991-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.
+
+ *
+ * Beware that some of this code is subtly aware of the way operator
+ * precedence is structured in regular expressions.  Serious changes in
+ * regular-expression syntax might require a total rethink.
+ */
+#include "EXTERN.h"
+#include "perl.h"
+#include "INTERN.h"
+#include "regcomp.h"
+
+#ifdef MSDOS
+# if defined(BUGGY_MSC6)
+ /* MSC 6.00A breaks on op/regexp.t test 85 unless we turn this off */
+ # pragma optimize("a",off)
+ /* But MSC 6.00A is happy with 'w', for aliases only across function calls*/
+ # pragma optimize("w",on )
+# endif /* BUGGY_MSC6 */
+#endif /* MSDOS */
+
+#ifndef STATIC
+#define	STATIC	static
+#endif
+
+#define	ISMULT1(c)	((c) == '*' || (c) == '+' || (c) == '?')
+#define	ISMULT2(s)	((*s) == '*' || (*s) == '+' || (*s) == '?' || \
+	((*s) == '{' && regcurly(s)))
+#ifdef atarist
+#define	PERL_META	"^$.[()|?+*\\"
+#else
+#define	META	"^$.[()|?+*\\"
+#endif
+
+#ifdef SPSTART
+#undef SPSTART		/* dratted cpp namespace... */
+#endif
+/*
+ * Flags to be passed up and down.
+ */
+#define	WORST		0	/* Worst case. */
+#define	HASWIDTH	0x1	/* Known never to match null string. */
+#define	SIMPLE		0x2	/* Simple enough to be STAR/PLUS operand. */
+#define	SPSTART		0x4	/* Starts with * or +. */
+#define TRYAGAIN	0x8	/* Weeded out a declaration. */
+
+/*
+ * Forward declarations for pregcomp()'s friends.
+ */
+
+static char *reg _((I32, I32 *));
+static char *reganode _((char, unsigned short));
+static char *regatom _((I32 *));
+static char *regbranch _((I32 *));
+static void regc _((char));
+static char *regclass _((void));
+STATIC I32 regcurly _((char *));
+static char *regnode _((char));
+static char *regpiece _((I32 *));
+static void reginsert _((char, char *));
+static void regoptail _((char *, char *));
+static void regset _((char *, I32, I32));
+static void regtail _((char *, char *));
+static char* nextchar _((void));
+
+/*
+ - pregcomp - compile a regular expression into internal code
+ *
+ * We can't allocate space until we know how big the compiled form will be,
+ * but we can't compile it (and thus know how big it is) until we've got a
+ * place to put the code.  So we cheat:  we compile it twice, once with code
+ * generation turned off and size counting turned on, and once "for real".
+ * This also means that we don't allocate space until we are sure that the
+ * thing really will compile successfully, and we never have to move the
+ * code and thus invalidate pointers into it.  (Note that it has to be in
+ * one piece because free() must be able to free it all.) [NB: not true in perl]
+ *
+ * Beware that the optimization-preparation code in here knows about some
+ * of the structure of the compiled regexp.  [I'll say.]
+ */
+regexp *
+pregcomp(exp,xend,pm)
+char* exp;
+char* xend;
+PMOP* pm;
+{
+    I32 fold = pm->op_pmflags & PMf_FOLD;
+    register regexp *r;
+    register char *scan;
+    register SV *longish;
+    SV *longest;
+    register I32 len;
+    register char *first;
+    I32 flags;
+    I32 backish;
+    I32 backest;
+    I32 curback;
+    I32 minlen = 0;
+    I32 sawplus = 0;
+    I32 sawopen = 0;
+
+    if (exp == NULL)
+	croak("NULL regexp argument");
+
+    /* First pass: determine size, legality. */
+    regflags = pm->op_pmflags;
+    regparse = exp;
+    regxend = xend;
+    regprecomp = savepvn(exp,xend-exp);
+    regnaughty = 0;
+    regsawback = 0;
+    regnpar = 1;
+    regsize = 0L;
+    regcode = &regdummy;
+    regc((char)MAGIC);
+    if (reg(0, &flags) == NULL) {
+	Safefree(regprecomp);
+	regprecomp = Nullch;
+	return(NULL);
+    }
+
+    /* Small enough for pointer-storage convention? */
+    if (regsize >= 32767L)		/* Probably could be 65535L. */
+	FAIL("regexp too big");
+
+    /* Allocate space. */
+    Newc(1001, r, sizeof(regexp) + (unsigned)regsize, char, regexp);
+    if (r == NULL)
+	FAIL("regexp out of space");
+
+    /* Second pass: emit code. */
+    r->prelen = xend-exp;
+    r->precomp = regprecomp;
+    r->subbeg = r->subbase = NULL;
+    regnaughty = 0;
+    regparse = exp;
+    regnpar = 1;
+    regcode = r->program;
+    regc((char)MAGIC);
+    if (reg(0, &flags) == NULL)
+	return(NULL);
+
+    /* Dig out information for optimizations. */
+    pm->op_pmflags = regflags;
+    fold = pm->op_pmflags & PMf_FOLD;
+    r->regstart = Nullsv;	/* Worst-case defaults. */
+    r->reganch = 0;
+    r->regmust = Nullsv;
+    r->regback = -1;
+    r->regstclass = Nullch;
+    r->naughty = regnaughty >= 10;	/* Probably an expensive pattern. */
+    scan = r->program+1;			/* First BRANCH. */
+    if (OP(regnext(scan)) == END) {/* Only one top-level choice. */
+	scan = NEXTOPER(scan);
+
+	first = scan;
+	while ((OP(first) == OPEN && (sawopen = 1)) ||
+	    (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
+	    (OP(first) == PLUS) ||
+	    (OP(first) == MINMOD) ||
+	    (regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) {
+		if (OP(first) == PLUS)
+		    sawplus = 1;
+		else
+		    first += regarglen[(U8)OP(first)];
+		first = NEXTOPER(first);
+	}
+
+	/* Starting-point info. */
+      again:
+	if (OP(first) == EXACTLY) {
+	    r->regstart = newSVpv(OPERAND(first)+1,*OPERAND(first));
+	    if (SvCUR(r->regstart) > !(sawstudy|fold))
+		fbm_compile(r->regstart,fold);
+	    else
+		sv_upgrade(r->regstart, SVt_PVBM);
+	}
+	else if (strchr(simple+2,OP(first)))
+	    r->regstclass = first;
+	else if (OP(first) == BOUND || OP(first) == NBOUND)
+	    r->regstclass = first;
+	else if (regkind[(U8)OP(first)] == BOL) {
+	    r->reganch = ROPT_ANCH;
+	    first = NEXTOPER(first);
+	  	goto again;
+	}
+	else if ((OP(first) == STAR &&
+	    regkind[(U8)OP(NEXTOPER(first))] == ANY) &&
+	    !(r->reganch & ROPT_ANCH) )
+	{
+	    /* turn .* into ^.* with an implied $*=1 */
+	    r->reganch = ROPT_ANCH | ROPT_IMPLICIT;
+	    first = NEXTOPER(first);
+	  	goto again;
+	}
+	if (sawplus && (!sawopen || !regsawback))
+	    r->reganch |= ROPT_SKIP;	/* x+ must match 1st of run */
+
+	DEBUG_r(fprintf(stderr,"first %d next %d offset %d\n",
+	   OP(first), OP(NEXTOPER(first)), first - scan));
+	/*
+	* If there's something expensive in the r.e., find the
+	* longest literal string that must appear and make it the
+	* regmust.  Resolve ties in favor of later strings, since
+	* the regstart check works with the beginning of the r.e.
+	* and avoiding duplication strengthens checking.  Not a
+	* strong reason, but sufficient in the absence of others.
+	* [Now we resolve ties in favor of the earlier string if
+	* it happens that curback has been invalidated, since the
+	* earlier string may buy us something the later one won't.]
+	*/
+	longish = newSVpv("",0);
+	longest = newSVpv("",0);
+	len = 0;
+	minlen = 0;
+	curback = 0;
+	backish = 0;
+	backest = 0;
+	while (OP(scan) != END) {
+	    if (OP(scan) == BRANCH) {
+		if (OP(regnext(scan)) == BRANCH) {
+		    curback = -30000;
+		    while (OP(scan) == BRANCH)
+			scan = regnext(scan);
+		}
+		else	/* single branch is ok */
+		    scan = NEXTOPER(scan);
+		continue;
+	    }
+	    if (OP(scan) == UNLESSM) {
+		curback = -30000;
+		scan = regnext(scan);
+		continue;
+	    }
+	    if (OP(scan) == EXACTLY) {
+		char *t;
+
+		first = scan;
+		while (OP(t = regnext(scan)) == CLOSE)
+		    scan = t;
+		minlen += *OPERAND(first);
+		if (curback - backish == len) {
+		    sv_catpvn(longish, OPERAND(first)+1,
+			*OPERAND(first));
+		    len += *OPERAND(first);
+		    curback += *OPERAND(first);
+		    first = regnext(scan);
+		}
+		else if (*OPERAND(first) >= len + (curback >= 0)) {
+		    len = *OPERAND(first);
+		    sv_setpvn(longish, OPERAND(first)+1,len);
+		    backish = curback;
+		    curback += len;
+		    first = regnext(scan);
+		}
+		else
+		    curback += *OPERAND(first);
+	    }
+	    else if (strchr(varies,OP(scan))) {
+		curback = -30000;
+		len = 0;
+		if (SvCUR(longish) > SvCUR(longest)) {
+		    sv_setsv(longest,longish);
+		    backest = backish;
+		}
+		sv_setpvn(longish,"",0);
+		if (OP(scan) == PLUS && strchr(simple,OP(NEXTOPER(scan))))
+		    minlen++;
+		else if (regkind[(U8)OP(scan)] == CURLY &&
+		  strchr(simple,OP(NEXTOPER(scan)+4)))
+		    minlen += ARG1(scan);
+	    }
+	    else if (strchr(simple,OP(scan))) {
+		curback++;
+		minlen++;
+		len = 0;
+		if (SvCUR(longish) > SvCUR(longest)) {
+		    sv_setsv(longest,longish);
+		    backest = backish;
+		}
+		sv_setpvn(longish,"",0);
+	    }
+	    scan = regnext(scan);
+	}
+
+	/* Prefer earlier on tie, unless we can tail match latter */
+
+	if (SvCUR(longish) + (regkind[(U8)OP(first)] == EOL) >
+		SvCUR(longest))
+	{
+	    sv_setsv(longest,longish);
+	    backest = backish;
+	}
+	else
+	    sv_setpvn(longish,"",0);
+	if (SvCUR(longest)
+	    &&
+	    (!r->regstart
+	     ||
+	     !fbm_instr((unsigned char*) SvPVX(r->regstart),
+		  (unsigned char *) SvPVX(r->regstart)
+		    + SvCUR(r->regstart),
+		  longest)
+	    )
+	   )
+	{
+	    r->regmust = longest;
+	    if (backest < 0)
+		backest = -1;
+	    r->regback = backest;
+	    if (SvCUR(longest) > !(sawstudy || fold ||
+			regkind[(U8)OP(first)]==EOL))
+		fbm_compile(r->regmust,fold);
+	    (void)SvUPGRADE(r->regmust, SVt_PVBM);
+	    BmUSEFUL(r->regmust) = 100;
+	    if (regkind[(U8)OP(first)] == EOL && SvCUR(longish))
+		SvTAIL_on(r->regmust);
+	}
+	else {
+	    SvREFCNT_dec(longest);
+	    longest = Nullsv;
+	}
+	SvREFCNT_dec(longish);
+    }
+
+    r->do_folding = fold;
+    r->nparens = regnpar - 1;
+    r->minlen = minlen;
+    Newz(1002, r->startp, regnpar, char*);
+    Newz(1002, r->endp, regnpar, char*);
+    DEBUG_r(regdump(r));
+    return(r);
+}
+
+/*
+ - reg - regular expression, i.e. main body or parenthesized thing
+ *
+ * Caller must absorb opening parenthesis.
+ *
+ * Combining parenthesis handling with the base level of regular expression
+ * is a trifle forced, but the need to tie the tails of the branches to what
+ * follows makes it hard to avoid.
+ */
+static char *
+reg(paren, flagp)
+I32 paren;			/* Parenthesized? */
+I32 *flagp;
+{
+    register char *ret;
+    register char *br;
+    register char *ender = 0;
+    register I32 parno = 0;
+    I32 flags;
+
+    *flagp = HASWIDTH;	/* Tentatively. */
+
+    /* Make an OPEN node, if parenthesized. */
+    if (paren) {
+	if (*regparse == '?') {
+	    regparse++;
+	    paren = *regparse++;
+	    ret = NULL;
+	    switch (paren) {
+	    case ':':
+	    case '=':
+	    case '!':
+		break;
+	    case '$':
+	    case '@':
+		croak("Sequence (?%c...) not implemented", paren);
+		break;
+	    case '#':
+		while (*regparse && *regparse != ')')
+		    regparse++;
+		if (*regparse != ')')
+		    croak("Sequence (?#... not terminated");
+		nextchar();
+		*flagp = TRYAGAIN;
+		return NULL;
+	    default:
+		--regparse;
+		while (*regparse && strchr("iogmsx", *regparse))
+		    pmflag(&regflags, *regparse++);
+		if (*regparse != ')')
+		    croak("Sequence (?%c...) not recognized", *regparse);
+		nextchar();
+		*flagp = TRYAGAIN;
+		return NULL;
+	    }
+	}
+	else {
+	    parno = regnpar;
+	    regnpar++;
+	    ret = reganode(OPEN, parno);
+	}
+    } else
+	ret = NULL;
+
+    /* Pick up the branches, linking them together. */
+    br = regbranch(&flags);
+    if (br == NULL)
+	return(NULL);
+    if (ret != NULL)
+	regtail(ret, br);	/* OPEN -> first. */
+    else
+	ret = br;
+    if (!(flags&HASWIDTH))
+	*flagp &= ~HASWIDTH;
+    *flagp |= flags&SPSTART;
+    while (*regparse == '|') {
+	nextchar();
+	br = regbranch(&flags);
+	if (br == NULL)
+	    return(NULL);
+	regtail(ret, br);	/* BRANCH -> BRANCH. */
+	if (!(flags&HASWIDTH))
+	    *flagp &= ~HASWIDTH;
+	*flagp |= flags&SPSTART;
+    }
+
+    /* Make a closing node, and hook it on the end. */
+    switch (paren) {
+    case ':':
+	ender = regnode(NOTHING);
+	break;
+    case 1:
+	ender = reganode(CLOSE, parno);
+	break;
+    case '=':
+    case '!':
+	ender = regnode(SUCCEED);
+	*flagp &= ~HASWIDTH;
+	break;
+    case 0:
+	ender = regnode(END);
+	break;
+    }
+    regtail(ret, ender);
+
+    /* Hook the tails of the branches to the closing node. */
+    for (br = ret; br != NULL; br = regnext(br))
+	regoptail(br, ender);
+
+    if (paren == '=') {
+	reginsert(IFMATCH,ret);
+	regtail(ret, regnode(NOTHING));
+    }
+    else if (paren == '!') {
+	reginsert(UNLESSM,ret);
+	regtail(ret, regnode(NOTHING));
+    }
+
+    /* Check for proper termination. */
+    if (paren && (regparse >= regxend || *nextchar() != ')')) {
+	FAIL("unmatched () in regexp");
+    } else if (!paren && regparse < regxend) {
+	if (*regparse == ')') {
+	    FAIL("unmatched () in regexp");
+	} else
+	    FAIL("junk on end of regexp");	/* "Can't happen". */
+	/* NOTREACHED */
+    }
+
+    return(ret);
+}
+
+/*
+ - regbranch - one alternative of an | operator
+ *
+ * Implements the concatenation operator.
+ */
+static char *
+regbranch(flagp)
+I32 *flagp;
+{
+    register char *ret;
+    register char *chain;
+    register char *latest;
+    I32 flags = 0;
+
+    *flagp = WORST;		/* Tentatively. */
+
+    ret = regnode(BRANCH);
+    chain = NULL;
+    regparse--;
+    nextchar();
+    while (regparse < regxend && *regparse != '|' && *regparse != ')') {
+	flags &= ~TRYAGAIN;
+	latest = regpiece(&flags);
+	if (latest == NULL) {
+	    if (flags & TRYAGAIN)
+		continue;
+	    return(NULL);
+	}
+	*flagp |= flags&HASWIDTH;
+	if (chain == NULL)	/* First piece. */
+	    *flagp |= flags&SPSTART;
+	else {
+	    regnaughty++;
+	    regtail(chain, latest);
+	}
+	chain = latest;
+    }
+    if (chain == NULL)	/* Loop ran zero times. */
+	(void) regnode(NOTHING);
+
+    return(ret);
+}
+
+/*
+ - regpiece - something followed by possible [*+?]
+ *
+ * Note that the branching code sequences used for ? and the general cases
+ * of * and + are somewhat optimized:  they use the same NOTHING node as
+ * both the endmarker for their branch list and the body of the last branch.
+ * It might seem that this node could be dispensed with entirely, but the
+ * endmarker role is not redundant.
+ */
+static char *
+regpiece(flagp)
+I32 *flagp;
+{
+    register char *ret;
+    register char op;
+    register char *next;
+    I32 flags;
+    char *origparse = regparse;
+    char *maxpos;
+    I32 min;
+    I32 max = 32767;
+
+    ret = regatom(&flags);
+    if (ret == NULL) {
+	if (flags & TRYAGAIN)
+	    *flagp |= TRYAGAIN;
+	return(NULL);
+    }
+
+    op = *regparse;
+    if (op == '(' && regparse[1] == '?' && regparse[2] == '#') {
+	while (op && op != ')')
+	    op = *++regparse;
+	if (op) {
+	    nextchar();
+	    op = *regparse;
+	}
+    }
+
+    if (op == '{' && regcurly(regparse)) {
+	next = regparse + 1;
+	maxpos = Nullch;
+	while (isDIGIT(*next) || *next == ',') {
+	    if (*next == ',') {
+		if (maxpos)
+		    break;
+		else
+		    maxpos = next;
+	    }
+	    next++;
+	}
+	if (*next == '}') {		/* got one */
+	    if (!maxpos)
+		maxpos = next;
+	    regparse++;
+	    min = atoi(regparse);
+	    if (*maxpos == ',')
+		maxpos++;
+	    else
+		maxpos = regparse;
+	    max = atoi(maxpos);
+	    if (!max && *maxpos != '0')
+		max = 32767;		/* meaning "infinity" */
+	    regparse = next;
+	    nextchar();
+
+	do_curly:
+	    if ((flags&SIMPLE)) {
+		regnaughty += 2 + regnaughty / 2;
+		reginsert(CURLY, ret);
+	    }
+	    else {
+		regnaughty += 4 + regnaughty;	/* compound interest */
+		regtail(ret, regnode(WHILEM));
+		reginsert(CURLYX,ret);
+		regtail(ret, regnode(NOTHING));
+	    }
+
+	    if (min > 0)
+		*flagp = (WORST|HASWIDTH);
+	    if (max && max < min)
+		croak("Can't do {n,m} with n > m");
+	    if (regcode != &regdummy) {
+#ifdef REGALIGN
+		*(unsigned short *)(ret+3) = min;
+		*(unsigned short *)(ret+5) = max;
+#else
+		ret[3] = min >> 8; ret[4] = min & 0377;
+		ret[5] = max  >> 8; ret[6] = max  & 0377;
+#endif
+	    }
+
+	    goto nest_check;
+	}
+    }
+
+    if (!ISMULT1(op)) {
+	*flagp = flags;
+	return(ret);
+    }
+    nextchar();
+
+    *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
+
+    if (op == '*' && (flags&SIMPLE)) {
+	reginsert(STAR, ret);
+	regnaughty += 4;
+    }
+    else if (op == '*') {
+	min = 0;
+	goto do_curly;
+    } else if (op == '+' && (flags&SIMPLE)) {
+	reginsert(PLUS, ret);
+	regnaughty += 3;
+    }
+    else if (op == '+') {
+	min = 1;
+	goto do_curly;
+    } else if (op == '?') {
+	min = 0; max = 1;
+	goto do_curly;
+    }
+  nest_check:
+    if (dowarn && regcode != &regdummy && !(flags&HASWIDTH) && max > 10000) {
+	warn("%.*s matches null string many times",
+	    regparse - origparse, origparse);
+    }
+
+    if (*regparse == '?') {
+	nextchar();
+	reginsert(MINMOD, ret);
+#ifdef REGALIGN
+	regtail(ret, ret + 4);
+#else
+	regtail(ret, ret + 3);
+#endif
+    }
+    if (ISMULT2(regparse))
+	FAIL("nested *?+ in regexp");
+
+    return(ret);
+}
+
+/*
+ - regatom - the lowest level
+ *
+ * Optimization:  gobbles an entire sequence of ordinary characters so that
+ * it can turn them into a single node, which is smaller to store and
+ * faster to run.  Backslashed characters are exceptions, each becoming a
+ * separate node; the code is simpler that way and it's not worth fixing.
+ *
+ * [Yes, it is worth fixing, some scripts can run twice the speed.]
+ */
+static char *
+regatom(flagp)
+I32 *flagp;
+{
+    register char *ret = 0;
+    I32 flags;
+
+    *flagp = WORST;		/* Tentatively. */
+
+tryagain:
+    switch (*regparse) {
+    case '^':
+	nextchar();
+	if (regflags & PMf_MULTILINE)
+	    ret = regnode(MBOL);
+	else if (regflags & PMf_SINGLELINE)
+	    ret = regnode(SBOL);
+	else
+	    ret = regnode(BOL);
+	break;
+    case '$':
+	nextchar();
+	if (regflags & PMf_MULTILINE)
+	    ret = regnode(MEOL);
+	else if (regflags & PMf_SINGLELINE)
+	    ret = regnode(SEOL);
+	else
+	    ret = regnode(EOL);
+	break;
+    case '.':
+	nextchar();
+	if (regflags & PMf_SINGLELINE)
+	    ret = regnode(SANY);
+	else
+	    ret = regnode(ANY);
+	regnaughty++;
+	*flagp |= HASWIDTH|SIMPLE;
+	break;
+    case '[':
+	regparse++;
+	ret = regclass();
+	*flagp |= HASWIDTH|SIMPLE;
+	break;
+    case '(':
+	nextchar();
+	ret = reg(1, &flags);
+	if (ret == NULL) {
+		if (flags & TRYAGAIN)
+		    goto tryagain;
+		return(NULL);
+	}
+	*flagp |= flags&(HASWIDTH|SPSTART);
+	break;
+    case '|':
+    case ')':
+	if (flags & TRYAGAIN) {
+	    *flagp |= TRYAGAIN;
+	    return NULL;
+	}
+	croak("internal urp in regexp at /%s/", regparse);
+				/* Supposed to be caught earlier. */
+	break;
+    case '?':
+    case '+':
+    case '*':
+	FAIL("?+* follows nothing in regexp");
+	break;
+    case '\\':
+	switch (*++regparse) {
+	case 'A':
+	    ret = regnode(SBOL);
+	    *flagp |= SIMPLE;
+	    nextchar();
+	    break;
+	case 'G':
+	    ret = regnode(GBOL);
+	    *flagp |= SIMPLE;
+	    nextchar();
+	    break;
+	case 'Z':
+	    ret = regnode(SEOL);
+	    *flagp |= SIMPLE;
+	    nextchar();
+	    break;
+	case 'w':
+	    ret = regnode(ALNUM);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'W':
+	    ret = regnode(NALNUM);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'b':
+	    ret = regnode(BOUND);
+	    *flagp |= SIMPLE;
+	    nextchar();
+	    break;
+	case 'B':
+	    ret = regnode(NBOUND);
+	    *flagp |= SIMPLE;
+	    nextchar();
+	    break;
+	case 's':
+	    ret = regnode(SPACE);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'S':
+	    ret = regnode(NSPACE);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'd':
+	    ret = regnode(DIGIT);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'D':
+	    ret = regnode(NDIGIT);
+	    *flagp |= HASWIDTH|SIMPLE;
+	    nextchar();
+	    break;
+	case 'n':
+	case 'r':
+	case 't':
+	case 'f':
+	case 'e':
+	case 'a':
+	case 'x':
+	case 'c':
+	case '0':
+	    goto defchar;
+	case '1': case '2': case '3': case '4':
+	case '5': case '6': case '7': case '8': case '9':
+	    {
+		I32 num = atoi(regparse);
+
+		if (num > 9 && num >= regnpar)
+		    goto defchar;
+		else {
+		    regsawback = 1;
+		    ret = reganode(REF, num);
+		    *flagp |= HASWIDTH;
+		    while (isDIGIT(*regparse))
+			regparse++;
+		    regparse--;
+		    nextchar();
+		}
+	    }
+	    break;
+	case '\0':
+	    if (regparse >= regxend)
+		FAIL("trailing \\ in regexp");
+	    /* FALL THROUGH */
+	default:
+	    goto defchar;
+	}
+	break;
+
+    case '#':
+	if (regflags & PMf_EXTENDED) {
+	    while (regparse < regxend && *regparse != '\n') regparse++;
+	    if (regparse < regxend)
+		goto tryagain;
+	}
+	/* FALL THROUGH */
+
+    default: {
+	    register I32 len;
+	    register char ender;
+	    register char *p;
+	    char *oldp;
+	    I32 numlen;
+
+	    regparse++;
+
+	defchar:
+	    ret = regnode(EXACTLY);
+	    regc(0);		/* save spot for len */
+	    for (len = 0, p = regparse - 1;
+	      len < 127 && p < regxend;
+	      len++)
+	    {
+		oldp = p;
+		switch (*p) {
+		case '^':
+		case '$':
+		case '.':
+		case '[':
+		case '(':
+		case ')':
+		case '|':
+		    goto loopdone;
+		case '\\':
+		    switch (*++p) {
+		    case 'A':
+		    case 'G':
+		    case 'Z':
+		    case 'w':
+		    case 'W':
+		    case 'b':
+		    case 'B':
+		    case 's':
+		    case 'S':
+		    case 'd':
+		    case 'D':
+			--p;
+			goto loopdone;
+		    case 'n':
+			ender = '\n';
+			p++;
+			break;
+		    case 'r':
+			ender = '\r';
+			p++;
+			break;
+		    case 't':
+			ender = '\t';
+			p++;
+			break;
+		    case 'f':
+			ender = '\f';
+			p++;
+			break;
+		    case 'e':
+			ender = '\033';
+			p++;
+			break;
+		    case 'a':
+			ender = '\007';
+			p++;
+			break;
+		    case 'x':
+			ender = scan_hex(++p, 2, &numlen);
+			p += numlen;
+			break;
+		    case 'c':
+			p++;
+			ender = *p++;
+			if (isLOWER(ender))
+			    ender = toUPPER(ender);
+			ender ^= 64;
+			break;
+		    case '0': case '1': case '2': case '3':case '4':
+		    case '5': case '6': case '7': case '8':case '9':
+			if (*p == '0' ||
+			  (isDIGIT(p[1]) && atoi(p) >= regnpar) ) {
+			    ender = scan_oct(p, 3, &numlen);
+			    p += numlen;
+			}
+			else {
+			    --p;
+			    goto loopdone;
+			}
+			break;
+		    case '\0':
+			if (p >= regxend)
+			    FAIL("trailing \\ in regexp");
+			/* FALL THROUGH */
+		    default:
+			ender = *p++;
+			break;
+		    }
+		    break;
+		case '#':
+		    if (regflags & PMf_EXTENDED) {
+			while (p < regxend && *p != '\n') p++;
+		    }
+		    /* FALL THROUGH */
+		case ' ': case '\t': case '\n': case '\r': case '\f': case '\v':
+		    if (regflags & PMf_EXTENDED) {
+			p++;
+			len--;
+			continue;
+		    }
+		    /* FALL THROUGH */
+		default:
+		    ender = *p++;
+		    break;
+		}
+		if (regflags & PMf_FOLD && isUPPER(ender))
+		    ender = toLOWER(ender);
+		if (ISMULT2(p)) { /* Back off on ?+*. */
+		    if (len)
+			p = oldp;
+		    else {
+			len++;
+			regc(ender);
+		    }
+		    break;
+		}
+		regc(ender);
+	    }
+	loopdone:
+	    regparse = p - 1;
+	    nextchar();
+	    if (len < 0)
+		FAIL("internal disaster in regexp");
+	    if (len > 0)
+		*flagp |= HASWIDTH;
+	    if (len == 1)
+		*flagp |= SIMPLE;
+	    if (regcode != &regdummy)
+		*OPERAND(ret) = len;
+	    regc('\0');
+	}
+	break;
+    }
+
+    return(ret);
+}
+
+static void
+regset(bits,def,c)
+char *bits;
+I32 def;
+register I32 c;
+{
+    if (regcode == &regdummy)
+      return;
+    c &= 255;
+    if (def)
+	bits[c >> 3] &= ~(1 << (c & 7));
+    else
+	bits[c >> 3] |=  (1 << (c & 7));
+}
+
+static char *
+regclass()
+{
+    register char *bits;
+    register I32 class;
+    register I32 lastclass = 1234;
+    register I32 range = 0;
+    register char *ret;
+    register I32 def;
+    I32 numlen;
+
+    ret = regnode(ANYOF);
+    if (*regparse == '^') {	/* Complement of range. */
+	regnaughty++;
+	regparse++;
+	def = 0;
+    } else {
+	def = 255;
+    }
+    bits = regcode;
+    for (class = 0; class < 32; class++)
+      regc(def);
+    if (*regparse == ']' || *regparse == '-')
+	goto skipcond;		/* allow 1st char to be ] or - */
+    while (regparse < regxend && *regparse != ']') {
+       skipcond:
+	class = UCHARAT(regparse++);
+	if (class == '\\') {
+	    class = UCHARAT(regparse++);
+	    switch (class) {
+	    case 'w':
+		for (class = 0; class < 256; class++)
+		  if (isALNUM(class))
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 'W':
+		for (class = 0; class < 256; class++)
+		  if (!isALNUM(class))
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 's':
+		for (class = 0; class < 256; class++)
+		  if (isSPACE(class))
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 'S':
+		for (class = 0; class < 256; class++)
+		  if (!isSPACE(class))
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 'd':
+		for (class = '0'; class <= '9'; class++)
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 'D':
+		for (class = 0; class < '0'; class++)
+		    regset(bits,def,class);
+		for (class = '9' + 1; class < 256; class++)
+		    regset(bits,def,class);
+		lastclass = 1234;
+		continue;
+	    case 'n':
+		class = '\n';
+		break;
+	    case 'r':
+		class = '\r';
+		break;
+	    case 't':
+		class = '\t';
+		break;
+	    case 'f':
+		class = '\f';
+		break;
+	    case 'b':
+		class = '\b';
+		break;
+	    case 'e':
+		class = '\033';
+		break;
+	    case 'a':
+		class = '\007';
+		break;
+	    case 'x':
+		class = scan_hex(regparse, 2, &numlen);
+		regparse += numlen;
+		break;
+	    case 'c':
+		class = *regparse++;
+		if (isLOWER(class))
+		  class = toUPPER(class);
+		class ^= 64;
+		break;
+	    case '0': case '1': case '2': case '3': case '4':
+	    case '5': case '6': case '7': case '8': case '9':
+		class = scan_oct(--regparse, 3, &numlen);
+		regparse += numlen;
+		break;
+	    }
+	}
+	if (range) {
+	    if (lastclass > class)
+		FAIL("invalid [] range in regexp");
+	    range = 0;
+	}
+	else {
+	    lastclass = class;
+	    if (*regparse == '-' && regparse+1 < regxend &&
+	      regparse[1] != ']') {
+		regparse++;
+		range = 1;
+		continue;	/* do it next time */
+	    }
+	}
+	for ( ; lastclass <= class; lastclass++) {
+	    regset(bits,def,lastclass);
+	    if (regflags & PMf_FOLD && isUPPER(lastclass))
+		regset(bits,def,toLOWER(lastclass));
+	}
+	lastclass = class;
+    }
+    if (*regparse != ']')
+	FAIL("unmatched [] in regexp");
+    nextchar();
+    return ret;
+}
+
+static char*
+nextchar()
+{
+    char* retval = regparse++;
+
+    for (;;) {
+	if (*regparse == '(' && regparse[1] == '?' &&
+		regparse[2] == '#') {
+	    while (*regparse && *regparse != ')')
+		regparse++;
+	    regparse++;
+	    continue;
+	}
+	if (regflags & PMf_EXTENDED) {
+	    if (isSPACE(*regparse)) {
+		regparse++;
+		continue;
+	    }
+	    else if (*regparse == '#') {
+		while (*regparse && *regparse != '\n')
+		    regparse++;
+		regparse++;
+		continue;
+	    }
+	}
+	return retval;
+    }
+}
+
+/*
+- regnode - emit a node
+*/
+#ifdef CAN_PROTOTYPE
+static char *			/* Location. */
+regnode(char op)
+#else
+static char *			/* Location. */
+regnode(op)
+char op;
+#endif
+{
+    register char *ret;
+    register char *ptr;
+
+    ret = regcode;
+    if (ret == &regdummy) {
+#ifdef REGALIGN
+	if (!(regsize & 1))
+	    regsize++;
+#endif
+	regsize += 3;
+	return(ret);
+    }
+
+#ifdef REGALIGN
+#ifndef lint
+    if (!((long)ret & 1))
+      *ret++ = 127;
+#endif
+#endif
+    ptr = ret;
+    *ptr++ = op;
+    *ptr++ = '\0';		/* Null "next" pointer. */
+    *ptr++ = '\0';
+    regcode = ptr;
+
+    return(ret);
+}
+
+/*
+- reganode - emit a node with an argument
+*/
+#ifdef CAN_PROTOTYPE
+static char *			/* Location. */
+reganode(char op, unsigned short arg)
+#else
+static char *			/* Location. */
+reganode(op, arg)
+char op;
+unsigned short arg;
+#endif
+{
+    register char *ret;
+    register char *ptr;
+
+    ret = regcode;
+    if (ret == &regdummy) {
+#ifdef REGALIGN
+	if (!(regsize & 1))
+	    regsize++;
+#endif
+	regsize += 5;
+	return(ret);
+    }
+
+#ifdef REGALIGN
+#ifndef lint
+    if (!((long)ret & 1))
+      *ret++ = 127;
+#endif
+#endif
+    ptr = ret;
+    *ptr++ = op;
+    *ptr++ = '\0';		/* Null "next" pointer. */
+    *ptr++ = '\0';
+#ifdef REGALIGN
+    *(unsigned short *)(ret+3) = arg;
+#else
+    ret[3] = arg >> 8; ret[4] = arg & 0377;
+#endif
+    ptr += 2;
+    regcode = ptr;
+
+    return(ret);
+}
+
+/*
+- regc - emit (if appropriate) a byte of code
+*/
+#ifdef CAN_PROTOTYPE
+static void
+regc(char b)
+#else
+static void
+regc(b)
+char b;
+#endif
+{
+    if (regcode != &regdummy)
+	*regcode++ = b;
+    else
+	regsize++;
+}
+
+/*
+- reginsert - insert an operator in front of already-emitted operand
+*
+* Means relocating the operand.
+*/
+#ifdef CAN_PROTOTYPE
+static void
+reginsert(char op, char *opnd)
+#else
+static void
+reginsert(op, opnd)
+char op;
+char *opnd;
+#endif
+{
+    register char *src;
+    register char *dst;
+    register char *place;
+    register int offset = (regkind[(U8)op] == CURLY ? 4 : 0);
+
+    if (regcode == &regdummy) {
+#ifdef REGALIGN
+	regsize += 4 + offset;
+#else
+	regsize += 3 + offset;
+#endif
+	return;
+    }
+
+    src = regcode;
+#ifdef REGALIGN
+    regcode += 4 + offset;
+#else
+    regcode += 3 + offset;
+#endif
+    dst = regcode;
+    while (src > opnd)
+	*--dst = *--src;
+
+    place = opnd;		/* Op node, where operand used to be. */
+    *place++ = op;
+    *place++ = '\0';
+    *place++ = '\0';
+    while (offset-- > 0)
+	*place++ = '\0';
+#ifdef REGALIGN
+    *place++ = '\177';
+#endif
+}
+
+/*
+- regtail - set the next-pointer at the end of a node chain
+*/
+static void
+regtail(p, val)
+char *p;
+char *val;
+{
+    register char *scan;
+    register char *temp;
+    register I32 offset;
+
+    if (p == &regdummy)
+	return;
+
+    /* Find last node. */
+    scan = p;
+    for (;;) {
+	temp = regnext(scan);
+	if (temp == NULL)
+	    break;
+	scan = temp;
+    }
+
+#ifdef REGALIGN
+    offset = val - scan;
+#ifndef lint
+    *(short*)(scan+1) = offset;
+#else
+    offset = offset;
+#endif
+#else
+    if (OP(scan) == BACK)
+	offset = scan - val;
+    else
+	offset = val - scan;
+    *(scan+1) = (offset>>8)&0377;
+    *(scan+2) = offset&0377;
+#endif
+}
+
+/*
+- regoptail - regtail on operand of first argument; nop if operandless
+*/
+static void
+regoptail(p, val)
+char *p;
+char *val;
+{
+    /* "Operandless" and "op != BRANCH" are synonymous in practice. */
+    if (p == NULL || p == &regdummy || regkind[(U8)OP(p)] != BRANCH)
+	return;
+    regtail(NEXTOPER(p), val);
+}
+
+/*
+ - regcurly - a little FSA that accepts {\d+,?\d*}
+ */
+STATIC I32
+regcurly(s)
+register char *s;
+{
+    if (*s++ != '{')
+	return FALSE;
+    if (!isDIGIT(*s))
+	return FALSE;
+    while (isDIGIT(*s))
+	s++;
+    if (*s == ',')
+	s++;
+    while (isDIGIT(*s))
+	s++;
+    if (*s != '}')
+	return FALSE;
+    return TRUE;
+}
+
+#ifdef DEBUGGING
+
+/*
+ - regdump - dump a regexp onto stderr in vaguely comprehensible form
+ */
+void
+regdump(r)
+regexp *r;
+{
+    register char *s;
+    register char op = EXACTLY;	/* Arbitrary non-END op. */
+    register char *next;
+
+
+    s = r->program + 1;
+    while (op != END) {	/* While that wasn't END last time... */
+#ifdef REGALIGN
+	if (!((long)s & 1))
+	    s++;
+#endif
+	op = OP(s);
+	fprintf(stderr,"%2d%s", s-r->program, regprop(s));	/* Where, what. */
+	next = regnext(s);
+	s += regarglen[(U8)op];
+	if (next == NULL)		/* Next ptr. */
+	    fprintf(stderr,"(0)");
+	else 
+	    fprintf(stderr,"(%d)", (s-r->program)+(next-s));
+	s += 3;
+	if (op == ANYOF) {
+	    s += 32;
+	}
+	if (op == EXACTLY) {
+	    /* Literal string, where present. */
+	    s++;
+	    (void)putc(' ', stderr);
+	    (void)putc('<', stderr);
+	    while (*s != '\0') {
+		(void)putc(*s, stderr);
+		s++;
+	    }
+	    (void)putc('>', stderr);
+	    s++;
+	}
+	(void)putc('\n', stderr);
+    }
+
+    /* Header fields of interest. */
+    if (r->regstart)
+	fprintf(stderr,"start `%s' ", SvPVX(r->regstart));
+    if (r->regstclass)
+	fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
+    if (r->reganch & ROPT_ANCH)
+	fprintf(stderr,"anchored ");
+    if (r->reganch & ROPT_SKIP)
+	fprintf(stderr,"plus ");
+    if (r->reganch & ROPT_IMPLICIT)
+	fprintf(stderr,"implicit ");
+    if (r->regmust != NULL)
+	fprintf(stderr,"must have \"%s\" back %ld ", SvPVX(r->regmust),
+	 (long) r->regback);
+    fprintf(stderr, "minlen %ld ", (long) r->minlen);
+    fprintf(stderr,"\n");
+}
+
+/*
+- regprop - printable representation of opcode
+*/
+char *
+regprop(op)
+char *op;
+{
+    register char *p = 0;
+
+    (void) strcpy(buf, ":");
+
+    switch (OP(op)) {
+    case BOL:
+	p = "BOL";
+	break;
+    case MBOL:
+	p = "MBOL";
+	break;
+    case SBOL:
+	p = "SBOL";
+	break;
+    case EOL:
+	p = "EOL";
+	break;
+    case MEOL:
+	p = "MEOL";
+	break;
+    case SEOL:
+	p = "SEOL";
+	break;
+    case ANY:
+	p = "ANY";
+	break;
+    case SANY:
+	p = "SANY";
+	break;
+    case ANYOF:
+	p = "ANYOF";
+	break;
+    case BRANCH:
+	p = "BRANCH";
+	break;
+    case EXACTLY:
+	p = "EXACTLY";
+	break;
+    case NOTHING:
+	p = "NOTHING";
+	break;
+    case BACK:
+	p = "BACK";
+	break;
+    case END:
+	p = "END";
+	break;
+    case ALNUM:
+	p = "ALNUM";
+	break;
+    case NALNUM:
+	p = "NALNUM";
+	break;
+    case BOUND:
+	p = "BOUND";
+	break;
+    case NBOUND:
+	p = "NBOUND";
+	break;
+    case SPACE:
+	p = "SPACE";
+	break;
+    case NSPACE:
+	p = "NSPACE";
+	break;
+    case DIGIT:
+	p = "DIGIT";
+	break;
+    case NDIGIT:
+	p = "NDIGIT";
+	break;
+    case CURLY:
+	(void)sprintf(buf+strlen(buf), "CURLY {%d,%d}", ARG1(op),ARG2(op));
+	p = NULL;
+	break;
+    case CURLYX:
+	(void)sprintf(buf+strlen(buf), "CURLYX {%d,%d}", ARG1(op),ARG2(op));
+	p = NULL;
+	break;
+    case REF:
+	(void)sprintf(buf+strlen(buf), "REF%d", ARG1(op));
+	p = NULL;
+	break;
+    case OPEN:
+	(void)sprintf(buf+strlen(buf), "OPEN%d", ARG1(op));
+	p = NULL;
+	break;
+    case CLOSE:
+	(void)sprintf(buf+strlen(buf), "CLOSE%d", ARG1(op));
+	p = NULL;
+	break;
+    case STAR:
+	p = "STAR";
+	break;
+    case PLUS:
+	p = "PLUS";
+	break;
+    case MINMOD:
+	p = "MINMOD";
+	break;
+    case GBOL:
+	p = "GBOL";
+	break;
+    case UNLESSM:
+	p = "UNLESSM";
+	break;
+    case IFMATCH:
+	p = "IFMATCH";
+	break;
+    case SUCCEED:
+	p = "SUCCEED";
+	break;
+    case WHILEM:
+	p = "WHILEM";
+	break;
+    default:
+	FAIL("corrupted regexp opcode");
+    }
+    if (p != NULL)
+	(void) strcat(buf, p);
+    return(buf);
+}
+#endif /* DEBUGGING */
+
+void
+pregfree(r)
+struct regexp *r;
+{
+    if (!r)
+	return;
+    if (r->precomp) {
+	Safefree(r->precomp);
+	r->precomp = Nullch;
+    }
+    if (r->subbase) {
+	Safefree(r->subbase);
+	r->subbase = Nullch;
+    }
+    if (r->regmust) {
+	SvREFCNT_dec(r->regmust);
+	r->regmust = Nullsv;
+    }
+    if (r->regstart) {
+	SvREFCNT_dec(r->regstart);
+	r->regstart = Nullsv;
+    }
+    Safefree(r->startp);
+    Safefree(r->endp);
+    Safefree(r);
+}
diff --git a/gnu/usr.bin/perl/regcomp.h b/gnu/usr.bin/perl/regcomp.h
new file mode 100644
index 00000000000..b2d9b846f7b
--- /dev/null
+++ b/gnu/usr.bin/perl/regcomp.h
@@ -0,0 +1,238 @@
+/*    regcomp.h
+ */
+
+/*
+ * The "internal use only" fields in regexp.h are present to pass info from
+ * compile to execute that permits the execute phase to run lots faster on
+ * simple cases.  They are:
+ *
+ * regstart	sv that must begin a match; Nullch if none obvious
+ * reganch	is the match anchored (at beginning-of-line only)?
+ * regmust	string (pointer into program) that match must include, or NULL
+ *  [regmust changed to SV* for bminstr()--law]
+ * regmlen	length of regmust string
+ *  [regmlen not used currently]
+ *
+ * Regstart and reganch permit very fast decisions on suitable starting points
+ * for a match, cutting down the work a lot.  Regmust permits fast rejection
+ * of lines that cannot possibly match.  The regmust tests are costly enough
+ * that pregcomp() supplies a regmust only if the r.e. contains something
+ * potentially expensive (at present, the only such thing detected is * or +
+ * at the start of the r.e., which can involve a lot of backup).  Regmlen is
+ * supplied because the test in pregexec() needs it and pregcomp() is computing
+ * it anyway.
+ * [regmust is now supplied always.  The tests that use regmust have a
+ * heuristic that disables the test if it usually matches.]
+ *
+ * [In fact, we now use regmust in many cases to locate where the search
+ * starts in the string, so if regback is >= 0, the regmust search is never
+ * wasted effort.  The regback variable says how many characters back from
+ * where regmust matched is the earliest possible start of the match.
+ * For instance, /[a-z].foo/ has a regmust of 'foo' and a regback of 2.]
+ */
+
+/*
+ * Structure for regexp "program".  This is essentially a linear encoding
+ * of a nondeterministic finite-state machine (aka syntax charts or
+ * "railroad normal form" in parsing technology).  Each node is an opcode
+ * plus a "next" pointer, possibly plus an operand.  "Next" pointers of
+ * all nodes except BRANCH implement concatenation; a "next" pointer with
+ * a BRANCH on both ends of it is connecting two alternatives.  (Here we
+ * have one of the subtle syntax dependencies:  an individual BRANCH (as
+ * opposed to a collection of them) is never concatenated with anything
+ * because of operator precedence.)  The operand of some types of node is
+ * a literal string; for others, it is a node leading into a sub-FSM.  In
+ * particular, the operand of a BRANCH node is the first node of the branch.
+ * (NB this is *not* a tree structure:  the tail of the branch connects
+ * to the thing following the set of BRANCHes.)  The opcodes are:
+ */
+
+/* definition	number	opnd?	meaning */
+#define	END	0	/* no	End of program. */
+#define	BOL	1	/* no	Match "" at beginning of line. */
+#define MBOL	2	/* no	Same, assuming multiline. */
+#define SBOL	3	/* no	Same, assuming singleline. */
+#define	EOL	4	/* no	Match "" at end of line. */
+#define MEOL	5	/* no	Same, assuming multiline. */
+#define SEOL	6	/* no	Same, assuming singleline. */
+#define	ANY	7	/* no	Match any one character (except newline). */
+#define	SANY	8	/* no	Match any one character. */
+#define	ANYOF	9	/* sv	Match character in (or not in) this class. */
+#define	CURLY	10	/* sv	Match this simple thing {n,m} times. */
+#define	CURLYX	11	/* sv	Match this complex thing {n,m} times. */
+#define	BRANCH	12	/* node	Match this alternative, or the next... */
+#define	BACK	13	/* no	Match "", "next" ptr points backward. */
+#define	EXACTLY	14	/* sv	Match this string (preceded by length). */
+#define	NOTHING	15	/* no	Match empty string. */
+#define	STAR	16	/* node	Match this (simple) thing 0 or more times. */
+#define	PLUS	17	/* node	Match this (simple) thing 1 or more times. */
+#define ALNUM	18	/* no	Match any alphanumeric character */
+#define NALNUM	19	/* no	Match any non-alphanumeric character */
+#define BOUND	20	/* no	Match "" at any word boundary */
+#define NBOUND	21	/* no	Match "" at any word non-boundary */
+#define SPACE	22	/* no	Match any whitespace character */
+#define NSPACE	23	/* no	Match any non-whitespace character */
+#define DIGIT	24	/* no	Match any numeric character */
+#define NDIGIT	25	/* no	Match any non-numeric character */
+#define REF	26	/* num	Match some already matched string */
+#define	OPEN	27	/* num	Mark this point in input as start of #n. */
+#define	CLOSE	28	/* num	Analogous to OPEN. */
+#define MINMOD	29	/* no	Next operator is not greedy. */
+#define GBOL	30	/* no	Matches where last m//g left off. */
+#define IFMATCH	31	/* no	Succeeds if the following matches. */
+#define UNLESSM	32	/* no	Fails if the following matches. */
+#define SUCCEED	33	/* no	Return from a subroutine, basically. */
+#define WHILEM	34	/* no	Do curly processing and see if rest matches. */
+
+/*
+ * Opcode notes:
+ *
+ * BRANCH	The set of branches constituting a single choice are hooked
+ *		together with their "next" pointers, since precedence prevents
+ *		anything being concatenated to any individual branch.  The
+ *		"next" pointer of the last BRANCH in a choice points to the
+ *		thing following the whole choice.  This is also where the
+ *		final "next" pointer of each individual branch points; each
+ *		branch starts with the operand node of a BRANCH node.
+ *
+ * BACK		Normal "next" pointers all implicitly point forward; BACK
+ *		exists to make loop structures possible.
+ *
+ * STAR,PLUS	'?', and complex '*' and '+', are implemented as circular
+ *		BRANCH structures using BACK.  Simple cases (one character
+ *		per match) are implemented with STAR and PLUS for speed
+ *		and to minimize recursive plunges.
+ *
+ * OPEN,CLOSE	...are numbered at compile time.
+ */
+
+#ifndef DOINIT
+EXT char regarglen[];
+#else
+EXT char regarglen[] = {0,0,0,0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,2,0,0,0,0,0};
+#endif
+
+#ifndef DOINIT
+EXT char regkind[];
+#else
+EXT char regkind[] = {
+	END,
+	BOL,
+	BOL,
+	BOL,
+	EOL,
+	EOL,
+	EOL,
+	ANY,
+	ANY,
+	ANYOF,
+	CURLY,
+	CURLY,
+	BRANCH,
+	BACK,
+	EXACTLY,
+	NOTHING,
+	STAR,
+	PLUS,
+	ALNUM,
+	NALNUM,
+	BOUND,
+	NBOUND,
+	SPACE,
+	NSPACE,
+	DIGIT,
+	NDIGIT,
+	REF,
+	OPEN,
+	CLOSE,
+	MINMOD,
+	BOL,
+	BRANCH,
+	BRANCH,
+	END,
+	WHILEM
+};
+#endif
+
+/* The following have no fixed length. */
+#ifndef DOINIT
+EXT char varies[];
+#else
+EXT char varies[] = {BRANCH,BACK,STAR,PLUS,CURLY,CURLYX,REF,WHILEM,0};
+#endif
+
+/* The following always have a length of 1. */
+#ifndef DOINIT
+EXT char simple[];
+#else
+EXT char simple[] = {ANY,SANY,ANYOF,ALNUM,NALNUM,SPACE,NSPACE,DIGIT,NDIGIT,0};
+#endif
+
+EXT char regdummy;
+
+/*
+ * A node is one char of opcode followed by two chars of "next" pointer.
+ * "Next" pointers are stored as two 8-bit pieces, high order first.  The
+ * value is a positive offset from the opcode of the node containing it.
+ * An operand, if any, simply follows the node.  (Note that much of the
+ * code generation knows about this implicit relationship.)
+ *
+ * Using two bytes for the "next" pointer is vast overkill for most things,
+ * but allows patterns to get big without disasters.
+ *
+ * [If REGALIGN is defined, the "next" pointer is always aligned on an even
+ * boundary, and reads the offset directly as a short.  Also, there is no
+ * special test to reverse the sign of BACK pointers since the offset is
+ * stored negative.]
+ */
+
+#ifndef gould
+#ifndef cray
+#ifndef eta10
+#define REGALIGN
+#endif
+#endif
+#endif
+
+#define	OP(p)	(*(p))
+
+#ifndef lint
+#ifdef REGALIGN
+#define NEXT(p) (*(short*)(p+1))
+#define ARG1(p) (*(unsigned short*)(p+3))
+#define ARG2(p) (*(unsigned short*)(p+5))
+#else
+#define	NEXT(p)	(((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
+#define	ARG1(p)	(((*((p)+3)&0377)<<8) + (*((p)+4)&0377))
+#define	ARG2(p)	(((*((p)+5)&0377)<<8) + (*((p)+6)&0377))
+#endif
+#else /* lint */
+#define NEXT(p) 0
+#endif /* lint */
+
+#define	OPERAND(p)	((p) + 3)
+
+#ifdef REGALIGN
+#define	NEXTOPER(p)	((p) + 4)
+#define	PREVOPER(p)	((p) - 4)
+#else
+#define	NEXTOPER(p)	((p) + 3)
+#define	PREVOPER(p)	((p) - 3)
+#endif
+
+#define MAGIC 0234
+
+/*
+ * Utility definitions.
+ */
+#ifndef lint
+#ifndef CHARMASK
+#define	UCHARAT(p)	((int)*(unsigned char *)(p))
+#else
+#define	UCHARAT(p)	((int)*(p)&CHARMASK)
+#endif
+#else /* lint */
+#define UCHARAT(p)	regdummy
+#endif /* lint */
+
+#define	FAIL(m)	croak("/%.127s/: %s",regprecomp,m)
diff --git a/gnu/usr.bin/perl/regexec.c b/gnu/usr.bin/perl/regexec.c
new file mode 100644
index 00000000000..6a29d7f0320
--- /dev/null
+++ b/gnu/usr.bin/perl/regexec.c
@@ -0,0 +1,1119 @@
+/*    regexec.c
+ */
+
+/*
+ * "One Ring to rule them all, One Ring to find them..."
+ */
+
+/* NOTE: this is derived from Henry Spencer's regexp code, and should not
+ * confused with the original package (see point 3 below).  Thanks, Henry!
+ */
+
+/* Additional note: this code is very heavily munged from Henry's version
+ * in places.  In some spots I've traded clarity for efficiency, so don't
+ * blame Henry for some of the lack of readability.
+ */
+
+/* The names of the functions have been changed from regcomp and
+ * regexec to  pregcomp and pregexec in order to avoid conflicts
+ * with the POSIX routines of the same names.
+*/
+
+/*SUPPRESS 112*/
+/*
+ * pregcomp and pregexec -- regsub and regerror are not used in perl
+ *
+ *	Copyright (c) 1986 by University of Toronto.
+ *	Written by Henry Spencer.  Not derived from licensed software.
+ *
+ *	Permission is granted to anyone to use this software for any
+ *	purpose on any computer system, and to redistribute it freely,
+ *	subject to the following restrictions:
+ *
+ *	1. 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.
+ *
+ *	2. The origin of this software must not be misrepresented, either
+ *		by explicit claim or by omission.
+ *
+ *	3. Altered versions must be plainly marked as such, and must not
+ *		be misrepresented as being the original software.
+ *
+ ****    Alterations to Henry's code are...
+ ****
+ ****    Copyright (c) 1991-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.
+ *
+ * Beware that some of this code is subtly aware of the way operator
+ * precedence is structured in regular expressions.  Serious changes in
+ * regular-expression syntax might require a total rethink.
+ */
+#include "EXTERN.h"
+#include "perl.h"
+#include "regcomp.h"
+
+#ifndef STATIC
+#define	STATIC	static
+#endif
+
+#ifdef DEBUGGING
+static I32 regnarrate = 0;
+static char* regprogram = 0;
+#endif
+
+/* Current curly descriptor */
+typedef struct curcur CURCUR;
+struct curcur {
+    int		parenfloor;	/* how far back to strip paren data */
+    int		cur;		/* how many instances of scan we've matched */
+    int		min;		/* the minimal number of scans to match */
+    int		max;		/* the maximal number of scans to match */
+    int		minmod;		/* whether to work our way up or down */
+    char *	scan;		/* the thing to match */
+    char *	next;		/* what has to match after it */
+    char *	lastloc;	/* where we started matching this scan */
+    CURCUR *	oldcc;		/* current curly before we started this one */
+};
+
+static CURCUR* regcc;
+
+typedef I32 CHECKPOINT;
+
+CHECKPOINT regcppush _((I32 parenfloor));
+char * regcppop _((void));
+
+CHECKPOINT
+regcppush(parenfloor)
+I32 parenfloor;
+{
+    int retval = savestack_ix;
+    int i = (regsize - parenfloor) * 3;
+    int p;
+
+    SSCHECK(i + 5);
+    for (p = regsize; p > parenfloor; p--) {
+	SSPUSHPTR(regendp[p]);
+	SSPUSHPTR(regstartp[p]);
+	SSPUSHINT(p);
+    }
+    SSPUSHINT(regsize);
+    SSPUSHINT(*reglastparen);
+    SSPUSHPTR(reginput);
+    SSPUSHINT(i + 3);
+    SSPUSHINT(SAVEt_REGCONTEXT);
+    return retval;
+}
+
+char*
+regcppop()
+{
+    I32 i = SSPOPINT;
+    U32 paren = 0;
+    char *input;
+    char *tmps;
+    assert(i == SAVEt_REGCONTEXT);
+    i = SSPOPINT;
+    input = (char *) SSPOPPTR;
+    *reglastparen = SSPOPINT;
+    regsize = SSPOPINT;
+    for (i -= 3; i > 0; i -= 3) {
+	paren = (U32)SSPOPINT;
+	regstartp[paren] = (char *) SSPOPPTR;
+	tmps = (char*)SSPOPPTR;
+	if (paren <= *reglastparen)
+	    regendp[paren] = tmps;
+    }
+    for (paren = *reglastparen + 1; paren <= regnpar; paren++) {
+	if (paren > regsize)
+	    regstartp[paren] = Nullch;
+	regendp[paren] = Nullch;
+    }
+    return input;
+}
+
+#define regcpblow(cp) leave_scope(cp)
+
+/*
+ * pregexec and friends
+ */
+
+/*
+ * Forwards.
+ */
+
+static I32 regmatch _((char *prog));
+static I32 regrepeat _((char *p, I32 max));
+static I32 regtry _((regexp *prog, char *startpos));
+
+/*
+ - pregexec - match a regexp against a string
+ */
+I32
+pregexec(prog, stringarg, strend, strbeg, minend, screamer, safebase)
+register regexp *prog;
+char *stringarg;
+register char *strend;	/* pointer to null at end of string */
+char *strbeg;	/* real beginning of string */
+I32 minend;	/* end of match must be at least minend after stringarg */
+SV *screamer;
+I32 safebase;	/* no need to remember string in subbase */
+{
+    register char *s;
+    register I32 i;
+    register char *c;
+    register char *startpos = stringarg;
+    register I32 tmp;
+    I32 minlen = 0;		/* must match at least this many chars */
+    I32 dontbother = 0;	/* how many characters not to try at end */
+    CURCUR cc;
+
+    cc.cur = 0;
+    cc.oldcc = 0;
+    regcc = &cc;
+
+#ifdef DEBUGGING
+    regnarrate = debug & 512;
+    regprogram = prog->program;
+#endif
+
+    /* Be paranoid... */
+    if (prog == NULL || startpos == NULL) {
+	croak("NULL regexp parameter");
+	return 0;
+    }
+
+    if (startpos == strbeg)	/* is ^ valid at stringarg? */
+	regprev = '\n';
+    else {
+	regprev = stringarg[-1];
+	if (!multiline && regprev == '\n')
+	    regprev = '\0';		/* force ^ to NOT match */
+    }
+    regprecomp = prog->precomp;
+    regnpar = prog->nparens;
+    /* Check validity of program. */
+    if (UCHARAT(prog->program) != MAGIC) {
+	FAIL("corrupted regexp program");
+    }
+
+    if (prog->do_folding) {
+	i = strend - startpos;
+	New(1101,c,i+1,char);
+	Copy(startpos, c, i+1, char);
+	startpos = c;
+	strend = startpos + i;
+	for (s = startpos; s < strend; s++)
+	    if (isUPPER(*s))
+		*s = toLOWER(*s);
+    }
+
+    /* If there is a "must appear" string, look for it. */
+    s = startpos;
+    if (prog->regmust != Nullsv &&
+	(!(prog->reganch & ROPT_ANCH)
+	 || (multiline && prog->regback >= 0)) )
+    {
+	if (stringarg == strbeg && screamer) {
+	    if (screamfirst[BmRARE(prog->regmust)] >= 0)
+		    s = screaminstr(screamer,prog->regmust);
+	    else
+		    s = Nullch;
+	}
+	else
+	    s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
+		prog->regmust);
+	if (!s) {
+	    ++BmUSEFUL(prog->regmust);	/* hooray */
+	    goto phooey;	/* not present */
+	}
+	else if (prog->regback >= 0) {
+	    s -= prog->regback;
+	    if (s < startpos)
+		s = startpos;
+	    minlen = prog->regback + SvCUR(prog->regmust);
+	}
+	else if (!prog->naughty && --BmUSEFUL(prog->regmust) < 0) { /* boo */
+	    SvREFCNT_dec(prog->regmust);
+	    prog->regmust = Nullsv;	/* disable regmust */
+	    s = startpos;
+	}
+	else {
+	    s = startpos;
+	    minlen = SvCUR(prog->regmust);
+	}
+    }
+
+    /* Mark beginning of line for ^ . */
+    regbol = startpos;
+
+    /* Mark end of line for $ (and such) */
+    regeol = strend;
+
+    /* see how far we have to get to not match where we matched before */
+    regtill = startpos+minend;
+
+    /* Simplest case:  anchored match need be tried only once. */
+    /*  [unless multiline is set] */
+    if (prog->reganch & ROPT_ANCH) {
+	if (regtry(prog, startpos))
+	    goto got_it;
+	else if (multiline || (prog->reganch & ROPT_IMPLICIT)) {
+	    if (minlen)
+		dontbother = minlen - 1;
+	    strend -= dontbother;
+	    /* for multiline we only have to try after newlines */
+	    if (s > startpos)
+		s--;
+	    while (s < strend) {
+		if (*s++ == '\n') {
+		    if (s < strend && regtry(prog, s))
+			goto got_it;
+		}
+	    }
+	}
+	goto phooey;
+    }
+
+    /* Messy cases:  unanchored match. */
+    if (prog->regstart) {
+	if (prog->reganch & ROPT_SKIP) {  /* we have /x+whatever/ */
+	    /* it must be a one character string */
+	    i = SvPVX(prog->regstart)[0];
+	    while (s < strend) {
+		if (*s == i) {
+		    if (regtry(prog, s))
+			goto got_it;
+		    s++;
+		    while (s < strend && *s == i)
+			s++;
+		}
+		s++;
+	    }
+	}
+	else if (SvPOK(prog->regstart) == 3) {
+	    /* We know what string it must start with. */
+	    while ((s = fbm_instr((unsigned char*)s,
+	      (unsigned char*)strend, prog->regstart)) != NULL)
+	    {
+		if (regtry(prog, s))
+		    goto got_it;
+		s++;
+	    }
+	}
+	else {
+	    c = SvPVX(prog->regstart);
+	    while ((s = ninstr(s, strend, c, c + SvCUR(prog->regstart))) != NULL)
+	    {
+		if (regtry(prog, s))
+		    goto got_it;
+		s++;
+	    }
+	}
+	goto phooey;
+    }
+    /*SUPPRESS 560*/
+    if (c = prog->regstclass) {
+	I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
+
+	if (minlen)
+	    dontbother = minlen - 1;
+	strend -= dontbother;	/* don't bother with what can't match */
+	tmp = 1;
+	/* We know what class it must start with. */
+	switch (OP(c)) {
+	case ANYOF:
+	    c = OPERAND(c);
+	    while (s < strend) {
+		i = UCHARAT(s);
+		if (!(c[i >> 3] & (1 << (i&7)))) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case BOUND:
+	    if (minlen)
+		dontbother++,strend--;
+	    if (s != startpos) {
+		i = s[-1];
+		tmp = isALNUM(i);
+	    }
+	    else
+		tmp = isALNUM(regprev);	/* assume not alphanumeric */
+	    while (s < strend) {
+		i = *s;
+		if (tmp != isALNUM(i)) {
+		    tmp = !tmp;
+		    if (regtry(prog, s))
+			goto got_it;
+		}
+		s++;
+	    }
+	    if ((minlen || tmp) && regtry(prog,s))
+		goto got_it;
+	    break;
+	case NBOUND:
+	    if (minlen)
+		dontbother++,strend--;
+	    if (s != startpos) {
+		i = s[-1];
+		tmp = isALNUM(i);
+	    }
+	    else
+		tmp = isALNUM(regprev);	/* assume not alphanumeric */
+	    while (s < strend) {
+		i = *s;
+		if (tmp != isALNUM(i))
+		    tmp = !tmp;
+		else if (regtry(prog, s))
+		    goto got_it;
+		s++;
+	    }
+	    if ((minlen || !tmp) && regtry(prog,s))
+		goto got_it;
+	    break;
+	case ALNUM:
+	    while (s < strend) {
+		i = *s;
+		if (isALNUM(i)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case NALNUM:
+	    while (s < strend) {
+		i = *s;
+		if (!isALNUM(i)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case SPACE:
+	    while (s < strend) {
+		if (isSPACE(*s)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case NSPACE:
+	    while (s < strend) {
+		if (!isSPACE(*s)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case DIGIT:
+	    while (s < strend) {
+		if (isDIGIT(*s)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	case NDIGIT:
+	    while (s < strend) {
+		if (!isDIGIT(*s)) {
+		    if (tmp && regtry(prog, s))
+			goto got_it;
+		    else
+			tmp = doevery;
+		}
+		else
+		    tmp = 1;
+		s++;
+	    }
+	    break;
+	}
+    }
+    else {
+	if (minlen)
+	    dontbother = minlen - 1;
+	strend -= dontbother;
+	/* We don't know much -- general case. */
+	do {
+	    if (regtry(prog, s))
+		goto got_it;
+	} while (s++ < strend);
+    }
+
+    /* Failure. */
+    goto phooey;
+
+got_it:
+    strend += dontbother;	/* uncheat */
+    prog->subbeg = strbeg;
+    prog->subend = strend;
+    if ((!safebase && (prog->nparens || sawampersand)) || prog->do_folding) {
+	i = strend - startpos + (stringarg - strbeg);
+	if (safebase) {			/* no need for $digit later */
+	    s = strbeg;
+	    prog->subend = s+i;
+	}
+	else if (strbeg != prog->subbase) {
+	    s = savepvn(strbeg,i);	/* so $digit will work later */
+	    if (prog->subbase)
+		Safefree(prog->subbase);
+	    prog->subbeg = prog->subbase = s;
+	    prog->subend = s+i;
+	}
+	else {
+	    prog->subbeg = s = prog->subbase;
+	    prog->subend = s+i;
+	}
+	s += (stringarg - strbeg);
+	for (i = 0; i <= prog->nparens; i++) {
+	    if (prog->endp[i]) {
+		prog->startp[i] = s + (prog->startp[i] - startpos);
+		prog->endp[i] = s + (prog->endp[i] - startpos);
+	    }
+	}
+	if (prog->do_folding)
+	    Safefree(startpos);
+    }
+    return 1;
+
+phooey:
+    if (prog->do_folding)
+	Safefree(startpos);
+    return 0;
+}
+
+/*
+ - regtry - try match at specific point
+ */
+static I32			/* 0 failure, 1 success */
+regtry(prog, startpos)
+regexp *prog;
+char *startpos;
+{
+    register I32 i;
+    register char **sp;
+    register char **ep;
+
+    reginput = startpos;
+    regstartp = prog->startp;
+    regendp = prog->endp;
+    reglastparen = &prog->lastparen;
+    prog->lastparen = 0;
+    regsize = 0;
+
+    sp = prog->startp;
+    ep = prog->endp;
+    if (prog->nparens) {
+	for (i = prog->nparens; i >= 0; i--) {
+	    *sp++ = NULL;
+	    *ep++ = NULL;
+	}
+    }
+    if (regmatch(prog->program + 1) && reginput >= regtill) {
+	prog->startp[0] = startpos;
+	prog->endp[0] = reginput;
+	return 1;
+    }
+    else
+	return 0;
+}
+
+/*
+ - regmatch - main matching routine
+ *
+ * Conceptually the strategy is simple:  check to see whether the current
+ * node matches, call self recursively to see whether the rest matches,
+ * and then act accordingly.  In practice we make some effort to avoid
+ * recursion, in particular by going through "ordinary" nodes (that don't
+ * need to know whether the rest of the match failed) by a loop instead of
+ * by recursion.
+ */
+/* [lwall] I've hoisted the register declarations to the outer block in order to
+ * maybe save a little bit of pushing and popping on the stack.  It also takes
+ * advantage of machines that use a register save mask on subroutine entry.
+ */
+static I32			/* 0 failure, 1 success */
+regmatch(prog)
+char *prog;
+{
+    register char *scan;	/* Current node. */
+    char *next;			/* Next node. */
+    register I32 nextchar;
+    register I32 n;		/* no or next */
+    register I32 ln;		/* len or last */
+    register char *s;		/* operand or save */
+    register char *locinput = reginput;
+    int minmod = 0;
+#ifdef DEBUGGING
+    static int regindent = 0;
+    regindent++;
+#endif
+
+    nextchar = *locinput;
+    scan = prog;
+    while (scan != NULL) {
+#ifdef DEBUGGING
+#define sayYES goto yes
+#define sayNO goto no
+#define saySAME(x) if (x) goto yes; else goto no
+	if (regnarrate) {
+	    fprintf(stderr, "%*s%2d%-8.8s\t<%.10s>\n", regindent*2, "",
+		scan - regprogram, regprop(scan), locinput);
+	}
+#else
+#define sayYES return 1
+#define sayNO return 0
+#define saySAME(x) return x
+#endif
+
+#ifdef REGALIGN
+	next = scan + NEXT(scan);
+	if (next == scan)
+	    next = NULL;
+#else
+	next = regnext(scan);
+#endif
+
+	switch (OP(scan)) {
+	case BOL:
+	    if (locinput == regbol
+		? regprev == '\n'
+		: ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
+	    {
+		/* regtill = regbol; */
+		break;
+	    }
+	    sayNO;
+	case MBOL:
+	    if (locinput == regbol
+		? regprev == '\n'
+		: ((nextchar || locinput < regeol) && locinput[-1] == '\n') )
+	    {
+		break;
+	    }
+	    sayNO;
+	case SBOL:
+	    if (locinput == regbol && regprev == '\n')
+		break;
+	    sayNO;
+	case GBOL:
+	    if (locinput == regbol)
+		break;
+	    sayNO;
+	case EOL:
+	    if (multiline)
+		goto meol;
+	    else
+		goto seol;
+	case MEOL:
+	  meol:
+	    if ((nextchar || locinput < regeol) && nextchar != '\n')
+		sayNO;
+	    break;
+	case SEOL:
+	  seol:
+	    if ((nextchar || locinput < regeol) && nextchar != '\n')
+		sayNO;
+	    if (regeol - locinput > 1)
+		sayNO;
+	    break;
+	case SANY:
+	    if (!nextchar && locinput >= regeol)
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case ANY:
+	    if (!nextchar && locinput >= regeol || nextchar == '\n')
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case EXACTLY:
+	    s = OPERAND(scan);
+	    ln = *s++;
+	    /* Inline the first character, for speed. */
+	    if (*s != nextchar)
+		sayNO;
+	    if (regeol - locinput < ln)
+		sayNO;
+	    if (ln > 1 && bcmp(s, locinput, ln) != 0)
+		sayNO;
+	    locinput += ln;
+	    nextchar = *locinput;
+	    break;
+	case ANYOF:
+	    s = OPERAND(scan);
+	    if (nextchar < 0)
+		nextchar = UCHARAT(locinput);
+	    if (s[nextchar >> 3] & (1 << (nextchar&7)))
+		sayNO;
+	    if (!nextchar && locinput >= regeol)
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case ALNUM:
+	    if (!nextchar)
+		sayNO;
+	    if (!isALNUM(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case NALNUM:
+	    if (!nextchar && locinput >= regeol)
+		sayNO;
+	    if (isALNUM(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case NBOUND:
+	case BOUND:
+	    if (locinput == regbol)	/* was last char in word? */
+		ln = isALNUM(regprev);
+	    else 
+		ln = isALNUM(locinput[-1]);
+	    n = isALNUM(nextchar); /* is next char in word? */
+	    if ((ln == n) == (OP(scan) == BOUND))
+		sayNO;
+	    break;
+	case SPACE:
+	    if (!nextchar && locinput >= regeol)
+		sayNO;
+	    if (!isSPACE(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case NSPACE:
+	    if (!nextchar)
+		sayNO;
+	    if (isSPACE(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case DIGIT:
+	    if (!isDIGIT(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case NDIGIT:
+	    if (!nextchar && locinput >= regeol)
+		sayNO;
+	    if (isDIGIT(nextchar))
+		sayNO;
+	    nextchar = *++locinput;
+	    break;
+	case REF:
+	    n = ARG1(scan);  /* which paren pair */
+	    s = regstartp[n];
+	    if (!s)
+		sayNO;
+	    if (!regendp[n])
+		sayNO;
+	    if (s == regendp[n])
+		break;
+	    /* Inline the first character, for speed. */
+	    if (*s != nextchar)
+		sayNO;
+	    ln = regendp[n] - s;
+	    if (locinput + ln > regeol)
+		sayNO;
+	    if (ln > 1 && bcmp(s, locinput, ln) != 0)
+		sayNO;
+	    locinput += ln;
+	    nextchar = *locinput;
+	    break;
+
+	case NOTHING:
+	    break;
+	case BACK:
+	    break;
+	case OPEN:
+	    n = ARG1(scan);  /* which paren pair */
+	    regstartp[n] = locinput;
+	    if (n > regsize)
+		regsize = n;
+	    break;
+	case CLOSE:
+	    n = ARG1(scan);  /* which paren pair */
+	    regendp[n] = locinput;
+	    if (n > *reglastparen)
+		*reglastparen = n;
+	    break;
+	case CURLYX: {
+		CURCUR cc;
+		CHECKPOINT cp = savestack_ix;
+		cc.oldcc = regcc;
+		regcc = &cc;
+		cc.parenfloor = *reglastparen;
+		cc.cur = -1;
+		cc.min = ARG1(scan);
+		cc.max  = ARG2(scan);
+		cc.scan = NEXTOPER(scan) + 4;
+		cc.next = next;
+		cc.minmod = minmod;
+		cc.lastloc = 0;
+		reginput = locinput;
+		n = regmatch(PREVOPER(next));	/* start on the WHILEM */
+		regcpblow(cp);
+		regcc = cc.oldcc;
+		saySAME(n);
+	    }
+	    /* NOT REACHED */
+	case WHILEM: {
+		/*
+		 * This is really hard to understand, because after we match
+		 * what we're trying to match, we must make sure the rest of
+		 * the RE is going to match for sure, and to do that we have
+		 * to go back UP the parse tree by recursing ever deeper.  And
+		 * if it fails, we have to reset our parent's current state
+		 * that we can try again after backing off.
+		 */
+
+		CURCUR* cc = regcc;
+		n = cc->cur + 1;	/* how many we know we matched */
+		reginput = locinput;
+
+#ifdef DEBUGGING
+		if (regnarrate)
+		    fprintf(stderr, "%*s  %d  %lx\n", regindent*2, "",
+			n, (long)cc);
+#endif
+
+		/* If degenerate scan matches "", assume scan done. */
+
+		if (locinput == cc->lastloc) {
+		    regcc = cc->oldcc;
+		    ln = regcc->cur;
+		    if (regmatch(cc->next))
+			sayYES;
+		    regcc->cur = ln;
+		    regcc = cc;
+		    sayNO;
+		}
+
+		/* First just match a string of min scans. */
+
+		if (n < cc->min) {
+		    cc->cur = n;
+		    cc->lastloc = locinput;
+		    if (regmatch(cc->scan))
+			sayYES;
+		    cc->cur = n - 1;
+		    sayNO;
+		}
+
+		/* Prefer next over scan for minimal matching. */
+
+		if (cc->minmod) {
+		    regcc = cc->oldcc;
+		    ln = regcc->cur;
+		    if (regmatch(cc->next))
+			sayYES;	/* All done. */
+		    regcc->cur = ln;
+		    regcc = cc;
+
+		    if (n >= cc->max)	/* Maximum greed exceeded? */
+			sayNO;
+
+		    /* Try scanning more and see if it helps. */
+		    reginput = locinput;
+		    cc->cur = n;
+		    cc->lastloc = locinput;
+		    if (regmatch(cc->scan))
+			sayYES;
+		    cc->cur = n - 1;
+		    sayNO;
+		}
+
+		/* Prefer scan over next for maximal matching. */
+
+		if (n < cc->max) {	/* More greed allowed? */
+		    regcppush(cc->parenfloor);
+		    cc->cur = n;
+		    cc->lastloc = locinput;
+		    if (regmatch(cc->scan))
+			sayYES;
+		    regcppop();		/* Restore some previous $<digit>s? */
+		    reginput = locinput;
+		}
+
+		/* Failed deeper matches of scan, so see if this one works. */
+		regcc = cc->oldcc;
+		ln = regcc->cur;
+		if (regmatch(cc->next))
+		    sayYES;
+		regcc->cur = ln;
+		regcc = cc;
+		cc->cur = n - 1;
+		sayNO;
+	    }
+	    /* NOT REACHED */
+	case BRANCH: {
+		if (OP(next) != BRANCH)	  /* No choice. */
+		    next = NEXTOPER(scan);/* Avoid recursion. */
+		else {
+		    int lastparen = *reglastparen;
+		    do {
+			reginput = locinput;
+			if (regmatch(NEXTOPER(scan)))
+			    sayYES;
+			for (n = *reglastparen; n > lastparen; n--)
+			    regendp[n] = 0;
+			*reglastparen = n;
+			    
+#ifdef REGALIGN
+			/*SUPPRESS 560*/
+			if (n = NEXT(scan))
+			    scan += n;
+			else
+			    scan = NULL;
+#else
+			scan = regnext(scan);
+#endif
+		    } while (scan != NULL && OP(scan) == BRANCH);
+		    sayNO;
+		    /* NOTREACHED */
+		}
+	    }
+	    break;
+	case MINMOD:
+	    minmod = 1;
+	    break;
+	case CURLY:
+	    ln = ARG1(scan);  /* min to match */
+	    n  = ARG2(scan);  /* max to match */
+	    scan = NEXTOPER(scan) + 4;
+	    goto repeat;
+	case STAR:
+	    ln = 0;
+	    n = 32767;
+	    scan = NEXTOPER(scan);
+	    goto repeat;
+	case PLUS:
+	    /*
+	    * Lookahead to avoid useless match attempts
+	    * when we know what character comes next.
+	    */
+	    ln = 1;
+	    n = 32767;
+	    scan = NEXTOPER(scan);
+	  repeat:
+	    if (OP(next) == EXACTLY)
+		nextchar = *(OPERAND(next)+1);
+	    else
+		nextchar = -1000;
+	    reginput = locinput;
+	    if (minmod) {
+		minmod = 0;
+		if (ln && regrepeat(scan, ln) < ln)
+		    sayNO;
+		while (n >= ln || (n == 32767 && ln > 0)) { /* ln overflow ? */
+		    /* If it could work, try it. */
+		    if (nextchar == -1000 || *reginput == nextchar)
+			if (regmatch(next))
+			    sayYES;
+		    /* Couldn't or didn't -- back up. */
+		    reginput = locinput + ln;
+		    if (regrepeat(scan, 1)) {
+			ln++;
+			reginput = locinput + ln;
+		    }
+		    else
+			sayNO;
+		}
+	    }
+	    else {
+		n = regrepeat(scan, n);
+		if (ln < n && regkind[(U8)OP(next)] == EOL &&
+		    (!multiline || OP(next) == SEOL))
+		    ln = n;			/* why back off? */
+		while (n >= ln) {
+		    /* If it could work, try it. */
+		    if (nextchar == -1000 || *reginput == nextchar)
+			if (regmatch(next))
+			    sayYES;
+		    /* Couldn't or didn't -- back up. */
+		    n--;
+		    reginput = locinput + n;
+		}
+	    }
+	    sayNO;
+	case SUCCEED:
+	case END:
+	    reginput = locinput;	/* put where regtry can find it */
+	    sayYES;			/* Success! */
+	case IFMATCH:
+	    reginput = locinput;
+	    scan = NEXTOPER(scan);
+	    if (!regmatch(scan))
+		sayNO;
+	    break;
+	case UNLESSM:
+	    reginput = locinput;
+	    scan = NEXTOPER(scan);
+	    if (regmatch(scan))
+		sayNO;
+	    break;
+	default:
+	    fprintf(stderr, "%x %d\n",(unsigned)scan,scan[1]);
+	    FAIL("regexp memory corruption");
+	}
+	scan = next;
+    }
+
+    /*
+    * We get here only if there's trouble -- normally "case END" is
+    * the terminating point.
+    */
+    FAIL("corrupted regexp pointers");
+    /*NOTREACHED*/
+    sayNO;
+
+yes:
+#ifdef DEBUGGING
+    regindent--;
+#endif
+    return 1;
+
+no:
+#ifdef DEBUGGING
+    regindent--;
+#endif
+    return 0;
+}
+
+/*
+ - regrepeat - repeatedly match something simple, report how many
+ */
+/*
+ * [This routine now assumes that it will only match on things of length 1.
+ * That was true before, but now we assume scan - reginput is the count,
+ * rather than incrementing count on every character.]
+ */
+static I32
+regrepeat(p, max)
+char *p;
+I32 max;
+{
+    register char *scan;
+    register char *opnd;
+    register I32 c;
+    register char *loceol = regeol;
+
+    scan = reginput;
+    if (max != 32767 && max < loceol - scan)
+      loceol = scan + max;
+    opnd = OPERAND(p);
+    switch (OP(p)) {
+    case ANY:
+	while (scan < loceol && *scan != '\n')
+	    scan++;
+	break;
+    case SANY:
+	scan = loceol;
+	break;
+    case EXACTLY:		/* length of string is 1 */
+	opnd++;
+	while (scan < loceol && *opnd == *scan)
+	    scan++;
+	break;
+    case ANYOF:
+	c = UCHARAT(scan);
+	while (scan < loceol && !(opnd[c >> 3] & (1 << (c & 7)))) {
+	    scan++;
+	    c = UCHARAT(scan);
+	}
+	break;
+    case ALNUM:
+	while (scan < loceol && isALNUM(*scan))
+	    scan++;
+	break;
+    case NALNUM:
+	while (scan < loceol && !isALNUM(*scan))
+	    scan++;
+	break;
+    case SPACE:
+	while (scan < loceol && isSPACE(*scan))
+	    scan++;
+	break;
+    case NSPACE:
+	while (scan < loceol && !isSPACE(*scan))
+	    scan++;
+	break;
+    case DIGIT:
+	while (scan < loceol && isDIGIT(*scan))
+	    scan++;
+	break;
+    case NDIGIT:
+	while (scan < loceol && !isDIGIT(*scan))
+	    scan++;
+	break;
+    default:		/* Called on something of 0 width. */
+	break;		/* So match right here or not at all. */
+    }
+
+    c = scan - reginput;
+    reginput = scan;
+
+    return(c);
+}
+
+/*
+ - regnext - dig the "next" pointer out of a node
+ *
+ * [Note, when REGALIGN is defined there are two places in regmatch()
+ * that bypass this code for speed.]
+ */
+char *
+regnext(p)
+register char *p;
+{
+    register I32 offset;
+
+    if (p == &regdummy)
+	return(NULL);
+
+    offset = NEXT(p);
+    if (offset == 0)
+	return(NULL);
+
+#ifdef REGALIGN
+    return(p+offset);
+#else
+    if (OP(p) == BACK)
+	return(p-offset);
+    else
+	return(p+offset);
+#endif
+}
diff --git a/gnu/usr.bin/perl/regexp.h b/gnu/usr.bin/perl/regexp.h
new file mode 100644
index 00000000000..018312ec243
--- /dev/null
+++ b/gnu/usr.bin/perl/regexp.h
@@ -0,0 +1,35 @@
+/*    regexp.h
+ */
+
+/*
+ * Definitions etc. for regexp(3) routines.
+ *
+ * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
+ * not the System V one.
+ */
+
+
+typedef struct regexp {
+	char **startp;
+	char **endp;
+	SV *regstart;		/* Internal use only. */
+	char *regstclass;
+	SV *regmust;		/* Internal use only. */
+	I32 regback;		/* Can regmust locate first try? */
+	I32 minlen;		/* mininum possible length of $& */
+	I32 prelen;		/* length of precomp */
+	U32 nparens;		/* number of parentheses */
+	U32 lastparen;		/* last paren matched */
+	char *precomp;		/* pre-compilation regular expression */
+	char *subbase;		/* saved string so \digit works forever */
+	char *subbeg;		/* same, but not responsible for allocation */
+	char *subend;		/* end of subbase */
+	U16 naughty;		/* how exponential is this pattern? */
+	char reganch;		/* Internal use only. */
+	char do_folding;	/* do case-insensitive match? */
+	char program[1];	/* Unwarranted chumminess with compiler. */
+} regexp;
+
+#define ROPT_ANCH 1
+#define ROPT_SKIP 2
+#define ROPT_IMPLICIT 4
diff --git a/gnu/usr.bin/perl/run.c b/gnu/usr.bin/perl/run.c
new file mode 100644
index 00000000000..7c09f8f58bd
--- /dev/null
+++ b/gnu/usr.bin/perl/run.c
@@ -0,0 +1,120 @@
+/*    run.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/*
+ * "Away now, Shadowfax!  Run, greatheart, run as you have never run before!
+ * Now we are come to the lands where you were foaled, and every stone you
+ * know.  Run now!  Hope is in speed!"  --Gandalf
+ */
+
+dEXT char **watchaddr = 0;
+dEXT char *watchok;
+
+#ifndef DEBUGGING
+
+int
+runops() {
+    SAVEI32(runlevel);
+    runlevel++;
+
+    while ( op = (*op->op_ppaddr)() ) ;
+    return 0;
+}
+
+#else
+
+static void debprof _((OP*op));
+
+int
+runops() {
+    if (!op) {
+	warn("NULL OP IN RUN");
+	return 0;
+    }
+
+    SAVEI32(runlevel);
+    runlevel++;
+
+    do {
+	if (debug) {
+	    if (watchaddr != 0 && *watchaddr != watchok)
+		fprintf(stderr, "WARNING: %lx changed from %lx to %lx\n",
+		    (long)watchaddr, (long)watchok, (long)*watchaddr);
+	    DEBUG_s(debstack());
+	    DEBUG_t(debop(op));
+	    DEBUG_P(debprof(op));
+	}
+    } while ( op = (*op->op_ppaddr)() );
+    return 0;
+}
+
+I32
+debop(op)
+OP *op;
+{
+    SV *sv;
+    deb("%s", op_name[op->op_type]);
+    switch (op->op_type) {
+    case OP_CONST:
+	fprintf(stderr, "(%s)", SvPEEK(cSVOP->op_sv));
+	break;
+    case OP_GVSV:
+    case OP_GV:
+	if (cGVOP->op_gv) {
+	    sv = NEWSV(0,0);
+	    gv_fullname(sv, cGVOP->op_gv);
+	    fprintf(stderr, "(%s)", SvPV(sv, na));
+	    SvREFCNT_dec(sv);
+	}
+	else
+	    fprintf(stderr, "(NULL)");
+	break;
+    default:
+	break;
+    }
+    fprintf(stderr, "\n");
+    return 0;
+}
+
+void
+watch(addr)
+char **addr;
+{
+    watchaddr = addr;
+    watchok = *addr;
+    fprintf(stderr, "WATCHING, %lx is currently %lx\n",
+	(long)watchaddr, (long)watchok);
+}
+
+static void
+debprof(op)
+OP* op;
+{
+    if (!profiledata)
+	New(000, profiledata, MAXO, U32);
+    ++profiledata[op->op_type];
+}
+
+void
+debprofdump()
+{
+    U32 i;
+    if (!profiledata)
+	return;
+    for (i = 0; i < MAXO; i++) {
+	if (profiledata[i])
+	    fprintf(stderr, "%d\t%lu\n", i, profiledata[i]);
+    }
+}
+
+#endif
+
diff --git a/gnu/usr.bin/perl/scope.c b/gnu/usr.bin/perl/scope.c
new file mode 100644
index 00000000000..3f4860990d7
--- /dev/null
+++ b/gnu/usr.bin/perl/scope.c
@@ -0,0 +1,701 @@
+/*    scope.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "For the fashion of Minas Tirith was such that it was built on seven
+ * levels..."
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+SV**
+stack_grow(sp, p, n)
+SV** sp;
+SV** p;
+int n;
+{
+    stack_sp = sp;
+    av_extend(stack, (p - stack_base) + (n) + 128);
+    return stack_sp;
+}
+
+I32
+cxinc()
+{
+    cxstack_max = cxstack_max * 3 / 2;
+    Renew(cxstack, cxstack_max + 1, CONTEXT);	/* XXX should fix CXINC macro */
+    return cxstack_ix + 1;
+}
+
+void
+push_return(retop)
+OP *retop;
+{
+    if (retstack_ix == retstack_max) {
+	retstack_max = retstack_max * 3 / 2;
+	Renew(retstack, retstack_max, OP*);
+    }
+    retstack[retstack_ix++] = retop;
+}
+
+OP *
+pop_return()
+{
+    if (retstack_ix > 0)
+	return retstack[--retstack_ix];
+    else
+	return Nullop;
+}
+
+void
+push_scope()
+{
+    if (scopestack_ix == scopestack_max) {
+	scopestack_max = scopestack_max * 3 / 2;
+	Renew(scopestack, scopestack_max, I32);
+    }
+    scopestack[scopestack_ix++] = savestack_ix;
+
+}
+
+void
+pop_scope()
+{
+    I32 oldsave = scopestack[--scopestack_ix];
+    LEAVE_SCOPE(oldsave);
+}
+
+void
+markstack_grow()
+{
+    I32 oldmax = markstack_max - markstack;
+    I32 newmax = oldmax * 3 / 2;
+
+    Renew(markstack, newmax, I32);
+    markstack_ptr = markstack + oldmax;
+    markstack_max = markstack + newmax;
+}
+
+void
+savestack_grow()
+{
+    savestack_max = savestack_max * 3 / 2;
+    Renew(savestack, savestack_max, ANY);
+}
+
+void
+free_tmps()
+{
+    /* XXX should tmps_floor live in cxstack? */
+    I32 myfloor = tmps_floor;
+    while (tmps_ix > myfloor) {      /* clean up after last statement */
+	SV* sv = tmps_stack[tmps_ix];
+	tmps_stack[tmps_ix--] = Nullsv;
+	if (sv) {
+#ifdef DEBUGGING
+	    SvTEMP_off(sv);
+#endif
+	    SvREFCNT_dec(sv);		/* note, can modify tmps_ix!!! */
+	}
+    }
+}
+
+SV *
+save_scalar(gv)
+GV *gv;
+{
+    register SV *sv;
+    SV *osv = GvSV(gv);
+
+    SSCHECK(3);
+    SSPUSHPTR(gv);
+    SSPUSHPTR(osv);
+    SSPUSHINT(SAVEt_SV);
+
+    sv = GvSV(gv) = NEWSV(0,0);
+    if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+	sv_upgrade(sv, SvTYPE(osv));
+	if (SvGMAGICAL(osv)) {
+	    MAGIC* mg;
+	    bool oldtainted = tainted;
+	    mg_get(osv);
+	    if (tainting && tainted && (mg = mg_find(osv, 't'))) {
+		SAVESPTR(mg->mg_obj);
+		mg->mg_obj = osv;
+	    }
+	    SvFLAGS(osv) |= (SvFLAGS(osv) &
+		(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+	    tainted = oldtainted;
+	}
+	SvMAGIC(sv) = SvMAGIC(osv);
+	SvFLAGS(sv) |= SvMAGICAL(osv);
+	localizing = 1;
+	SvSETMAGIC(sv);
+	localizing = 0;
+    }
+    return sv;
+}
+
+#ifdef INLINED_ELSEWHERE
+void
+save_gp(gv)
+GV *gv;
+{
+    register GP *gp;
+    GP *ogp = GvGP(gv);
+
+    SSCHECK(3);
+    SSPUSHPTR(SvREFCNT_inc(gv));
+    SSPUSHPTR(ogp);
+    SSPUSHINT(SAVEt_GP);
+
+    Newz(602,gp, 1, GP);
+    GvGP(gv) = gp;
+    GvREFCNT(gv) = 1;
+    GvSV(gv) = NEWSV(72,0);
+    GvLINE(gv) = curcop->cop_line;
+    GvEGV(gv) = gv;
+}
+#endif
+
+SV*
+save_svref(sptr)
+SV **sptr;
+{
+    register SV *sv;
+    SV *osv = *sptr;
+
+    SSCHECK(3);
+    SSPUSHPTR(*sptr);
+    SSPUSHPTR(sptr);
+    SSPUSHINT(SAVEt_SVREF);
+
+    sv = *sptr = NEWSV(0,0);
+    if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) {
+	sv_upgrade(sv, SvTYPE(osv));
+	if (SvGMAGICAL(osv)) {
+	    MAGIC* mg;
+	    bool oldtainted = tainted;
+	    mg_get(osv);
+	    if (tainting && tainted && (mg = mg_find(osv, 't'))) {
+		SAVESPTR(mg->mg_obj);
+		mg->mg_obj = osv;
+	    }
+	    SvFLAGS(osv) |= (SvFLAGS(osv) &
+		(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+	    tainted = oldtainted;
+	}
+	SvMAGIC(sv) = SvMAGIC(osv);
+	SvFLAGS(sv) |= SvMAGICAL(osv);
+	localizing = 1;
+	SvSETMAGIC(sv);
+	localizing = 0;
+    }
+    return sv;
+}
+
+AV *
+save_ary(gv)
+GV *gv;
+{
+    SSCHECK(3);
+    SSPUSHPTR(gv);
+    SSPUSHPTR(GvAVn(gv));
+    SSPUSHINT(SAVEt_AV);
+
+    GvAV(gv) = Null(AV*);
+    return GvAVn(gv);
+}
+
+HV *
+save_hash(gv)
+GV *gv;
+{
+    SSCHECK(3);
+    SSPUSHPTR(gv);
+    SSPUSHPTR(GvHVn(gv));
+    SSPUSHINT(SAVEt_HV);
+
+    GvHV(gv) = Null(HV*);
+    return GvHVn(gv);
+}
+
+void
+save_item(item)
+register SV *item;
+{
+    register SV *sv;
+
+    SSCHECK(3);
+    SSPUSHPTR(item);		/* remember the pointer */
+    sv = NEWSV(0,0);
+    sv_setsv(sv,item);
+    SSPUSHPTR(sv);		/* remember the value */
+    SSPUSHINT(SAVEt_ITEM);
+}
+
+void
+save_int(intp)
+int *intp;
+{
+    SSCHECK(3);
+    SSPUSHINT(*intp);
+    SSPUSHPTR(intp);
+    SSPUSHINT(SAVEt_INT);
+}
+
+void
+save_long(longp)
+long *longp;
+{
+    SSCHECK(3);
+    SSPUSHLONG(*longp);
+    SSPUSHPTR(longp);
+    SSPUSHINT(SAVEt_LONG);
+}
+
+void
+save_I32(intp)
+I32 *intp;
+{
+    SSCHECK(3);
+    SSPUSHINT(*intp);
+    SSPUSHPTR(intp);
+    SSPUSHINT(SAVEt_I32);
+}
+
+void
+save_iv(ivp)
+IV *ivp;
+{
+    SSCHECK(3);
+    SSPUSHIV(*ivp);
+    SSPUSHPTR(ivp);
+    SSPUSHINT(SAVEt_IV);
+}
+
+/* Cannot use save_sptr() to store a char* since the SV** cast will
+ * force word-alignment and we'll miss the pointer.
+ */
+void
+save_pptr(pptr)
+char **pptr;
+{
+    SSCHECK(3);
+    SSPUSHPTR(*pptr);
+    SSPUSHPTR(pptr);
+    SSPUSHINT(SAVEt_PPTR);
+}
+
+void
+save_sptr(sptr)
+SV **sptr;
+{
+    SSCHECK(3);
+    SSPUSHPTR(*sptr);
+    SSPUSHPTR(sptr);
+    SSPUSHINT(SAVEt_SPTR);
+}
+
+void
+save_nogv(gv)
+GV *gv;
+{
+    SSCHECK(2);
+    SSPUSHPTR(gv);
+    SSPUSHINT(SAVEt_NSTAB);
+}
+
+void
+save_hptr(hptr)
+HV **hptr;
+{
+    SSCHECK(3);
+    SSPUSHPTR(*hptr);
+    SSPUSHPTR(hptr);
+    SSPUSHINT(SAVEt_HPTR);
+}
+
+void
+save_aptr(aptr)
+AV **aptr;
+{
+    SSCHECK(3);
+    SSPUSHPTR(*aptr);
+    SSPUSHPTR(aptr);
+    SSPUSHINT(SAVEt_APTR);
+}
+
+void
+save_freesv(sv)
+SV *sv;
+{
+    SSCHECK(2);
+    SSPUSHPTR(sv);
+    SSPUSHINT(SAVEt_FREESV);
+}
+
+void
+save_freeop(op)
+OP *op;
+{
+    SSCHECK(2);
+    SSPUSHPTR(op);
+    SSPUSHINT(SAVEt_FREEOP);
+}
+
+void
+save_freepv(pv)
+char *pv;
+{
+    SSCHECK(2);
+    SSPUSHPTR(pv);
+    SSPUSHINT(SAVEt_FREEPV);
+}
+
+void
+save_clearsv(svp)
+SV** svp;
+{
+    SSCHECK(2);
+    SSPUSHLONG((long)(svp-curpad));
+    SSPUSHINT(SAVEt_CLEARSV);
+}
+
+void
+save_delete(hv,key,klen)
+HV *hv;
+char *key;
+I32 klen;
+{
+    SSCHECK(4);
+    SSPUSHINT(klen);
+    SSPUSHPTR(key);
+    SSPUSHPTR(hv);
+    SSPUSHINT(SAVEt_DELETE);
+}
+
+void
+save_list(sarg,maxsarg)
+register SV **sarg;
+I32 maxsarg;
+{
+    register SV *sv;
+    register I32 i;
+
+    SSCHECK(3 * maxsarg);
+    for (i = 1; i <= maxsarg; i++) {
+	SSPUSHPTR(sarg[i]);		/* remember the pointer */
+	sv = NEWSV(0,0);
+	sv_setsv(sv,sarg[i]);
+	SSPUSHPTR(sv);			/* remember the value */
+	SSPUSHINT(SAVEt_ITEM);
+    }
+}
+
+void
+save_destructor(f,p)
+void (*f) _((void*));
+void* p;
+{
+    SSCHECK(3);
+    SSPUSHDPTR(f);
+    SSPUSHPTR(p);
+    SSPUSHINT(SAVEt_DESTRUCTOR);
+}
+
+void
+leave_scope(base)
+I32 base;
+{
+    register SV *sv;
+    register SV *value;
+    register GV *gv;
+    register AV *av;
+    register HV *hv;
+    register void* ptr;
+
+    if (base < -1)
+	croak("panic: corrupt saved stack index");
+    while (savestack_ix > base) {
+	switch (SSPOPINT) {
+	case SAVEt_ITEM:			/* normal string */
+	    value = (SV*)SSPOPPTR;
+	    sv = (SV*)SSPOPPTR;
+	    sv_replace(sv,value);
+	    localizing = 2;
+	    SvSETMAGIC(sv);
+	    localizing = 0;
+	    break;
+        case SAVEt_SV:				/* scalar reference */
+	    value = (SV*)SSPOPPTR;
+	    gv = (GV*)SSPOPPTR;
+	    sv = GvSV(gv);
+	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
+		SvTYPE(sv) != SVt_PVGV)
+	    {
+		(void)SvUPGRADE(value, SvTYPE(sv));
+		SvMAGIC(value) = SvMAGIC(sv);
+		SvFLAGS(value) |= SvMAGICAL(sv);
+		SvMAGICAL_off(sv);
+		SvMAGIC(sv) = 0;
+	    }
+            SvREFCNT_dec(sv);
+            GvSV(gv) = value;
+	    localizing = 2;
+	    SvSETMAGIC(value);
+	    localizing = 0;
+            break;
+        case SAVEt_SVREF:			/* scalar reference */
+	    ptr = SSPOPPTR;
+	    sv = *(SV**)ptr;
+	    value = (SV*)SSPOPPTR;
+	    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
+		SvTYPE(sv) != SVt_PVGV)
+	    {
+		(void)SvUPGRADE(value, SvTYPE(sv));
+		SvMAGIC(value) = SvMAGIC(sv);
+		SvFLAGS(value) |= SvMAGICAL(sv);
+		SvMAGICAL_off(sv);
+		SvMAGIC(sv) = 0;
+	    }
+            SvREFCNT_dec(sv);
+	    *(SV**)ptr = value;
+	    localizing = 2;
+	    SvSETMAGIC(value);
+	    localizing = 0;
+            break;
+        case SAVEt_AV:				/* array reference */
+	    av = (AV*)SSPOPPTR;
+	    gv = (GV*)SSPOPPTR;
+            SvREFCNT_dec(GvAV(gv));
+            GvAV(gv) = av;
+            break;
+        case SAVEt_HV:				/* hash reference */
+	    hv = (HV*)SSPOPPTR;
+	    gv = (GV*)SSPOPPTR;
+            SvREFCNT_dec(GvHV(gv));
+            GvHV(gv) = hv;
+            break;
+	case SAVEt_INT:				/* int reference */
+	    ptr = SSPOPPTR;
+	    *(int*)ptr = (int)SSPOPINT;
+	    break;
+	case SAVEt_LONG:			/* long reference */
+	    ptr = SSPOPPTR;
+	    *(long*)ptr = (long)SSPOPLONG;
+	    break;
+	case SAVEt_I32:				/* I32 reference */
+	    ptr = SSPOPPTR;
+	    *(I32*)ptr = (I32)SSPOPINT;
+	    break;
+	case SAVEt_IV:				/* IV reference */
+	    ptr = SSPOPPTR;
+	    *(IV*)ptr = (IV)SSPOPIV;
+	    break;
+	case SAVEt_SPTR:			/* SV* reference */
+	    ptr = SSPOPPTR;
+	    *(SV**)ptr = (SV*)SSPOPPTR;
+	    break;
+	case SAVEt_PPTR:			/* char* reference */
+	    ptr = SSPOPPTR;
+	    *(char**)ptr = (char*)SSPOPPTR;
+	    break;
+	case SAVEt_HPTR:			/* HV* reference */
+	    ptr = SSPOPPTR;
+	    *(HV**)ptr = (HV*)SSPOPPTR;
+	    break;
+	case SAVEt_APTR:			/* AV* reference */
+	    ptr = SSPOPPTR;
+	    *(AV**)ptr = (AV*)SSPOPPTR;
+	    break;
+	case SAVEt_NSTAB:
+	    gv = (GV*)SSPOPPTR;
+	    (void)sv_clear(gv);
+	    break;
+        case SAVEt_GP:				/* scalar reference */
+	    ptr = SSPOPPTR;
+	    gv = (GV*)SSPOPPTR;
+            gp_free(gv);
+            GvGP(gv) = (GP*)ptr;
+	    SvREFCNT_dec(gv);
+            break;
+	case SAVEt_FREESV:
+	    ptr = SSPOPPTR;
+	    SvREFCNT_dec((SV*)ptr);
+	    break;
+	case SAVEt_FREEOP:
+	    ptr = SSPOPPTR;
+	    curpad = AvARRAY(comppad);
+	    op_free((OP*)ptr);
+	    break;
+	case SAVEt_FREEPV:
+	    ptr = SSPOPPTR;
+	    Safefree((char*)ptr);
+	    break;
+	case SAVEt_CLEARSV:
+	    ptr = (void*)&curpad[SSPOPLONG];
+	    sv = *(SV**)ptr;
+	    if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */
+		if (SvTHINKFIRST(sv)) {
+		    if (SvREADONLY(sv))
+			croak("panic: leave_scope clearsv");
+		    if (SvROK(sv))
+			sv_unref(sv);
+		}
+		if (SvMAGICAL(sv))
+		    mg_free(sv);
+
+		switch (SvTYPE(sv)) {
+		case SVt_NULL:
+		    break;
+		case SVt_PVAV:
+		    av_clear((AV*)sv);
+		    break;
+		case SVt_PVHV:
+		    hv_clear((HV*)sv);
+		    break;
+		case SVt_PVCV:
+		    sub_generation++;
+		    cv_undef((CV*)sv);
+		    break;
+		default:
+		    if (SvPOK(sv) && SvLEN(sv))
+			(void)SvOOK_off(sv);
+		    (void)SvOK_off(sv);
+		    break;
+		}
+	    }
+	    else {	/* Someone has a claim on this, so abandon it. */
+		U32 padflags = SvFLAGS(sv) & (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP);
+		SvREFCNT_dec(sv);	/* Cast current value to the winds. */
+		switch (SvTYPE(sv)) {	/* Console ourselves with a new value */
+		case SVt_PVAV:	*(SV**)ptr = (SV*)newAV();	break;
+		case SVt_PVHV:	*(SV**)ptr = (SV*)newHV();	break;
+		default:	*(SV**)ptr = NEWSV(0,0);	break;
+		}
+		SvFLAGS(*(SV**)ptr) |= padflags; /* preserve pad nature */
+	    }
+	    break;
+	case SAVEt_DELETE:
+	    ptr = SSPOPPTR;
+	    hv = (HV*)ptr;
+	    ptr = SSPOPPTR;
+	    (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
+	    Safefree(ptr);
+	    break;
+	case SAVEt_DESTRUCTOR:
+	    ptr = SSPOPPTR;
+	    (*SSPOPDPTR)(ptr);
+	    break;
+	case SAVEt_REGCONTEXT:
+	    {
+		I32 delta = SSPOPINT;
+		savestack_ix -= delta;	/* regexp must have croaked */
+	    }
+	    break;
+	default:
+	    croak("panic: leave_scope inconsistency");
+	}
+    }
+}
+
+#ifdef DEBUGGING
+void
+cx_dump(cx)
+CONTEXT* cx;
+{
+    fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]);
+    if (cx->cx_type != CXt_SUBST) {
+	fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
+	fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
+	fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
+	fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp);
+	fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp);
+	fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
+	fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
+    }
+    switch (cx->cx_type) {
+    case CXt_NULL:
+    case CXt_BLOCK:
+	break;
+    case CXt_SUB:
+	fprintf(stderr, "BLK_SUB.CV = 0x%lx\n",
+		(long)cx->blk_sub.cv);
+	fprintf(stderr, "BLK_SUB.GV = 0x%lx\n",
+		(long)cx->blk_sub.gv);
+	fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n",
+		(long)cx->blk_sub.dfoutgv);
+	fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n",
+		(long)cx->blk_sub.olddepth);
+	fprintf(stderr, "BLK_SUB.HASARGS = %d\n",
+		(int)cx->blk_sub.hasargs);
+	break;
+    case CXt_EVAL:
+	fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
+		(long)cx->blk_eval.old_in_eval);
+	fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
+		op_name[cx->blk_eval.old_op_type],
+		op_desc[cx->blk_eval.old_op_type]);
+	fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n",
+		cx->blk_eval.old_name);
+	fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
+		(long)cx->blk_eval.old_eval_root);
+	break;
+
+    case CXt_LOOP:
+	fprintf(stderr, "BLK_LOOP.LABEL = %s\n",
+		cx->blk_loop.label);
+	fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n",
+		(long)cx->blk_loop.resetsp);
+	fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n",
+		(long)cx->blk_loop.redo_op);
+	fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n",
+		(long)cx->blk_loop.next_op);
+	fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n",
+		(long)cx->blk_loop.last_op);
+	fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n",
+		(long)cx->blk_loop.iterix);
+	fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n",
+		(long)cx->blk_loop.iterary);
+	fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n",
+		(long)cx->blk_loop.itervar);
+	if (cx->blk_loop.itervar)
+	    fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n",
+		(long)cx->blk_loop.itersave);
+	break;
+
+    case CXt_SUBST:
+	fprintf(stderr, "SB_ITERS = %ld\n",
+		(long)cx->sb_iters);
+	fprintf(stderr, "SB_MAXITERS = %ld\n",
+		(long)cx->sb_maxiters);
+	fprintf(stderr, "SB_SAFEBASE = %ld\n",
+		(long)cx->sb_safebase);
+	fprintf(stderr, "SB_ONCE = %ld\n",
+		(long)cx->sb_once);
+	fprintf(stderr, "SB_ORIG = %s\n",
+		cx->sb_orig);
+	fprintf(stderr, "SB_DSTR = 0x%lx\n",
+		(long)cx->sb_dstr);
+	fprintf(stderr, "SB_TARG = 0x%lx\n",
+		(long)cx->sb_targ);
+	fprintf(stderr, "SB_S = 0x%lx\n",
+		(long)cx->sb_s);
+	fprintf(stderr, "SB_M = 0x%lx\n",
+		(long)cx->sb_m);
+	fprintf(stderr, "SB_STREND = 0x%lx\n",
+		(long)cx->sb_strend);
+	fprintf(stderr, "SB_SUBBASE = 0x%lx\n",
+		(long)cx->sb_subbase);
+	break;
+    }
+}
+#endif
diff --git a/gnu/usr.bin/perl/scope.h b/gnu/usr.bin/perl/scope.h
new file mode 100644
index 00000000000..8845e7cfec0
--- /dev/null
+++ b/gnu/usr.bin/perl/scope.h
@@ -0,0 +1,58 @@
+#define SAVEt_ITEM	0
+#define SAVEt_SV	1
+#define SAVEt_AV	2
+#define SAVEt_HV	3
+#define SAVEt_INT	4
+#define SAVEt_LONG	5
+#define SAVEt_I32	6
+#define SAVEt_IV	7
+#define SAVEt_SPTR	8
+#define SAVEt_APTR	9
+#define SAVEt_HPTR	10
+#define SAVEt_PPTR	11
+#define SAVEt_NSTAB	12
+#define SAVEt_SVREF	13
+#define SAVEt_GP	14
+#define SAVEt_FREESV	15
+#define SAVEt_FREEOP	16
+#define SAVEt_FREEPV	17
+#define SAVEt_CLEARSV	18
+#define SAVEt_DELETE	19
+#define SAVEt_DESTRUCTOR 20
+#define SAVEt_REGCONTEXT 21
+
+#define SSCHECK(need) if (savestack_ix + need > savestack_max) savestack_grow()
+#define SSPUSHINT(i) (savestack[savestack_ix++].any_i32 = (I32)(i))
+#define SSPUSHLONG(i) (savestack[savestack_ix++].any_long = (long)(i))
+#define SSPUSHIV(i) (savestack[savestack_ix++].any_iv = (IV)(i))
+#define SSPUSHPTR(p) (savestack[savestack_ix++].any_ptr = (void*)(p))
+#define SSPUSHDPTR(p) (savestack[savestack_ix++].any_dptr = (p))
+#define SSPOPINT (savestack[--savestack_ix].any_i32)
+#define SSPOPLONG (savestack[--savestack_ix].any_long)
+#define SSPOPIV (savestack[--savestack_ix].any_iv)
+#define SSPOPPTR (savestack[--savestack_ix].any_ptr)
+#define SSPOPDPTR (savestack[--savestack_ix].any_dptr)
+
+#define SAVETMPS save_int((int*)&tmps_floor), tmps_floor = tmps_ix
+#define FREETMPS if (tmps_ix > tmps_floor) free_tmps()
+#ifdef DEPRECATED
+#define FREE_TMPS() FREETMPS
+#endif
+
+#define ENTER push_scope()
+#define LEAVE pop_scope()
+#define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old)
+
+#define SAVEINT(i) save_int((int*)(&i));
+#define SAVEIV(i) save_iv((IV*)(&i));
+#define SAVEI32(i) save_I32((I32*)(&i));
+#define SAVELONG(l) save_long((long*)(&l));
+#define SAVESPTR(s) save_sptr((SV**)(&s))
+#define SAVEPPTR(s) save_pptr((char**)(&s))
+#define SAVEFREESV(s) save_freesv((SV*)(s))
+#define SAVEFREEOP(o) save_freeop((OP*)(o))
+#define SAVEFREEPV(p) save_freepv((char*)(p))
+#define SAVECLEARSV(sv) save_clearsv((SV**)(&sv))
+#define SAVEDELETE(h,k,l) save_delete((HV*)(h), (char*)(k), (I32)l)
+#define SAVEDESTRUCTOR(f,p) save_destructor(f,(void*)p)
+
diff --git a/gnu/usr.bin/perl/sv.c b/gnu/usr.bin/perl/sv.c
new file mode 100644
index 00000000000..a1f1d607157
--- /dev/null
+++ b/gnu/usr.bin/perl/sv.c
@@ -0,0 +1,3677 @@
+/*    sv.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "I wonder what the Entish is for 'yes' and 'no'," he thought.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef OVR_DBL_DIG
+/* Use an overridden DBL_DIG */
+# ifdef DBL_DIG
+#  undef DBL_DIG
+# endif
+# define DBL_DIG OVR_DBL_DIG
+#else
+/* The following is all to get DBL_DIG, in order to pick a nice
+   default value for printing floating point numbers in Gconvert.
+   (see config.h)
+*/
+#ifdef I_LIMITS
+#include <limits.h>
+#endif
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifndef HAS_DBL_DIG
+#define DBL_DIG	15   /* A guess that works lots of places */
+#endif
+#endif
+
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+#  define FAST_SV_GETS
+#endif
+
+static SV *more_sv _((void));
+static XPVIV *more_xiv _((void));
+static XPVNV *more_xnv _((void));
+static XPV *more_xpv _((void));
+static XRV *more_xrv _((void));
+static SV *new_sv _((void));
+static XPVIV *new_xiv _((void));
+static XPVNV *new_xnv _((void));
+static XPV *new_xpv _((void));
+static XRV *new_xrv _((void));
+static void del_xiv _((XPVIV* p));
+static void del_xnv _((XPVNV* p));
+static void del_xpv _((XPV* p));
+static void del_xrv _((XRV* p));
+static void sv_mortalgrow _((void));
+
+static void sv_unglob _((SV* sv));
+
+#ifdef PURIFY
+
+#define new_SV() sv = (SV*)safemalloc(sizeof(SV))
+#define del_SV(p) free((char*)p)
+
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
+{
+    if (!(flags & SVf_FAKE))
+	free(ptr);
+}
+
+#else
+
+#define new_SV()			\
+    if (sv_root) {			\
+	sv = sv_root;			\
+	sv_root = (SV*)SvANY(sv);	\
+	++sv_count;			\
+    }					\
+    else				\
+	sv = more_sv();
+
+static SV*
+new_sv()
+{
+    SV* sv;
+    if (sv_root) {
+	sv = sv_root;
+	sv_root = (SV*)SvANY(sv);
+	++sv_count;
+	return sv;
+    }
+    return more_sv();
+}
+
+#ifdef DEBUGGING
+#define del_SV(p)			\
+    if (debug & 32768)			\
+	del_sv(p);			\
+    else {				\
+	SvANY(p) = (void *)sv_root;	\
+	sv_root = p;			\
+	--sv_count;			\
+    }
+
+static void
+del_sv(p)
+SV* p;
+{
+    if (debug & 32768) {
+	SV* sva;
+	SV* sv;
+	SV* svend;
+	int ok = 0;
+	for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+	    sv = sva + 1;
+	    svend = &sva[SvREFCNT(sva)];
+	    if (p >= sv && p < svend)
+		ok = 1;
+	}
+	if (!ok) {
+	    warn("Attempt to free non-arena SV: 0x%lx", (unsigned long)p);
+	    return;
+	}
+    }
+    SvANY(p) = (void *) sv_root;
+    sv_root = p;
+    --sv_count;
+}
+#else
+#define del_SV(p)			\
+    SvANY(p) = (void *)sv_root;		\
+    sv_root = p;			\
+    --sv_count;
+
+#endif
+
+void
+sv_add_arena(ptr, size, flags)
+char* ptr;
+U32 size;
+U32 flags;
+{
+    SV* sva = (SV*)ptr;
+    register SV* sv;
+    register SV* svend;
+    Zero(sva, size, char);
+
+    /* The first SV in an arena isn't an SV. */
+    SvANY(sva) = (void *) sv_arenaroot;		/* ptr to next arena */
+    SvREFCNT(sva) = size / sizeof(SV);		/* number of SV slots */
+    SvFLAGS(sva) = flags;			/* FAKE if not to be freed */
+
+    sv_arenaroot = sva;
+    sv_root = sva + 1;
+
+    svend = &sva[SvREFCNT(sva) - 1];
+    sv = sva + 1;
+    while (sv < svend) {
+	SvANY(sv) = (void *)(SV*)(sv + 1);
+	SvFLAGS(sv) = SVTYPEMASK;
+	sv++;
+    }
+    SvANY(sv) = 0;
+    SvFLAGS(sv) = SVTYPEMASK;
+}
+
+static SV*
+more_sv()
+{
+    if (nice_chunk) {
+	sv_add_arena(nice_chunk, nice_chunk_size, 0);
+	nice_chunk = Nullch;
+    }
+    else
+	sv_add_arena(safemalloc(1008), 1008, 0);
+    return new_sv();
+}
+#endif
+
+void
+sv_report_used()
+{
+    SV* sva;
+    SV* sv;
+    register SV* svend;
+
+    for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+	sv = sva + 1;
+	svend = &sva[SvREFCNT(sva)];
+	while (sv < svend) {
+	    if (SvTYPE(sv) != SVTYPEMASK) {
+		fprintf(stderr, "****\n");
+		sv_dump(sv);
+	    }
+	    ++sv;
+	}
+    }
+}
+
+void
+sv_clean_objs()
+{
+    SV* sva;
+    register SV* sv;
+    register SV* svend;
+    SV* rv;
+
+#ifndef DISABLE_DESTRUCTOR_KLUDGE
+    register GV* gv;
+    for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+	gv = sva + 1;
+	svend = &sva[SvREFCNT(sva)];
+	while (gv < svend) {
+	    if (SvTYPE(gv) == SVt_PVGV && (sv = GvSV(gv)) &&
+		SvROK(sv) && SvOBJECT(rv = SvRV(sv)))
+	    {
+		DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
+			 sv_dump(sv));)
+		SvROK_off(sv);
+		SvRV(sv) = 0;
+		SvREFCNT_dec(rv);
+	    }
+	    ++gv;
+	}
+    }
+    if (!sv_objcount)
+	return;
+#endif
+    for (sva = sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
+	sv = sva + 1;
+	svend = &sva[SvREFCNT(sva)];
+	while (sv < svend) {
+	    if (SvROK(sv) && SvOBJECT(rv = SvRV(sv))) {
+		DEBUG_D((fprintf(stderr, "Cleaning object ref:\n "),
+			 sv_dump(sv));)
+		SvROK_off(sv);
+		SvRV(sv) = 0;
+		SvREFCNT_dec(rv);
+	    }
+	    /* XXX Might want to check arrays, etc. */
+	    ++sv;
+	}
+    }
+}
+
+void
+sv_clean_all()
+{
+    SV* sva;
+    register SV* sv;
+    register SV* svend;
+
+    for (sva = sv_arenaroot; sva; sva = (SV*) SvANY(sva)) {
+	sv = sva + 1;
+	svend = &sva[SvREFCNT(sva)];
+	while (sv < svend) {
+	    if (SvTYPE(sv) != SVTYPEMASK) {
+		DEBUG_D((fprintf(stderr, "Cleaning loops:\n "), sv_dump(sv));)
+		SvFLAGS(sv) |= SVf_BREAK;
+		SvREFCNT_dec(sv);
+	    }
+	    ++sv;
+	}
+    }
+}
+
+void
+sv_free_arenas()
+{
+    SV* sva;
+    SV* svanext;
+
+    /* Free arenas here, but be careful about fake ones.  (We assume
+       contiguity of the fake ones with the corresponding real ones.) */
+
+    for (sva = sv_arenaroot; sva; sva = svanext) {
+	svanext = (SV*) SvANY(sva);
+	while (svanext && SvFAKE(svanext))
+	    svanext = (SV*) SvANY(svanext);
+
+	if (!SvFAKE(sva))
+	    Safefree(sva);
+    }
+}
+
+static XPVIV*
+new_xiv()
+{
+    IV** xiv;
+    if (xiv_root) {
+	xiv = xiv_root;
+	/*
+	 * See comment in more_xiv() -- RAM.
+	 */
+	xiv_root = (IV**)*xiv;
+	return (XPVIV*)((char*)xiv - sizeof(XPV));
+    }
+    return more_xiv();
+}
+
+static void
+del_xiv(p)
+XPVIV* p;
+{
+    IV** xiv = (IV**)((char*)(p) + sizeof(XPV));
+    *xiv = (IV *)xiv_root;
+    xiv_root = xiv;
+}
+
+static XPVIV*
+more_xiv()
+{
+    register IV** xiv;
+    register IV** xivend;
+    XPV* ptr = (XPV*)safemalloc(1008);
+    ptr->xpv_pv = (char*)xiv_arenaroot;		/* linked list of xiv arenas */
+    xiv_arenaroot = ptr;			/* to keep Purify happy */
+
+    xiv = (IV**) ptr;
+    xivend = &xiv[1008 / sizeof(IV *) - 1];
+    xiv += (sizeof(XPV) - 1) / sizeof(IV *) + 1;   /* fudge by size of XPV */
+    xiv_root = xiv;
+    while (xiv < xivend) {
+	*xiv = (IV *)(xiv + 1);
+	xiv++;
+    }
+    *xiv = 0;
+    return new_xiv();
+}
+
+static XPVNV*
+new_xnv()
+{
+    double* xnv;
+    if (xnv_root) {
+	xnv = xnv_root;
+	xnv_root = *(double**)xnv;
+	return (XPVNV*)((char*)xnv - sizeof(XPVIV));
+    }
+    return more_xnv();
+}
+
+static void
+del_xnv(p)
+XPVNV* p;
+{
+    double* xnv = (double*)((char*)(p) + sizeof(XPVIV));
+    *(double**)xnv = xnv_root;
+    xnv_root = xnv;
+}
+
+static XPVNV*
+more_xnv()
+{
+    register double* xnv;
+    register double* xnvend;
+    xnv = (double*)safemalloc(1008);
+    xnvend = &xnv[1008 / sizeof(double) - 1];
+    xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
+    xnv_root = xnv;
+    while (xnv < xnvend) {
+	*(double**)xnv = (double*)(xnv + 1);
+	xnv++;
+    }
+    *(double**)xnv = 0;
+    return new_xnv();
+}
+
+static XRV*
+new_xrv()
+{
+    XRV* xrv;
+    if (xrv_root) {
+	xrv = xrv_root;
+	xrv_root = (XRV*)xrv->xrv_rv;
+	return xrv;
+    }
+    return more_xrv();
+}
+
+static void
+del_xrv(p)
+XRV* p;
+{
+    p->xrv_rv = (SV*)xrv_root;
+    xrv_root = p;
+}
+
+static XRV*
+more_xrv()
+{
+    register XRV* xrv;
+    register XRV* xrvend;
+    xrv_root = (XRV*)safemalloc(1008);
+    xrv = xrv_root;
+    xrvend = &xrv[1008 / sizeof(XRV) - 1];
+    while (xrv < xrvend) {
+	xrv->xrv_rv = (SV*)(xrv + 1);
+	xrv++;
+    }
+    xrv->xrv_rv = 0;
+    return new_xrv();
+}
+
+static XPV*
+new_xpv()
+{
+    XPV* xpv;
+    if (xpv_root) {
+	xpv = xpv_root;
+	xpv_root = (XPV*)xpv->xpv_pv;
+	return xpv;
+    }
+    return more_xpv();
+}
+
+static void
+del_xpv(p)
+XPV* p;
+{
+    p->xpv_pv = (char*)xpv_root;
+    xpv_root = p;
+}
+
+static XPV*
+more_xpv()
+{
+    register XPV* xpv;
+    register XPV* xpvend;
+    xpv_root = (XPV*)safemalloc(1008);
+    xpv = xpv_root;
+    xpvend = &xpv[1008 / sizeof(XPV) - 1];
+    while (xpv < xpvend) {
+	xpv->xpv_pv = (char*)(xpv + 1);
+	xpv++;
+    }
+    xpv->xpv_pv = 0;
+    return new_xpv();
+}
+
+#ifdef PURIFY
+#define new_XIV() (void*)safemalloc(sizeof(XPVIV))
+#define del_XIV(p) free((char*)p)
+#else
+#define new_XIV() (void*)new_xiv()
+#define del_XIV(p) del_xiv(p)
+#endif
+
+#ifdef PURIFY
+#define new_XNV() (void*)safemalloc(sizeof(XPVNV))
+#define del_XNV(p) free((char*)p)
+#else
+#define new_XNV() (void*)new_xnv()
+#define del_XNV(p) del_xnv(p)
+#endif
+
+#ifdef PURIFY
+#define new_XRV() (void*)safemalloc(sizeof(XRV))
+#define del_XRV(p) free((char*)p)
+#else
+#define new_XRV() (void*)new_xrv()
+#define del_XRV(p) del_xrv(p)
+#endif
+
+#ifdef PURIFY
+#define new_XPV() (void*)safemalloc(sizeof(XPV))
+#define del_XPV(p) free((char*)p)
+#else
+#define new_XPV() (void*)new_xpv()
+#define del_XPV(p) del_xpv(p)
+#endif
+
+#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p) free((char*)p)
+
+#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p) free((char*)p)
+
+#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p) free((char*)p)
+
+#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p) free((char*)p)
+
+#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p) free((char*)p)
+
+#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p) free((char*)p)
+
+#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p) free((char*)p)
+
+#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p) free((char*)p)
+
+#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p) free((char*)p)
+
+#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
+#define del_XPVFM(p) free((char*)p)
+
+#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
+#define del_XPVIO(p) free((char*)p)
+
+bool
+sv_upgrade(sv, mt)
+register SV* sv;
+U32 mt;
+{
+    char*	pv;
+    U32		cur;
+    U32		len;
+    IV		iv;
+    double	nv;
+    MAGIC*	magic;
+    HV*		stash;
+
+    if (SvTYPE(sv) == mt)
+	return TRUE;
+
+    if (mt < SVt_PVIV)
+	(void)SvOOK_off(sv);
+
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	pv	= 0;
+	cur	= 0;
+	len	= 0;
+	iv	= 0;
+	nv	= 0.0;
+	magic	= 0;
+	stash	= 0;
+	break;
+    case SVt_IV:
+	pv	= 0;
+	cur	= 0;
+	len	= 0;
+	iv	= SvIVX(sv);
+	nv	= (double)SvIVX(sv);
+	del_XIV(SvANY(sv));
+	magic	= 0;
+	stash	= 0;
+	if (mt == SVt_NV)
+	    mt = SVt_PVNV;
+	else if (mt < SVt_PVIV)
+	    mt = SVt_PVIV;
+	break;
+    case SVt_NV:
+	pv	= 0;
+	cur	= 0;
+	len	= 0;
+	nv	= SvNVX(sv);
+	iv	= I_32(nv);
+	magic	= 0;
+	stash	= 0;
+	del_XNV(SvANY(sv));
+	SvANY(sv) = 0;
+	if (mt < SVt_PVNV)
+	    mt = SVt_PVNV;
+	break;
+    case SVt_RV:
+	pv	= (char*)SvRV(sv);
+	cur	= 0;
+	len	= 0;
+	iv	= (IV)pv;
+	nv	= (double)(unsigned long)pv;
+	del_XRV(SvANY(sv));
+	magic	= 0;
+	stash	= 0;
+	break;
+    case SVt_PV:
+	nv = 0.0;
+	pv	= SvPVX(sv);
+	cur	= SvCUR(sv);
+	len	= SvLEN(sv);
+	iv	= 0;
+	nv	= 0.0;
+	magic	= 0;
+	stash	= 0;
+	del_XPV(SvANY(sv));
+	if (mt <= SVt_IV)
+	    mt = SVt_PVIV;
+	else if (mt == SVt_NV)
+	    mt = SVt_PVNV;
+	break;
+    case SVt_PVIV:
+	nv = 0.0;
+	pv	= SvPVX(sv);
+	cur	= SvCUR(sv);
+	len	= SvLEN(sv);
+	iv	= SvIVX(sv);
+	nv	= 0.0;
+	magic	= 0;
+	stash	= 0;
+	del_XPVIV(SvANY(sv));
+	break;
+    case SVt_PVNV:
+	nv = SvNVX(sv);
+	pv	= SvPVX(sv);
+	cur	= SvCUR(sv);
+	len	= SvLEN(sv);
+	iv	= SvIVX(sv);
+	nv	= SvNVX(sv);
+	magic	= 0;
+	stash	= 0;
+	del_XPVNV(SvANY(sv));
+	break;
+    case SVt_PVMG:
+	pv	= SvPVX(sv);
+	cur	= SvCUR(sv);
+	len	= SvLEN(sv);
+	iv	= SvIVX(sv);
+	nv	= SvNVX(sv);
+	magic	= SvMAGIC(sv);
+	stash	= SvSTASH(sv);
+	del_XPVMG(SvANY(sv));
+	break;
+    default:
+	croak("Can't upgrade that kind of scalar");
+    }
+
+    switch (mt) {
+    case SVt_NULL:
+	croak("Can't upgrade to undef");
+    case SVt_IV:
+	SvANY(sv) = new_XIV();
+	SvIVX(sv)	= iv;
+	break;
+    case SVt_NV:
+	SvANY(sv) = new_XNV();
+	SvNVX(sv)	= nv;
+	break;
+    case SVt_RV:
+	SvANY(sv) = new_XRV();
+	SvRV(sv) = (SV*)pv;
+	break;
+    case SVt_PV:
+	SvANY(sv) = new_XPV();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	break;
+    case SVt_PVIV:
+	SvANY(sv) = new_XPVIV();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	if (SvNIOK(sv))
+	    (void)SvIOK_on(sv);
+	SvNOK_off(sv);
+	break;
+    case SVt_PVNV:
+	SvANY(sv) = new_XPVNV();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	break;
+    case SVt_PVMG:
+	SvANY(sv) = new_XPVMG();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	break;
+    case SVt_PVLV:
+	SvANY(sv) = new_XPVLV();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	LvTARGOFF(sv)	= 0;
+	LvTARGLEN(sv)	= 0;
+	LvTARG(sv)	= 0;
+	LvTYPE(sv)	= 0;
+	break;
+    case SVt_PVAV:
+	SvANY(sv) = new_XPVAV();
+	if (pv)
+	    Safefree(pv);
+	SvPVX(sv)	= 0;
+	AvMAX(sv)	= 0;
+	AvFILL(sv)	= 0;
+	SvIVX(sv)	= 0;
+	SvNVX(sv)	= 0.0;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	AvALLOC(sv)	= 0;
+	AvARYLEN(sv)	= 0;
+	AvFLAGS(sv)	= 0;
+	break;
+    case SVt_PVHV:
+	SvANY(sv) = new_XPVHV();
+	if (pv)
+	    Safefree(pv);
+	SvPVX(sv)	= 0;
+	HvFILL(sv)	= 0;
+	HvMAX(sv)	= 0;
+	HvKEYS(sv)	= 0;
+	SvNVX(sv)	= 0.0;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	HvRITER(sv)	= 0;
+	HvEITER(sv)	= 0;
+	HvPMROOT(sv)	= 0;
+	HvNAME(sv)	= 0;
+	break;
+    case SVt_PVCV:
+	SvANY(sv) = new_XPVCV();
+	Zero(SvANY(sv), 1, XPVCV);
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	break;
+    case SVt_PVGV:
+	SvANY(sv) = new_XPVGV();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	GvGP(sv)	= 0;
+	GvNAME(sv)	= 0;
+	GvNAMELEN(sv)	= 0;
+	GvSTASH(sv)	= 0;
+	GvFLAGS(sv)	= 0;
+	break;
+    case SVt_PVBM:
+	SvANY(sv) = new_XPVBM();
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	BmRARE(sv)	= 0;
+	BmUSEFUL(sv)	= 0;
+	BmPREVIOUS(sv)	= 0;
+	break;
+    case SVt_PVFM:
+	SvANY(sv) = new_XPVFM();
+	Zero(SvANY(sv), 1, XPVFM);
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	break;
+    case SVt_PVIO:
+	SvANY(sv) = new_XPVIO();
+	Zero(SvANY(sv), 1, XPVIO);
+	SvPVX(sv)	= pv;
+	SvCUR(sv)	= cur;
+	SvLEN(sv)	= len;
+	SvIVX(sv)	= iv;
+	SvNVX(sv)	= nv;
+	SvMAGIC(sv)	= magic;
+	SvSTASH(sv)	= stash;
+	IoPAGE_LEN(sv)	= 60;
+	break;
+    }
+    SvFLAGS(sv) &= ~SVTYPEMASK;
+    SvFLAGS(sv) |= mt;
+    return TRUE;
+}
+
+#ifdef DEBUGGING
+char *
+sv_peek(sv)
+register SV *sv;
+{
+    char *t = tokenbuf;
+    int unref = 0;
+
+  retry:
+    if (!sv) {
+	strcpy(t, "VOID");
+	goto finish;
+    }
+    else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') {
+	strcpy(t, "WILD");
+	goto finish;
+    }
+    else if (sv == &sv_undef || sv == &sv_no || sv == &sv_yes) {
+	if (sv == &sv_undef) {
+	    strcpy(t, "SV_UNDEF");
+	    if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT|
+				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
+		SvREADONLY(sv))
+		goto finish;
+	}
+	else if (sv == &sv_no) {
+	    strcpy(t, "SV_NO");
+	    if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
+				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
+		!(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
+				  SVp_POK|SVp_NOK)) &&
+		SvCUR(sv) == 0 &&
+		SvNVX(sv) == 0.0)
+		goto finish;
+	}
+	else {
+	    strcpy(t, "SV_YES");
+	    if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT|
+				 SVs_GMG|SVs_SMG|SVs_RMG)) &&
+		!(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY|
+				  SVp_POK|SVp_NOK)) &&
+		SvCUR(sv) == 1 &&
+		SvPVX(sv) && *SvPVX(sv) == '1' &&
+		SvNVX(sv) == 1.0)
+		goto finish;
+	}
+	t += strlen(t);
+	*t++ = ':';
+    }
+    else if (SvREFCNT(sv) == 0) {
+	*t++ = '(';
+	unref++;
+    }
+    if (SvROK(sv)) {
+	*t++ = '\\';
+	if (t - tokenbuf + unref > 10) {
+	    strcpy(tokenbuf + unref + 3,"...");
+	    goto finish;
+	}
+	sv = (SV*)SvRV(sv);
+	goto retry;
+    }
+    switch (SvTYPE(sv)) {
+    default:
+	strcpy(t,"FREED");
+	goto finish;
+
+    case SVt_NULL:
+	strcpy(t,"UNDEF");
+	return tokenbuf;
+    case SVt_IV:
+	strcpy(t,"IV");
+	break;
+    case SVt_NV:
+	strcpy(t,"NV");
+	break;
+    case SVt_RV:
+	strcpy(t,"RV");
+	break;
+    case SVt_PV:
+	strcpy(t,"PV");
+	break;
+    case SVt_PVIV:
+	strcpy(t,"PVIV");
+	break;
+    case SVt_PVNV:
+	strcpy(t,"PVNV");
+	break;
+    case SVt_PVMG:
+	strcpy(t,"PVMG");
+	break;
+    case SVt_PVLV:
+	strcpy(t,"PVLV");
+	break;
+    case SVt_PVAV:
+	strcpy(t,"AV");
+	break;
+    case SVt_PVHV:
+	strcpy(t,"HV");
+	break;
+    case SVt_PVCV:
+	if (CvGV(sv))
+	    sprintf(t, "CV(%s)", GvNAME(CvGV(sv)));
+	else
+	    strcpy(t, "CV()");
+	goto finish;
+    case SVt_PVGV:
+	strcpy(t,"GV");
+	break;
+    case SVt_PVBM:
+	strcpy(t,"BM");
+	break;
+    case SVt_PVFM:
+	strcpy(t,"FM");
+	break;
+    case SVt_PVIO:
+	strcpy(t,"IO");
+	break;
+    }
+    t += strlen(t);
+
+    if (SvPOKp(sv)) {
+	if (!SvPVX(sv))
+	    strcpy(t, "(null)");
+	if (SvOOK(sv))
+	    sprintf(t,"(%ld+\"%.127s\")",(long)SvIVX(sv),SvPVX(sv));
+	else
+	    sprintf(t,"(\"%.127s\")",SvPVX(sv));
+    }
+    else if (SvNOKp(sv))
+	sprintf(t,"(%g)",SvNVX(sv));
+    else if (SvIOKp(sv))
+	sprintf(t,"(%ld)",(long)SvIVX(sv));
+    else
+	strcpy(t,"()");
+    
+  finish:
+    if (unref) {
+	t += strlen(t);
+	while (unref--)
+	    *t++ = ')';
+	*t = '\0';
+    }
+    return tokenbuf;
+}
+#endif
+
+int
+sv_backoff(sv)
+register SV *sv;
+{
+    assert(SvOOK(sv));
+    if (SvIVX(sv)) {
+	char *s = SvPVX(sv);
+	SvLEN(sv) += SvIVX(sv);
+	SvPVX(sv) -= SvIVX(sv);
+	SvIV_set(sv, 0);
+	Move(s, SvPVX(sv), SvCUR(sv)+1, char);
+    }
+    SvFLAGS(sv) &= ~SVf_OOK;
+    return 0;
+}
+
+char *
+sv_grow(sv,newlen)
+register SV *sv;
+#ifndef DOSISH
+register I32 newlen;
+#else
+unsigned long newlen;
+#endif
+{
+    register char *s;
+
+#ifdef MSDOS
+    if (newlen >= 0x10000) {
+	fprintf(stderr, "Allocation too large: %lx\n", newlen);
+	my_exit(1);
+    }
+#endif /* MSDOS */
+    if (SvROK(sv))
+	sv_unref(sv);
+    if (SvTYPE(sv) < SVt_PV) {
+	sv_upgrade(sv, SVt_PV);
+	s = SvPVX(sv);
+    }
+    else if (SvOOK(sv)) {	/* pv is offset? */
+	sv_backoff(sv);
+	s = SvPVX(sv);
+	if (newlen > SvLEN(sv))
+	    newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */
+    }
+    else
+	s = SvPVX(sv);
+    if (newlen > SvLEN(sv)) {		/* need more room? */
+        if (SvLEN(sv) && s)
+	    Renew(s,newlen,char);
+        else
+	    New(703,s,newlen,char);
+	SvPV_set(sv, s);
+        SvLEN_set(sv, newlen);
+    }
+    return s;
+}
+
+void
+sv_setiv(sv,i)
+register SV *sv;
+IV i;
+{
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	sv_upgrade(sv, SVt_IV);
+	break;
+    case SVt_NV:
+	sv_upgrade(sv, SVt_PVNV);
+	break;
+    case SVt_RV:
+    case SVt_PV:
+	sv_upgrade(sv, SVt_PVIV);
+	break;
+
+    case SVt_PVGV:
+	if (SvFAKE(sv)) {
+	    sv_unglob(sv);
+	    break;
+	}
+	/* FALL THROUGH */
+    case SVt_PVAV:
+    case SVt_PVHV:
+    case SVt_PVCV:
+    case SVt_PVFM:
+    case SVt_PVIO:
+	croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
+	    op_name[op->op_type]);
+    }
+    (void)SvIOK_only(sv);			/* validate number */
+    SvIVX(sv) = i;
+    SvTAINT(sv);
+}
+
+void
+sv_setnv(sv,num)
+register SV *sv;
+double num;
+{
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+    case SVt_IV:
+	sv_upgrade(sv, SVt_NV);
+	break;
+    case SVt_NV:
+    case SVt_RV:
+    case SVt_PV:
+    case SVt_PVIV:
+	sv_upgrade(sv, SVt_PVNV);
+	/* FALL THROUGH */
+    case SVt_PVNV:
+    case SVt_PVMG:
+    case SVt_PVBM:
+    case SVt_PVLV:
+	if (SvOOK(sv))
+	    (void)SvOOK_off(sv);
+	break;
+    case SVt_PVGV:
+	if (SvFAKE(sv)) {
+	    sv_unglob(sv);
+	    break;
+	}
+	/* FALL THROUGH */
+    case SVt_PVAV:
+    case SVt_PVHV:
+    case SVt_PVCV:
+    case SVt_PVFM:
+    case SVt_PVIO:
+	croak("Can't coerce %s to number in %s", sv_reftype(sv,0),
+	    op_name[op->op_type]);
+    }
+    SvNVX(sv) = num;
+    (void)SvNOK_only(sv);			/* validate number */
+    SvTAINT(sv);
+}
+
+static void
+not_a_number(sv)
+SV *sv;
+{
+    char tmpbuf[64];
+    char *d = tmpbuf;
+    char *s;
+    int i;
+
+    for (s = SvPVX(sv), i = 50; *s && i; s++,i--) {
+	int ch = *s;
+	if (ch & 128 && !isprint(ch)) {
+	    *d++ = 'M';
+	    *d++ = '-';
+	    ch &= 127;
+	}
+	if (isprint(ch))
+	    *d++ = ch;
+	else {
+	    *d++ = '^';
+	    *d++ = ch ^ 64;
+	}
+    }
+    if (*s) {
+	*d++ = '.';
+	*d++ = '.';
+	*d++ = '.';
+    }
+    *d = '\0';
+
+    if (op)
+	warn("Argument \"%s\" isn't numeric in %s", tmpbuf,
+		op_name[op->op_type]);
+    else
+	warn("Argument \"%s\" isn't numeric", tmpbuf);
+}
+
+IV
+sv_2iv(sv)
+register SV *sv;
+{
+    if (!sv)
+	return 0;
+    if (SvGMAGICAL(sv)) {
+	mg_get(sv);
+	if (SvIOKp(sv))
+	    return SvIVX(sv);
+	if (SvNOKp(sv)) {
+	    if (SvNVX(sv) < 0.0)
+		return I_V(SvNVX(sv));
+	    else
+		return (IV) U_V(SvNVX(sv));
+	}
+	if (SvPOKp(sv) && SvLEN(sv)) {
+	    if (dowarn && !looks_like_number(sv))
+		not_a_number(sv);
+	    return (IV)atol(SvPVX(sv));
+	}
+        if (!SvROK(sv)) {
+            return 0;
+        }
+    }
+    if (SvTHINKFIRST(sv)) {
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	  SV* tmpstr;
+	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv, numer)))
+	    return SvIV(tmpstr);
+#endif /* OVERLOAD */
+	  return (IV)SvRV(sv);
+	}
+	if (SvREADONLY(sv)) {
+	    if (SvNOKp(sv)) {
+		if (SvNVX(sv) < 0.0)
+		    return I_V(SvNVX(sv));
+		else
+		    return (IV) U_V(SvNVX(sv));
+	    }
+	    if (SvPOKp(sv) && SvLEN(sv)) {
+		if (dowarn && !looks_like_number(sv))
+		    not_a_number(sv);
+		return (IV)atol(SvPVX(sv));
+	    }
+	    if (dowarn)
+		warn(warn_uninit);
+	    return 0;
+	}
+    }
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	sv_upgrade(sv, SVt_IV);
+	return SvIVX(sv);
+    case SVt_PV:
+	sv_upgrade(sv, SVt_PVIV);
+	break;
+    case SVt_NV:
+	sv_upgrade(sv, SVt_PVNV);
+	break;
+    }
+    if (SvNOKp(sv)) {
+	(void)SvIOK_on(sv);
+	if (SvNVX(sv) < 0.0)
+	    SvIVX(sv) = I_V(SvNVX(sv));
+	else
+	    SvIVX(sv) = (IV) U_V(SvNVX(sv));
+    }
+    else if (SvPOKp(sv) && SvLEN(sv)) {
+	if (dowarn && !looks_like_number(sv))
+	    not_a_number(sv);
+	(void)SvIOK_on(sv);
+	SvIVX(sv) = (IV)atol(SvPVX(sv));
+    }
+    else  {
+	if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	    warn(warn_uninit);
+	return 0;
+    }
+    DEBUG_c(fprintf(stderr,"0x%lx 2iv(%ld)\n",
+	(unsigned long)sv,(long)SvIVX(sv)));
+    return SvIVX(sv);
+}
+
+double
+sv_2nv(sv)
+register SV *sv;
+{
+    if (!sv)
+	return 0.0;
+    if (SvGMAGICAL(sv)) {
+	mg_get(sv);
+	if (SvNOKp(sv))
+	    return SvNVX(sv);
+	if (SvPOKp(sv) && SvLEN(sv)) {
+	    if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+		not_a_number(sv);
+	    return atof(SvPVX(sv));
+	}
+	if (SvIOKp(sv))
+	    return (double)SvIVX(sv);
+        if (!SvROK(sv)) {
+            return 0;
+        }
+    }
+    if (SvTHINKFIRST(sv)) {
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	  SV* tmpstr;
+	  if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,numer)))
+	    return SvNV(tmpstr);
+#endif /* OVERLOAD */
+	  return (double)(unsigned long)SvRV(sv);
+	}
+	if (SvREADONLY(sv)) {
+	    if (SvPOKp(sv) && SvLEN(sv)) {
+		if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+		    not_a_number(sv);
+		return atof(SvPVX(sv));
+	    }
+	    if (SvIOKp(sv))
+		return (double)SvIVX(sv);
+	    if (dowarn)
+		warn(warn_uninit);
+	    return 0.0;
+	}
+    }
+    if (SvTYPE(sv) < SVt_NV) {
+	if (SvTYPE(sv) == SVt_IV)
+	    sv_upgrade(sv, SVt_PVNV);
+	else
+	    sv_upgrade(sv, SVt_NV);
+	DEBUG_c(fprintf(stderr,"0x%lx num(%g)\n",(unsigned long)sv,SvNVX(sv)));
+    }
+    else if (SvTYPE(sv) < SVt_PVNV)
+	sv_upgrade(sv, SVt_PVNV);
+    if (SvIOKp(sv) &&
+	    (!SvPOKp(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv)))
+    {
+	SvNVX(sv) = (double)SvIVX(sv);
+    }
+    else if (SvPOKp(sv) && SvLEN(sv)) {
+	if (dowarn && !SvIOKp(sv) && !looks_like_number(sv))
+	    not_a_number(sv);
+	SvNVX(sv) = atof(SvPVX(sv));
+    }
+    else  {
+	if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	    warn(warn_uninit);
+	return 0.0;
+    }
+    SvNOK_on(sv);
+    DEBUG_c(fprintf(stderr,"0x%lx 2nv(%g)\n",(unsigned long)sv,SvNVX(sv)));
+    return SvNVX(sv);
+}
+
+char *
+sv_2pv(sv, lp)
+register SV *sv;
+STRLEN *lp;
+{
+    register char *s;
+    int olderrno;
+
+    if (!sv) {
+	*lp = 0;
+	return "";
+    }
+    if (SvGMAGICAL(sv)) {
+	mg_get(sv);
+	if (SvPOKp(sv)) {
+	    *lp = SvCUR(sv);
+	    return SvPVX(sv);
+	}
+	if (SvIOKp(sv)) {
+	    (void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+	    goto tokensave;
+	}
+	if (SvNOKp(sv)) {
+	    Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+	    goto tokensave;
+	}
+        if (!SvROK(sv)) {
+            *lp = 0;
+            return "";
+        }
+    }
+    if (SvTHINKFIRST(sv)) {
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	    SV* tmpstr;
+	    if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)))
+	      return SvPV(tmpstr,*lp);
+#endif /* OVERLOAD */
+	    sv = (SV*)SvRV(sv);
+	    if (!sv)
+		s = "NULLREF";
+	    else {
+		switch (SvTYPE(sv)) {
+		case SVt_NULL:
+		case SVt_IV:
+		case SVt_NV:
+		case SVt_RV:
+		case SVt_PV:
+		case SVt_PVIV:
+		case SVt_PVNV:
+		case SVt_PVBM:
+		case SVt_PVMG:	s = "SCALAR";			break;
+		case SVt_PVLV:	s = "LVALUE";			break;
+		case SVt_PVAV:	s = "ARRAY";			break;
+		case SVt_PVHV:	s = "HASH";			break;
+		case SVt_PVCV:	s = "CODE";			break;
+		case SVt_PVGV:	s = "GLOB";			break;
+		case SVt_PVFM:	s = "FORMATLINE";		break;
+		case SVt_PVIO:	s = "FILEHANDLE";		break;
+		default:	s = "UNKNOWN";			break;
+		}
+		if (SvOBJECT(sv))
+		    sprintf(tokenbuf, "%s=%s(0x%lx)",
+				HvNAME(SvSTASH(sv)), s, (unsigned long)sv);
+		else
+		    sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv);
+		goto tokensaveref;
+	    }
+	    *lp = strlen(s);
+	    return s;
+	}
+	if (SvREADONLY(sv)) {
+	    if (SvNOKp(sv)) {
+		Gconvert(SvNVX(sv), DBL_DIG, 0, tokenbuf);
+		goto tokensave;
+	    }
+	    if (SvIOKp(sv)) {
+		(void)sprintf(tokenbuf,"%ld",(long)SvIVX(sv));
+		goto tokensave;
+	    }
+	    if (dowarn)
+		warn(warn_uninit);
+	    *lp = 0;
+	    return "";
+	}
+    }
+    if (!SvUPGRADE(sv, SVt_PV))
+	return 0;
+    if (SvNOKp(sv)) {
+	if (SvTYPE(sv) < SVt_PVNV)
+	    sv_upgrade(sv, SVt_PVNV);
+	SvGROW(sv, 28);
+	s = SvPVX(sv);
+	olderrno = errno;	/* some Xenix systems wipe out errno here */
+#ifdef apollo
+	if (SvNVX(sv) == 0.0)
+	    (void)strcpy(s,"0");
+	else
+#endif /*apollo*/
+	    Gconvert(SvNVX(sv), DBL_DIG, 0, s);
+	errno = olderrno;
+#ifdef FIXNEGATIVEZERO
+        if (*s == '-' && s[1] == '0' && !s[2])
+	    strcpy(s,"0");
+#endif
+	while (*s) s++;
+#ifdef hcx
+	if (s[-1] == '.')
+	    s--;
+#endif
+    }
+    else if (SvIOKp(sv)) {
+	if (SvTYPE(sv) < SVt_PVIV)
+	    sv_upgrade(sv, SVt_PVIV);
+	SvGROW(sv, 11);
+	s = SvPVX(sv);
+	olderrno = errno;	/* some Xenix systems wipe out errno here */
+	(void)sprintf(s,"%ld",(long)SvIVX(sv));
+	errno = olderrno;
+	while (*s) s++;
+    }
+    else {
+	if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+	    warn(warn_uninit);
+	*lp = 0;
+	return "";
+    }
+    *s = '\0';
+    *lp = s - SvPVX(sv);
+    SvCUR_set(sv, *lp);
+    SvPOK_on(sv);
+    DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
+    return SvPVX(sv);
+
+  tokensave:
+    if (SvROK(sv)) {	/* XXX Skip this when sv_pvn_force calls */
+	/* Sneaky stuff here */
+
+      tokensaveref:
+	sv = sv_newmortal();
+	*lp = strlen(tokenbuf);
+	sv_setpvn(sv, tokenbuf, *lp);
+	return SvPVX(sv);
+    }
+    else {
+	STRLEN len;
+	
+#ifdef FIXNEGATIVEZERO
+	if (*tokenbuf == '-' && tokenbuf[1] == '0' && !tokenbuf[2])
+	    strcpy(tokenbuf,"0");
+#endif
+	(void)SvUPGRADE(sv, SVt_PV);
+	len = *lp = strlen(tokenbuf);
+	s = SvGROW(sv, len + 1);
+	SvCUR_set(sv, len);
+	(void)strcpy(s, tokenbuf);
+	/* NO SvPOK_on(sv) here! */
+	return s;
+    }
+}
+
+/* This function is only called on magical items */
+bool
+sv_2bool(sv)
+register SV *sv;
+{
+    if (SvGMAGICAL(sv))
+	mg_get(sv);
+
+    if (!SvOK(sv))
+	return 0;
+    if (SvROK(sv)) {
+#ifdef OVERLOAD
+      {
+	SV* tmpsv;
+	if (SvAMAGIC(sv) && (tmpsv = AMG_CALLun(sv,bool_)))
+	  return SvTRUE(tmpsv);
+      }
+#endif /* OVERLOAD */
+      return SvRV(sv) != 0;
+    }
+    if (SvPOKp(sv)) {
+	register XPV* Xpv;
+	if ((Xpv = (XPV*)SvANY(sv)) &&
+		(*Xpv->xpv_pv > '0' ||
+		Xpv->xpv_cur > 1 ||
+		(Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+	    return 1;
+	else
+	    return 0;
+    }
+    else {
+	if (SvIOKp(sv))
+	    return SvIVX(sv) != 0;
+	else {
+	    if (SvNOKp(sv))
+		return SvNVX(sv) != 0.0;
+	    else
+		return FALSE;
+	}
+    }
+}
+
+/* Note: sv_setsv() should not be called with a source string that needs
+ * to be reused, since it may destroy the source string if it is marked
+ * as temporary.
+ */
+
+void
+sv_setsv(dstr,sstr)
+SV *dstr;
+register SV *sstr;
+{
+    register U32 sflags;
+    register int dtype;
+    register int stype;
+
+    if (sstr == dstr)
+	return;
+    if (SvTHINKFIRST(dstr)) {
+	if (SvREADONLY(dstr) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(dstr))
+	    sv_unref(dstr);
+    }
+    if (!sstr)
+	sstr = &sv_undef;
+    stype = SvTYPE(sstr);
+    dtype = SvTYPE(dstr);
+
+    if (dtype == SVt_PVGV && (SvFLAGS(dstr) & SVf_FAKE)) {
+        sv_unglob(dstr);     /* so fake GLOB won't perpetuate */
+	sv_setpvn(dstr, "", 0);
+        (void)SvPOK_only(dstr);
+        dtype = SvTYPE(dstr);
+    }
+
+#ifdef OVERLOAD
+    SvAMAGIC_off(dstr);
+#endif /* OVERLOAD */
+    /* There's a lot of redundancy below but we're going for speed here */
+
+    switch (stype) {
+    case SVt_NULL:
+	(void)SvOK_off(dstr);
+	return;
+    case SVt_IV:
+	if (dtype <= SVt_PV) {
+	    if (dtype < SVt_IV)
+		sv_upgrade(dstr, SVt_IV);
+	    else if (dtype == SVt_NV)
+		sv_upgrade(dstr, SVt_PVNV);
+	    else if (dtype <= SVt_PV)
+		sv_upgrade(dstr, SVt_PVIV);
+	}
+	break;
+    case SVt_NV:
+	if (dtype <= SVt_PVIV) {
+	    if (dtype < SVt_NV)
+		sv_upgrade(dstr, SVt_NV);
+	    else if (dtype == SVt_PVIV)
+		sv_upgrade(dstr, SVt_PVNV);
+	    else if (dtype <= SVt_PV)
+		sv_upgrade(dstr, SVt_PVNV);
+	}
+	break;
+    case SVt_RV:
+	if (dtype < SVt_RV)
+	    sv_upgrade(dstr, SVt_RV);
+	else if (dtype == SVt_PVGV &&
+		 SvTYPE(SvRV(sstr)) == SVt_PVGV) {
+	    sstr = SvRV(sstr);
+	    if (sstr == dstr) {
+		if (curcop->cop_stash != GvSTASH(dstr))
+		    GvIMPORTED_on(dstr);
+		GvMULTI_on(dstr);
+		return;
+	    }
+	    goto glob_assign;
+	}
+	break;
+    case SVt_PV:
+	if (dtype < SVt_PV)
+	    sv_upgrade(dstr, SVt_PV);
+	break;
+    case SVt_PVIV:
+	if (dtype < SVt_PVIV)
+	    sv_upgrade(dstr, SVt_PVIV);
+	break;
+    case SVt_PVNV:
+	if (dtype < SVt_PVNV)
+	    sv_upgrade(dstr, SVt_PVNV);
+	break;
+
+    case SVt_PVLV:
+	sv_upgrade(dstr, SVt_PVNV);
+	break;
+
+    case SVt_PVAV:
+    case SVt_PVHV:
+    case SVt_PVCV:
+    case SVt_PVIO:
+	if (op)
+	    croak("Bizarre copy of %s in %s", sv_reftype(sstr, 0),
+		op_name[op->op_type]);
+	else
+	    croak("Bizarre copy of %s", sv_reftype(sstr, 0));
+	break;
+
+    case SVt_PVGV:
+	if (dtype <= SVt_PVGV) {
+  glob_assign:
+	    if (dtype != SVt_PVGV) {
+		char *name = GvNAME(sstr);
+		STRLEN len = GvNAMELEN(sstr);
+		sv_upgrade(dstr, SVt_PVGV);
+		sv_magic(dstr, dstr, '*', name, len);
+		GvSTASH(dstr) = GvSTASH(sstr);
+		GvNAME(dstr) = savepvn(name, len);
+		GvNAMELEN(dstr) = len;
+		SvFAKE_on(dstr);	/* can coerce to non-glob */
+	    }
+	    (void)SvOK_off(dstr);
+	    GvINTRO_off(dstr);		/* one-shot flag */
+	    gp_free(dstr);
+	    GvGP(dstr) = gp_ref(GvGP(sstr));
+	    SvTAINT(dstr);
+	    if (curcop->cop_stash != GvSTASH(dstr))
+		GvIMPORTED_on(dstr);
+	    GvMULTI_on(dstr);
+	    return;
+	}
+	/* FALL THROUGH */
+
+    default:
+	if (dtype < stype)
+	    sv_upgrade(dstr, stype);
+	if (SvGMAGICAL(sstr))
+	    mg_get(sstr);
+    }
+
+    sflags = SvFLAGS(sstr);
+
+    if (sflags & SVf_ROK) {
+	if (dtype >= SVt_PV) {
+	    if (dtype == SVt_PVGV) {
+		SV *sref = SvREFCNT_inc(SvRV(sstr));
+		SV *dref = 0;
+		int intro = GvINTRO(dstr);
+
+		if (intro) {
+		    GP *gp;
+		    GvGP(dstr)->gp_refcnt--;
+		    GvINTRO_off(dstr);	/* one-shot flag */
+		    Newz(602,gp, 1, GP);
+		    GvGP(dstr) = gp;
+		    GvREFCNT(dstr) = 1;
+		    GvSV(dstr) = NEWSV(72,0);
+		    GvLINE(dstr) = curcop->cop_line;
+		    GvEGV(dstr) = dstr;
+		}
+		GvMULTI_on(dstr);
+		switch (SvTYPE(sref)) {
+		case SVt_PVAV:
+		    if (intro)
+			SAVESPTR(GvAV(dstr));
+		    else
+			dref = (SV*)GvAV(dstr);
+		    GvAV(dstr) = (AV*)sref;
+		    if (curcop->cop_stash != GvSTASH(dstr))
+			GvIMPORTED_AV_on(dstr);
+		    break;
+		case SVt_PVHV:
+		    if (intro)
+			SAVESPTR(GvHV(dstr));
+		    else
+			dref = (SV*)GvHV(dstr);
+		    GvHV(dstr) = (HV*)sref;
+		    if (curcop->cop_stash != GvSTASH(dstr))
+			GvIMPORTED_HV_on(dstr);
+		    break;
+		case SVt_PVCV:
+		    if (intro)
+			SAVESPTR(GvCV(dstr));
+		    else {
+			CV* cv = GvCV(dstr);
+			if (cv) {
+			    dref = (SV*)cv;
+			    if (dowarn && sref != dref &&
+				    !GvCVGEN((GV*)dstr) &&
+				    (CvROOT(cv) || CvXSUB(cv)) )
+				warn("Subroutine %s redefined",
+				    GvENAME((GV*)dstr));
+			    SvFAKE_on(cv);
+			}
+		    }
+		    if (GvCV(dstr) != (CV*)sref) {
+			GvCV(dstr) = (CV*)sref;
+			GvASSUMECV_on(dstr);
+		    }
+		    if (curcop->cop_stash != GvSTASH(dstr))
+			GvIMPORTED_CV_on(dstr);
+		    break;
+		case SVt_PVIO:
+		    if (intro)
+			SAVESPTR(GvIOp(dstr));
+		    else
+			dref = (SV*)GvIOp(dstr);
+		    GvIOp(dstr) = (IO*)sref;
+		    break;
+		default:
+		    if (intro)
+			SAVESPTR(GvSV(dstr));
+		    else
+			dref = (SV*)GvSV(dstr);
+		    GvSV(dstr) = sref;
+		    if (curcop->cop_stash != GvSTASH(dstr))
+			GvIMPORTED_SV_on(dstr);
+		    break;
+		}
+		if (dref)
+		    SvREFCNT_dec(dref);
+		if (intro)
+		    SAVEFREESV(sref);
+		SvTAINT(dstr);
+		return;
+	    }
+	    if (SvPVX(dstr)) {
+		Safefree(SvPVX(dstr));
+		SvLEN(dstr)=SvCUR(dstr)=0;
+	    }
+	}
+	(void)SvOK_off(dstr);
+	SvRV(dstr) = SvREFCNT_inc(SvRV(sstr));
+	SvROK_on(dstr);
+	if (sflags & SVp_NOK) {
+	    SvNOK_on(dstr);
+	    SvNVX(dstr) = SvNVX(sstr);
+	}
+	if (sflags & SVp_IOK) {
+	    (void)SvIOK_on(dstr);
+	    SvIVX(dstr) = SvIVX(sstr);
+	}
+#ifdef OVERLOAD
+	if (SvAMAGIC(sstr)) {
+	    SvAMAGIC_on(dstr);
+	}
+#endif /* OVERLOAD */
+    }
+    else if (sflags & SVp_POK) {
+
+	/*
+	 * Check to see if we can just swipe the string.  If so, it's a
+	 * possible small lose on short strings, but a big win on long ones.
+	 * It might even be a win on short strings if SvPVX(dstr)
+	 * has to be allocated and SvPVX(sstr) has to be freed.
+	 */
+
+	if (SvTEMP(sstr) &&		/* slated for free anyway? */
+	    !(sflags & SVf_OOK)) 	/* and not involved in OOK hack? */
+	{
+	    if (SvPVX(dstr)) {		/* we know that dtype >= SVt_PV */
+		if (SvOOK(dstr)) {
+		    SvFLAGS(dstr) &= ~SVf_OOK;
+		    Safefree(SvPVX(dstr) - SvIVX(dstr));
+		}
+		else
+		    Safefree(SvPVX(dstr));
+	    }
+	    (void)SvPOK_only(dstr);
+	    SvPV_set(dstr, SvPVX(sstr));
+	    SvLEN_set(dstr, SvLEN(sstr));
+	    SvCUR_set(dstr, SvCUR(sstr));
+	    SvTEMP_off(dstr);
+	    (void)SvOK_off(sstr);
+	    SvPV_set(sstr, Nullch);
+	    SvLEN_set(sstr, 0);
+	    SvCUR_set(sstr, 0);
+	    SvTEMP_off(sstr);
+	}
+	else {					/* have to copy actual string */
+	    STRLEN len = SvCUR(sstr);
+
+	    SvGROW(dstr, len + 1);		/* inlined from sv_setpvn */
+	    Move(SvPVX(sstr),SvPVX(dstr),len,char);
+	    SvCUR_set(dstr, len);
+	    *SvEND(dstr) = '\0';
+	    (void)SvPOK_only(dstr);
+	}
+	/*SUPPRESS 560*/
+	if (sflags & SVp_NOK) {
+	    SvNOK_on(dstr);
+	    SvNVX(dstr) = SvNVX(sstr);
+	}
+	if (sflags & SVp_IOK) {
+	    (void)SvIOK_on(dstr);
+	    SvIVX(dstr) = SvIVX(sstr);
+	}
+    }
+    else if (sflags & SVp_NOK) {
+	SvNVX(dstr) = SvNVX(sstr);
+	(void)SvNOK_only(dstr);
+	if (SvIOK(sstr)) {
+	    (void)SvIOK_on(dstr);
+	    SvIVX(dstr) = SvIVX(sstr);
+	}
+    }
+    else if (sflags & SVp_IOK) {
+	(void)SvIOK_only(dstr);
+	SvIVX(dstr) = SvIVX(sstr);
+    }
+    else {
+	(void)SvOK_off(dstr);
+    }
+    SvTAINT(dstr);
+}
+
+void
+sv_setpvn(sv,ptr,len)
+register SV *sv;
+register char *ptr;
+register STRLEN len;
+{
+    assert(len >= 0);
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (!ptr) {
+	(void)SvOK_off(sv);
+	return;
+    }
+    if (SvTYPE(sv) >= SVt_PV) {
+	if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+	    sv_unglob(sv);
+    }
+    else if (!sv_upgrade(sv, SVt_PV))
+	return;
+    SvGROW(sv, len + 1);
+    Move(ptr,SvPVX(sv),len,char);
+    SvCUR_set(sv, len);
+    *SvEND(sv) = '\0';
+    (void)SvPOK_only(sv);		/* validate pointer */
+    SvTAINT(sv);
+}
+
+void
+sv_setpv(sv,ptr)
+register SV *sv;
+register char *ptr;
+{
+    register STRLEN len;
+
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (!ptr) {
+	(void)SvOK_off(sv);
+	return;
+    }
+    len = strlen(ptr);
+    if (SvTYPE(sv) >= SVt_PV) {
+	if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
+	    sv_unglob(sv);
+    }
+    else if (!sv_upgrade(sv, SVt_PV))
+	return;
+    SvGROW(sv, len + 1);
+    Move(ptr,SvPVX(sv),len+1,char);
+    SvCUR_set(sv, len);
+    (void)SvPOK_only(sv);		/* validate pointer */
+    SvTAINT(sv);
+}
+
+void
+sv_usepvn(sv,ptr,len)
+register SV *sv;
+register char *ptr;
+register STRLEN len;
+{
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (!SvUPGRADE(sv, SVt_PV))
+	return;
+    if (!ptr) {
+	(void)SvOK_off(sv);
+	return;
+    }
+    if (SvPVX(sv))
+	Safefree(SvPVX(sv));
+    Renew(ptr, len+1, char);
+    SvPVX(sv) = ptr;
+    SvCUR_set(sv, len);
+    SvLEN_set(sv, len+1);
+    *SvEND(sv) = '\0';
+    (void)SvPOK_only(sv);		/* validate pointer */
+    SvTAINT(sv);
+}
+
+void
+sv_chop(sv,ptr)	/* like set but assuming ptr is in sv */
+register SV *sv;
+register char *ptr;
+{
+    register STRLEN delta;
+
+    if (!ptr || !SvPOKp(sv))
+	return;
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (SvTYPE(sv) < SVt_PVIV)
+	sv_upgrade(sv,SVt_PVIV);
+
+    if (!SvOOK(sv)) {
+	SvIVX(sv) = 0;
+	SvFLAGS(sv) |= SVf_OOK;
+    }
+    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVp_IOK|SVp_NOK);
+    delta = ptr - SvPVX(sv);
+    SvLEN(sv) -= delta;
+    SvCUR(sv) -= delta;
+    SvPVX(sv) += delta;
+    SvIVX(sv) += delta;
+}
+
+void
+sv_catpvn(sv,ptr,len)
+register SV *sv;
+register char *ptr;
+register STRLEN len;
+{
+    STRLEN tlen;
+    char *junk;
+
+    junk = SvPV_force(sv, tlen);
+    SvGROW(sv, tlen + len + 1);
+    if (ptr == junk)
+	ptr = SvPVX(sv);
+    Move(ptr,SvPVX(sv)+tlen,len,char);
+    SvCUR(sv) += len;
+    *SvEND(sv) = '\0';
+    (void)SvPOK_only(sv);		/* validate pointer */
+    SvTAINT(sv);
+}
+
+void
+sv_catsv(dstr,sstr)
+SV *dstr;
+register SV *sstr;
+{
+    char *s;
+    STRLEN len;
+    if (!sstr)
+	return;
+    if (s = SvPV(sstr, len))
+	sv_catpvn(dstr,s,len);
+}
+
+void
+sv_catpv(sv,ptr)
+register SV *sv;
+register char *ptr;
+{
+    register STRLEN len;
+    STRLEN tlen;
+    char *junk;
+
+    if (!ptr)
+	return;
+    junk = SvPV_force(sv, tlen);
+    len = strlen(ptr);
+    SvGROW(sv, tlen + len + 1);
+    if (ptr == junk)
+	ptr = SvPVX(sv);
+    Move(ptr,SvPVX(sv)+tlen,len+1,char);
+    SvCUR(sv) += len;
+    (void)SvPOK_only(sv);		/* validate pointer */
+    SvTAINT(sv);
+}
+
+SV *
+#ifdef LEAKTEST
+newSV(x,len)
+I32 x;
+#else
+newSV(len)
+#endif
+STRLEN len;
+{
+    register SV *sv;
+    
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    if (len) {
+	sv_upgrade(sv, SVt_PV);
+	SvGROW(sv, len + 1);
+    }
+    return sv;
+}
+
+void
+sv_magic(sv, obj, how, name, namlen)
+register SV *sv;
+SV *obj;
+int how;
+char *name;
+I32 namlen;
+{
+    MAGIC* mg;
+    
+    if (SvREADONLY(sv) && curcop != &compiling && !strchr("gB", how))
+	croak(no_modify);
+    if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
+	if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
+	    if (how == 't')
+		mg->mg_len |= 1;
+	    return;
+	}
+    }
+    else {
+	if (!SvUPGRADE(sv, SVt_PVMG))
+	    return;
+    }
+    Newz(702,mg, 1, MAGIC);
+    mg->mg_moremagic = SvMAGIC(sv);
+
+    SvMAGIC(sv) = mg;
+    if (!obj || obj == sv || how == '#')
+	mg->mg_obj = obj;
+    else {
+	mg->mg_obj = SvREFCNT_inc(obj);
+	mg->mg_flags |= MGf_REFCOUNTED;
+    }
+    mg->mg_type = how;
+    mg->mg_len = namlen;
+    if (name && namlen >= 0)
+	mg->mg_ptr = savepvn(name, namlen);
+    switch (how) {
+    case 0:
+	mg->mg_virtual = &vtbl_sv;
+	break;
+#ifdef OVERLOAD
+    case 'A':
+        mg->mg_virtual = &vtbl_amagic;
+        break;
+    case 'a':
+        mg->mg_virtual = &vtbl_amagicelem;
+        break;
+    case 'c':
+        mg->mg_virtual = 0;
+        break;
+#endif /* OVERLOAD */
+    case 'B':
+	mg->mg_virtual = &vtbl_bm;
+	break;
+    case 'E':
+	mg->mg_virtual = &vtbl_env;
+	break;
+    case 'e':
+	mg->mg_virtual = &vtbl_envelem;
+	break;
+    case 'g':
+	mg->mg_virtual = &vtbl_mglob;
+	break;
+    case 'I':
+	mg->mg_virtual = &vtbl_isa;
+	break;
+    case 'i':
+	mg->mg_virtual = &vtbl_isaelem;
+	break;
+    case 'L':
+	SvRMAGICAL_on(sv);
+	mg->mg_virtual = 0;
+	break;
+    case 'l':
+	mg->mg_virtual = &vtbl_dbline;
+	break;
+    case 'P':
+	mg->mg_virtual = &vtbl_pack;
+	break;
+    case 'p':
+    case 'q':
+	mg->mg_virtual = &vtbl_packelem;
+	break;
+    case 'S':
+	mg->mg_virtual = &vtbl_sig;
+	break;
+    case 's':
+	mg->mg_virtual = &vtbl_sigelem;
+	break;
+    case 't':
+	mg->mg_virtual = &vtbl_taint;
+	mg->mg_len = 1;
+	break;
+    case 'U':
+	mg->mg_virtual = &vtbl_uvar;
+	break;
+    case 'v':
+	mg->mg_virtual = &vtbl_vec;
+	break;
+    case 'x':
+	mg->mg_virtual = &vtbl_substr;
+	break;
+    case '*':
+	mg->mg_virtual = &vtbl_glob;
+	break;
+    case '#':
+	mg->mg_virtual = &vtbl_arylen;
+	break;
+    case '.':
+	mg->mg_virtual = &vtbl_pos;
+	break;
+    case '~':	/* Reserved for use by extensions not perl internals.	*/
+	/* Useful for attaching extension internal data to perl vars.	*/
+	/* Note that multiple extensions may clash if magical scalars	*/
+	/* etc holding private data from one are passed to another.	*/
+	SvRMAGICAL_on(sv);
+	break;
+    default:
+	croak("Don't know how to handle magic of type '%c'", how);
+    }
+    mg_magical(sv);
+    if (SvGMAGICAL(sv))
+	SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+}
+
+int
+sv_unmagic(sv, type)
+SV* sv;
+int type;
+{
+    MAGIC* mg;
+    MAGIC** mgp;
+    if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
+	return 0;
+    mgp = &SvMAGIC(sv);
+    for (mg = *mgp; mg; mg = *mgp) {
+	if (mg->mg_type == type) {
+	    MGVTBL* vtbl = mg->mg_virtual;
+	    *mgp = mg->mg_moremagic;
+	    if (vtbl && vtbl->svt_free)
+		(*vtbl->svt_free)(sv, mg);
+	    if (mg->mg_ptr && mg->mg_type != 'g')
+		Safefree(mg->mg_ptr);
+	    if (mg->mg_flags & MGf_REFCOUNTED)
+		SvREFCNT_dec(mg->mg_obj);
+	    Safefree(mg);
+	}
+	else
+	    mgp = &mg->mg_moremagic;
+    }
+    if (!SvMAGIC(sv)) {
+	SvMAGICAL_off(sv);
+	SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+    }
+
+    return 0;
+}
+
+void
+sv_insert(bigstr,offset,len,little,littlelen)
+SV *bigstr;
+STRLEN offset;
+STRLEN len;
+char *little;
+STRLEN littlelen;
+{
+    register char *big;
+    register char *mid;
+    register char *midend;
+    register char *bigend;
+    register I32 i;
+
+    if (!bigstr)
+	croak("Can't modify non-existent substring");
+    SvPV_force(bigstr, na);
+
+    i = littlelen - len;
+    if (i > 0) {			/* string might grow */
+	big = SvGROW(bigstr, SvCUR(bigstr) + i + 1);
+	mid = big + offset + len;
+	midend = bigend = big + SvCUR(bigstr);
+	bigend += i;
+	*bigend = '\0';
+	while (midend > mid)		/* shove everything down */
+	    *--bigend = *--midend;
+	Move(little,big+offset,littlelen,char);
+	SvCUR(bigstr) += i;
+	SvSETMAGIC(bigstr);
+	return;
+    }
+    else if (i == 0) {
+	Move(little,SvPVX(bigstr)+offset,len,char);
+	SvSETMAGIC(bigstr);
+	return;
+    }
+
+    big = SvPVX(bigstr);
+    mid = big + offset;
+    midend = mid + len;
+    bigend = big + SvCUR(bigstr);
+
+    if (midend > bigend)
+	croak("panic: sv_insert");
+
+    if (mid - big > bigend - midend) {	/* faster to shorten from end */
+	if (littlelen) {
+	    Move(little, mid, littlelen,char);
+	    mid += littlelen;
+	}
+	i = bigend - midend;
+	if (i > 0) {
+	    Move(midend, mid, i,char);
+	    mid += i;
+	}
+	*mid = '\0';
+	SvCUR_set(bigstr, mid - big);
+    }
+    /*SUPPRESS 560*/
+    else if (i = mid - big) {	/* faster from front */
+	midend -= littlelen;
+	mid = midend;
+	sv_chop(bigstr,midend-i);
+	big += i;
+	while (i--)
+	    *--midend = *--big;
+	if (littlelen)
+	    Move(little, mid, littlelen,char);
+    }
+    else if (littlelen) {
+	midend -= littlelen;
+	sv_chop(bigstr,midend);
+	Move(little,midend,littlelen,char);
+    }
+    else {
+	sv_chop(bigstr,midend);
+    }
+    SvSETMAGIC(bigstr);
+}
+
+/* make sv point to what nstr did */
+
+void
+sv_replace(sv,nsv)
+register SV *sv;
+register SV *nsv;
+{
+    U32 refcnt = SvREFCNT(sv);
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (SvREFCNT(nsv) != 1)
+	warn("Reference miscount in sv_replace()");
+    if (SvMAGICAL(sv)) {
+	if (SvMAGICAL(nsv))
+	    mg_free(nsv);
+	else
+	    sv_upgrade(nsv, SVt_PVMG);
+	SvMAGIC(nsv) = SvMAGIC(sv);
+	SvFLAGS(nsv) |= SvMAGICAL(sv);
+	SvMAGICAL_off(sv);
+	SvMAGIC(sv) = 0;
+    }
+    SvREFCNT(sv) = 0;
+    sv_clear(sv);
+    StructCopy(nsv,sv,SV);
+    SvREFCNT(sv) = refcnt;
+    del_SV(nsv);
+}
+
+void
+sv_clear(sv)
+register SV *sv;
+{
+    assert(sv);
+    assert(SvREFCNT(sv) == 0);
+
+    if (SvOBJECT(sv)) {
+	dSP;
+	GV* destructor;
+
+	if (defstash) {		/* Still have a symbol table? */
+	    destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+
+	    ENTER;
+	    SAVEFREESV(SvSTASH(sv));
+	    if (destructor && GvCV(destructor)) {
+		SV ref;
+
+		Zero(&ref, 1, SV);
+		sv_upgrade(&ref, SVt_RV);
+		SAVEI32(SvREFCNT(sv));
+		SvRV(&ref) = SvREFCNT_inc(sv);
+		SvROK_on(&ref);
+
+		EXTEND(SP, 2);
+		PUSHMARK(SP);
+		PUSHs(&ref);
+		PUTBACK;
+		perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
+		del_XRV(SvANY(&ref));
+	    }
+	    LEAVE;
+	}
+	else
+	    SvREFCNT_dec(SvSTASH(sv));
+	if (SvOBJECT(sv)) {
+	    SvOBJECT_off(sv);	/* Curse the object. */
+	    if (SvTYPE(sv) != SVt_PVIO)
+		--sv_objcount;	/* XXX Might want something more general */
+	}
+    }
+    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
+	mg_free(sv);
+    switch (SvTYPE(sv)) {
+    case SVt_PVIO:
+	io_close((IO*)sv);
+	Safefree(IoTOP_NAME(sv));
+	Safefree(IoFMT_NAME(sv));
+	Safefree(IoBOTTOM_NAME(sv));
+	/* FALL THROUGH */
+    case SVt_PVBM:
+	goto freescalar;
+    case SVt_PVCV:
+    case SVt_PVFM:
+	cv_undef((CV*)sv);
+	goto freescalar;
+    case SVt_PVHV:
+	hv_undef((HV*)sv);
+	break;
+    case SVt_PVAV:
+	av_undef((AV*)sv);
+	break;
+    case SVt_PVGV:
+	gp_free(sv);
+	Safefree(GvNAME(sv));
+	/* FALL THROUGH */
+    case SVt_PVLV:
+    case SVt_PVMG:
+    case SVt_PVNV:
+    case SVt_PVIV:
+      freescalar:
+	(void)SvOOK_off(sv);
+	/* FALL THROUGH */
+    case SVt_PV:
+    case SVt_RV:
+	if (SvROK(sv))
+	    SvREFCNT_dec(SvRV(sv));
+	else if (SvPVX(sv))
+	    Safefree(SvPVX(sv));
+	break;
+/*
+    case SVt_NV:
+    case SVt_IV:
+    case SVt_NULL:
+	break;
+*/
+    }
+
+    switch (SvTYPE(sv)) {
+    case SVt_NULL:
+	break;
+    case SVt_IV:
+	del_XIV(SvANY(sv));
+	break;
+    case SVt_NV:
+	del_XNV(SvANY(sv));
+	break;
+    case SVt_RV:
+	del_XRV(SvANY(sv));
+	break;
+    case SVt_PV:
+	del_XPV(SvANY(sv));
+	break;
+    case SVt_PVIV:
+	del_XPVIV(SvANY(sv));
+	break;
+    case SVt_PVNV:
+	del_XPVNV(SvANY(sv));
+	break;
+    case SVt_PVMG:
+	del_XPVMG(SvANY(sv));
+	break;
+    case SVt_PVLV:
+	del_XPVLV(SvANY(sv));
+	break;
+    case SVt_PVAV:
+	del_XPVAV(SvANY(sv));
+	break;
+    case SVt_PVHV:
+	del_XPVHV(SvANY(sv));
+	break;
+    case SVt_PVCV:
+	del_XPVCV(SvANY(sv));
+	break;
+    case SVt_PVGV:
+	del_XPVGV(SvANY(sv));
+	break;
+    case SVt_PVBM:
+	del_XPVBM(SvANY(sv));
+	break;
+    case SVt_PVFM:
+	del_XPVFM(SvANY(sv));
+	break;
+    case SVt_PVIO:
+	del_XPVIO(SvANY(sv));
+	break;
+    }
+    SvFLAGS(sv) &= SVf_BREAK;
+    SvFLAGS(sv) |= SVTYPEMASK;
+}
+
+SV *
+sv_newref(sv)
+SV* sv;
+{
+    if (sv)
+	SvREFCNT(sv)++;
+    return sv;
+}
+
+void
+sv_free(sv)
+SV *sv;
+{
+    if (!sv)
+	return;
+    if (SvREADONLY(sv)) {
+	if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no)
+	    return;
+    }
+    if (SvREFCNT(sv) == 0) {
+	if (SvFLAGS(sv) & SVf_BREAK)
+	    return;
+	warn("Attempt to free unreferenced scalar");
+	return;
+    }
+    if (--SvREFCNT(sv) > 0)
+	return;
+#ifdef DEBUGGING
+    if (SvTEMP(sv)) {
+	warn("Attempt to free temp prematurely");
+	return;
+    }
+#endif
+    sv_clear(sv);
+    del_SV(sv);
+}
+
+STRLEN
+sv_len(sv)
+register SV *sv;
+{
+    char *junk;
+    STRLEN len;
+
+    if (!sv)
+	return 0;
+
+    if (SvGMAGICAL(sv))
+	len = mg_len(sv);
+    else
+	junk = SvPV(sv, len);
+    return len;
+}
+
+I32
+sv_eq(str1,str2)
+register SV *str1;
+register SV *str2;
+{
+    char *pv1;
+    STRLEN cur1;
+    char *pv2;
+    STRLEN cur2;
+
+    if (!str1) {
+	pv1 = "";
+	cur1 = 0;
+    }
+    else
+	pv1 = SvPV(str1, cur1);
+
+    if (!str2)
+	return !cur1;
+    else
+	pv2 = SvPV(str2, cur2);
+
+    if (cur1 != cur2)
+	return 0;
+
+    return !bcmp(pv1, pv2, cur1);
+}
+
+I32
+sv_cmp(str1,str2)
+register SV *str1;
+register SV *str2;
+{
+    I32 retval;
+    char *pv1;
+    STRLEN cur1;
+    char *pv2;
+    STRLEN cur2;
+
+    if (!str1) {
+	pv1 = "";
+	cur1 = 0;
+    }
+    else
+	pv1 = SvPV(str1, cur1);
+
+    if (!str2) {
+	pv2 = "";
+	cur2 = 0;
+    }
+    else
+	pv2 = SvPV(str2, cur2);
+
+    if (!cur1)
+	return cur2 ? -1 : 0;
+    if (!cur2)
+	return 1;
+
+    if (cur1 < cur2) {
+	/*SUPPRESS 560*/
+	if (retval = memcmp((void*)pv1, (void*)pv2, cur1))
+	    return retval < 0 ? -1 : 1;
+	else
+	    return -1;
+    }
+    /*SUPPRESS 560*/
+    else if (retval = memcmp((void*)pv1, (void*)pv2, cur2))
+	return retval < 0 ? -1 : 1;
+    else if (cur1 == cur2)
+	return 0;
+    else
+	return 1;
+}
+
+char *
+sv_gets(sv,fp,append)
+register SV *sv;
+register FILE *fp;
+I32 append;
+{
+    char *rsptr;
+    STRLEN rslen;
+    register STDCHAR rslast;
+    register STDCHAR *bp;
+    register I32 cnt;
+    I32 i;
+
+#ifdef FAST_SV_GETS
+    /*
+     * We're going to steal some values from the stdio struct
+     * and put EVERYTHING in the innermost loop into registers.
+     */
+    register STDCHAR *ptr;
+    STRLEN bpx;
+    I32 shortbuffered;
+#endif
+
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv))
+	    sv_unref(sv);
+    }
+    if (!SvUPGRADE(sv, SVt_PV))
+	return 0;
+
+    if (RsSNARF(rs)) {
+	rsptr = NULL;
+	rslen = 0;
+    }
+    else if (RsPARA(rs)) {
+	rsptr = "\n\n";
+	rslen = 2;
+    }
+    else
+	rsptr = SvPV(rs, rslen);
+    rslast = rslen ? rsptr[rslen - 1] : '\0';
+
+    if (RsPARA(rs)) {		/* have to do this both before and after */
+	do {			/* to make sure file boundaries work right */
+	    if (feof(fp))
+		return 0;
+	    i = getc(fp);
+	    if (i != '\n') {
+		if (i == -1)
+		    return 0;
+		ungetc(i,fp);
+		break;
+	    }
+	} while (i != EOF);
+    }
+
+#ifdef FAST_SV_GETS
+
+    /* Here is some breathtakingly efficient cheating */
+
+    cnt = FILE_cnt(fp);			/* get count into register */
+    (void)SvPOK_only(sv);		/* validate pointer */
+    if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */
+	if (cnt > 80 && SvLEN(sv) > append) {
+	    shortbuffered = cnt - SvLEN(sv) + append + 1;
+	    cnt -= shortbuffered;
+	}
+	else {
+	    shortbuffered = 0;
+	    SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */
+	}
+    }
+    else
+	shortbuffered = 0;
+    bp = (STDCHAR*)SvPVX(sv) + append;  /* move these two too to registers */
+    ptr = FILE_ptr(fp);
+    for (;;) {
+      screamer:
+	if (cnt > 0) {
+	    if (rslen) {
+		while (--cnt >= 0) {		     /* this     |  eat */
+		    if ((*bp++ = *ptr++) == rslast)  /* really   |  dust */
+			goto thats_all_folks;	     /* screams  |  sed :-) */
+		}
+	    }
+	    else {
+	        memcpy((char*)bp, (char*)ptr, cnt);  /* this     |  eat */    
+		bp += cnt;			     /* screams  |  dust */   
+		ptr += cnt;			     /* louder   |  sed :-) */
+		cnt = 0;
+	    }
+	}
+	
+	if (shortbuffered) {		/* oh well, must extend */
+	    cnt = shortbuffered;
+	    shortbuffered = 0;
+	    bpx = bp - (STDCHAR*)SvPVX(sv); /* box up before relocation */
+	    SvCUR_set(sv, bpx);
+	    SvGROW(sv, SvLEN(sv) + append + cnt + 2);
+	    bp = (STDCHAR*)SvPVX(sv) + bpx; /* unbox after relocation */
+	    continue;
+	}
+
+	FILE_cnt(fp) = cnt;		/* deregisterize cnt and ptr */
+	FILE_ptr(fp) = ptr;
+	i = _filbuf(fp);		/* get more characters */
+	cnt = FILE_cnt(fp);
+	ptr = FILE_ptr(fp);		/* reregisterize cnt and ptr */
+
+	if (i == EOF)			/* all done for ever? */
+	    goto thats_really_all_folks;
+
+	bpx = bp - (STDCHAR*)SvPVX(sv);	/* box up before relocation */
+	SvCUR_set(sv, bpx);
+	SvGROW(sv, bpx + cnt + 2);
+	bp = (STDCHAR*)SvPVX(sv) + bpx;	/* unbox after relocation */
+
+	*bp++ = i;			/* store character from _filbuf */
+
+	if (rslen && (STDCHAR)i == rslast)  /* all done for now? */
+	    goto thats_all_folks;
+    }
+
+thats_all_folks:
+    if ((rslen > 1 && (bp - (STDCHAR*)SvPVX(sv) < rslen)) ||
+	  bcmp((char*)bp - rslen, rsptr, rslen))
+	goto screamer;			/* go back to the fray */
+thats_really_all_folks:
+    if (shortbuffered)
+	cnt += shortbuffered;
+    FILE_cnt(fp) = cnt;			/* put these back or we're in trouble */
+    FILE_ptr(fp) = ptr;
+    *bp = '\0';
+    SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv));  /* set length */
+
+#else /* SV_FAST_GETS */
+
+    /*The big, slow, and stupid way */
+
+    {
+	STDCHAR buf[8192];
+
+screamer:
+	if (rslen) {
+	    register STDCHAR *bpe = buf + sizeof(buf);
+	    bp = buf;
+	    while ((i = getc(fp)) != EOF && (*bp++ = i) != rslast && bp < bpe)
+		; /* keep reading */
+	    cnt = bp - buf;
+	}
+	else {
+	    cnt = fread((char*)buf, 1, sizeof(buf), fp);
+	    i = cnt ? (U8)buf[cnt - 1] : EOF;
+	}
+
+	if (append)
+	    sv_catpvn(sv, buf, cnt);
+	else
+	    sv_setpvn(sv, buf, cnt);
+
+	if (i != EOF &&			/* joy */
+	    (!rslen ||
+	     SvCUR(sv) < rslen ||
+	     bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
+	{
+	    append = -1;
+	    goto screamer;
+	}
+    }
+
+#endif /* SV_FAST_GETS */
+
+    if (RsPARA(rs)) {		/* have to do this both before and after */  
+        while (i != EOF) {	/* to make sure file boundaries work right */
+	    i = getc(fp);
+	    if (i != '\n') {
+		ungetc(i,fp);
+		break;
+	    }
+	}
+    }
+
+    return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch;
+}
+
+void
+sv_inc(sv)
+register SV *sv;
+{
+    register char *d;
+    int flags;
+
+    if (!sv)
+	return;
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	  if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
+#endif /* OVERLOAD */
+	  sv_unref(sv);
+	}
+    }
+    if (SvGMAGICAL(sv))
+	mg_get(sv);
+    flags = SvFLAGS(sv);
+    if (flags & SVp_IOK) {
+	(void)SvIOK_only(sv);
+	++SvIVX(sv);
+	return;
+    }
+    if (flags & SVp_NOK) {
+	SvNVX(sv) += 1.0;
+	(void)SvNOK_only(sv);
+	return;
+    }
+    if (!(flags & SVp_POK) || !*SvPVX(sv)) {
+	if ((flags & SVTYPEMASK) < SVt_PVNV)
+	    sv_upgrade(sv, SVt_NV);
+	SvNVX(sv) = 1.0;
+	(void)SvNOK_only(sv);
+	return;
+    }
+    d = SvPVX(sv);
+    while (isALPHA(*d)) d++;
+    while (isDIGIT(*d)) d++;
+    if (*d) {
+        sv_setnv(sv,atof(SvPVX(sv)) + 1.0);  /* punt */
+	return;
+    }
+    d--;
+    while (d >= SvPVX(sv)) {
+	if (isDIGIT(*d)) {
+	    if (++*d <= '9')
+		return;
+	    *(d--) = '0';
+	}
+	else {
+	    ++*d;
+	    if (isALPHA(*d))
+		return;
+	    *(d--) -= 'z' - 'a' + 1;
+	}
+    }
+    /* oh,oh, the number grew */
+    SvGROW(sv, SvCUR(sv) + 2);
+    SvCUR(sv)++;
+    for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--)
+	*d = d[-1];
+    if (isDIGIT(d[1]))
+	*d = '1';
+    else
+	*d = d[1];
+}
+
+void
+sv_dec(sv)
+register SV *sv;
+{
+    int flags;
+
+    if (!sv)
+	return;
+    if (SvTHINKFIRST(sv)) {
+	if (SvREADONLY(sv) && curcop != &compiling)
+	    croak(no_modify);
+	if (SvROK(sv)) {
+#ifdef OVERLOAD
+	  if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
+#endif /* OVERLOAD */
+	  sv_unref(sv);
+	}
+    }
+    if (SvGMAGICAL(sv))
+	mg_get(sv);
+    flags = SvFLAGS(sv);
+    if (flags & SVp_IOK) {
+	(void)SvIOK_only(sv);
+	--SvIVX(sv);
+	return;
+    }
+    if (flags & SVp_NOK) {
+	SvNVX(sv) -= 1.0;
+	(void)SvNOK_only(sv);
+	return;
+    }
+    if (!(flags & SVp_POK)) {
+	if ((flags & SVTYPEMASK) < SVt_PVNV)
+	    sv_upgrade(sv, SVt_NV);
+	SvNVX(sv) = -1.0;
+	(void)SvNOK_only(sv);
+	return;
+    }
+    sv_setnv(sv,atof(SvPVX(sv)) - 1.0);
+}
+
+/* Make a string that will exist for the duration of the expression
+ * evaluation.  Actually, it may have to last longer than that, but
+ * hopefully we won't free it until it has been assigned to a
+ * permanent location. */
+
+static void
+sv_mortalgrow()
+{
+    tmps_max += 128;
+    Renew(tmps_stack, tmps_max, SV*);
+}
+
+SV *
+sv_mortalcopy(oldstr)
+SV *oldstr;
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    sv_setsv(sv,oldstr);
+    if (++tmps_ix >= tmps_max)
+	sv_mortalgrow();
+    tmps_stack[tmps_ix] = sv;
+    SvTEMP_on(sv);
+    return sv;
+}
+
+SV *
+sv_newmortal()
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = SVs_TEMP;
+    if (++tmps_ix >= tmps_max)
+	sv_mortalgrow();
+    tmps_stack[tmps_ix] = sv;
+    return sv;
+}
+
+/* same thing without the copying */
+
+SV *
+sv_2mortal(sv)
+register SV *sv;
+{
+    if (!sv)
+	return sv;
+    if (SvREADONLY(sv) && curcop != &compiling)
+	croak(no_modify);
+    if (++tmps_ix >= tmps_max)
+	sv_mortalgrow();
+    tmps_stack[tmps_ix] = sv;
+    SvTEMP_on(sv);
+    return sv;
+}
+
+SV *
+newSVpv(s,len)
+char *s;
+STRLEN len;
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    if (!len)
+	len = strlen(s);
+    sv_setpvn(sv,s,len);
+    return sv;
+}
+
+SV *
+newSVnv(n)
+double n;
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    sv_setnv(sv,n);
+    return sv;
+}
+
+SV *
+newSViv(i)
+IV i;
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    sv_setiv(sv,i);
+    return sv;
+}
+
+SV *
+newRV(ref)
+SV *ref;
+{
+    register SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    sv_upgrade(sv, SVt_RV);
+    SvTEMP_off(ref);
+    SvRV(sv) = SvREFCNT_inc(ref);
+    SvROK_on(sv);
+    return sv;
+}
+
+/* make an exact duplicate of old */
+
+SV *
+newSVsv(old)
+register SV *old;
+{
+    register SV *sv;
+
+    if (!old)
+	return Nullsv;
+    if (SvTYPE(old) == SVTYPEMASK) {
+	warn("semi-panic: attempt to dup freed string");
+	return Nullsv;
+    }
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    if (SvTEMP(old)) {
+	SvTEMP_off(old);
+	sv_setsv(sv,old);
+	SvTEMP_on(old);
+    }
+    else
+	sv_setsv(sv,old);
+    return sv;
+}
+
+void
+sv_reset(s,stash)
+register char *s;
+HV *stash;
+{
+    register HE *entry;
+    register GV *gv;
+    register SV *sv;
+    register I32 i;
+    register PMOP *pm;
+    register I32 max;
+    char todo[256];
+
+    if (!*s) {		/* reset ?? searches */
+	for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) {
+	    pm->op_pmflags &= ~PMf_USED;
+	}
+	return;
+    }
+
+    /* reset variables */
+
+    if (!HvARRAY(stash))
+	return;
+
+    Zero(todo, 256, char);
+    while (*s) {
+	i = *s;
+	if (s[1] == '-') {
+	    s += 2;
+	}
+	max = *s++;
+	for ( ; i <= max; i++) {
+	    todo[i] = 1;
+	}
+	for (i = 0; i <= (I32) HvMAX(stash); i++) {
+	    for (entry = HvARRAY(stash)[i];
+	      entry;
+	      entry = entry->hent_next) {
+		if (!todo[(U8)*entry->hent_key])
+		    continue;
+		gv = (GV*)entry->hent_val;
+		sv = GvSV(gv);
+		(void)SvOK_off(sv);
+		if (SvTYPE(sv) >= SVt_PV) {
+		    SvCUR_set(sv, 0);
+		    SvTAINT(sv);
+		    if (SvPVX(sv) != Nullch)
+			*SvPVX(sv) = '\0';
+		}
+		if (GvAV(gv)) {
+		    av_clear(GvAV(gv));
+		}
+		if (GvHV(gv)) {
+		    if (HvNAME(GvHV(gv)))
+			continue;
+		    hv_clear(GvHV(gv));
+#ifndef VMS  /* VMS has no environ array */
+		    if (gv == envgv)
+			environ[0] = Nullch;
+#endif
+		}
+	    }
+	}
+    }
+}
+
+CV *
+sv_2cv(sv, st, gvp, lref)
+SV *sv;
+HV **st;
+GV **gvp;
+I32 lref;
+{
+    GV *gv;
+    CV *cv;
+
+    if (!sv)
+	return *gvp = Nullgv, Nullcv;
+    switch (SvTYPE(sv)) {
+    case SVt_PVCV:
+	*st = CvSTASH(sv);
+	*gvp = Nullgv;
+	return (CV*)sv;
+    case SVt_PVHV:
+    case SVt_PVAV:
+	*gvp = Nullgv;
+	return Nullcv;
+    case SVt_PVGV:
+	gv = (GV*)sv;
+	*gvp = gv;
+	*st = GvESTASH(gv);
+	goto fix_gv;
+
+    default:
+	if (SvGMAGICAL(sv))
+	    mg_get(sv);
+	if (SvROK(sv)) {
+	    cv = (CV*)SvRV(sv);
+	    if (SvTYPE(cv) != SVt_PVCV)
+		croak("Not a subroutine reference");
+	    *gvp = Nullgv;
+	    *st = CvSTASH(cv);
+	    return cv;
+	}
+	if (isGV(sv))
+	    gv = (GV*)sv;
+	else
+	    gv = gv_fetchpv(SvPV(sv, na), lref, SVt_PVCV);
+	*gvp = gv;
+	if (!gv)
+	    return Nullcv;
+	*st = GvESTASH(gv);
+    fix_gv:
+	if (lref && !GvCV(gv)) {
+	    SV *tmpsv;
+	    ENTER;
+	    tmpsv = NEWSV(704,0);
+	    gv_efullname(tmpsv, gv);
+	    newSUB(start_subparse(),
+		   newSVOP(OP_CONST, 0, tmpsv),
+		   Nullop,
+		   Nullop);
+	    LEAVE;
+	    if (!GvCV(gv))
+		croak("Unable to create sub named \"%s\"", SvPV(sv,na));
+	}
+	return GvCV(gv);
+    }
+}
+
+#ifndef SvTRUE
+I32
+SvTRUE(sv)
+register SV *sv;
+{
+    if (!sv)
+	return 0;
+    if (SvGMAGICAL(sv))
+	mg_get(sv);
+    if (SvPOK(sv)) {
+	register XPV* Xpv;
+	if ((Xpv = (XPV*)SvANY(sv)) &&
+		(*Xpv->xpv_pv > '0' ||
+		Xpv->xpv_cur > 1 ||
+		(Xpv->xpv_cur && *Xpv->xpv_pv != '0')))
+	    return 1;
+	else
+	    return 0;
+    }
+    else {
+	if (SvIOK(sv))
+	    return SvIVX(sv) != 0;
+	else {
+	    if (SvNOK(sv))
+		return SvNVX(sv) != 0.0;
+	    else
+		return sv_2bool(sv);
+	}
+    }
+}
+#endif /* SvTRUE */
+
+#ifndef SvIV
+IV SvIV(Sv)
+register SV *Sv;
+{
+    if (SvIOK(Sv))
+	return SvIVX(Sv);
+    return sv_2iv(Sv);
+}
+#endif /* SvIV */
+
+
+#ifndef SvNV
+double SvNV(Sv)
+register SV *Sv;
+{
+    if (SvNOK(Sv))
+	return SvNVX(Sv);
+    if (SvIOK(Sv))
+	return (double)SvIVX(Sv);
+    return sv_2nv(Sv);
+}
+#endif /* SvNV */
+
+#ifdef CRIPPLED_CC
+char *
+sv_pvn(sv, lp)
+SV *sv;
+STRLEN *lp;
+{
+    if (SvPOK(sv)) {
+	*lp = SvCUR(sv);
+	return SvPVX(sv);
+    }
+    return sv_2pv(sv, lp);
+}
+#endif
+
+char *
+sv_pvn_force(sv, lp)
+SV *sv;
+STRLEN *lp;
+{
+    char *s;
+
+    if (SvREADONLY(sv) && curcop != &compiling)
+	croak(no_modify);
+    
+    if (SvPOK(sv)) {
+	*lp = SvCUR(sv);
+    }
+    else {
+	if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM) {
+	    if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV) {
+		sv_unglob(sv);
+		s = SvPVX(sv);
+		*lp = SvCUR(sv);
+	    }
+	    else
+		croak("Can't coerce %s to string in %s", sv_reftype(sv,0),
+		    op_name[op->op_type]);
+	}
+	else
+	    s = sv_2pv(sv, lp);
+	if (s != SvPVX(sv)) {	/* Almost, but not quite, sv_setpvn() */
+	    STRLEN len = *lp;
+	    
+	    if (SvROK(sv))
+		sv_unref(sv);
+	    (void)SvUPGRADE(sv, SVt_PV);		/* Never FALSE */
+	    SvGROW(sv, len + 1);
+	    Move(s,SvPVX(sv),len,char);
+	    SvCUR_set(sv, len);
+	    *SvEND(sv) = '\0';
+	}
+	if (!SvPOK(sv)) {
+	    SvPOK_on(sv);		/* validate pointer */
+	    SvTAINT(sv);
+	    DEBUG_c(fprintf(stderr,"0x%lx 2pv(%s)\n",
+		(unsigned long)sv,SvPVX(sv)));
+	}
+    }
+    return SvPVX(sv);
+}
+
+char *
+sv_reftype(sv, ob)
+SV* sv;
+int ob;
+{
+    if (ob && SvOBJECT(sv))
+	return HvNAME(SvSTASH(sv));
+    else {
+	switch (SvTYPE(sv)) {
+	case SVt_NULL:
+	case SVt_IV:
+	case SVt_NV:
+	case SVt_RV:
+	case SVt_PV:
+	case SVt_PVIV:
+	case SVt_PVNV:
+	case SVt_PVMG:
+	case SVt_PVBM:
+				if (SvROK(sv))
+				    return "REF";
+				else
+				    return "SCALAR";
+	case SVt_PVLV:		return "LVALUE";
+	case SVt_PVAV:		return "ARRAY";
+	case SVt_PVHV:		return "HASH";
+	case SVt_PVCV:		return "CODE";
+	case SVt_PVGV:		return "GLOB";
+	case SVt_PVFM:		return "FORMLINE";
+	default:		return "UNKNOWN";
+	}
+    }
+}
+
+int
+sv_isobject(sv)
+SV *sv;
+{
+    if (!SvROK(sv))
+	return 0;
+    sv = (SV*)SvRV(sv);
+    if (!SvOBJECT(sv))
+	return 0;
+    return 1;
+}
+
+int
+sv_isa(sv, name)
+SV *sv;
+char *name;
+{
+    if (!SvROK(sv))
+	return 0;
+    sv = (SV*)SvRV(sv);
+    if (!SvOBJECT(sv))
+	return 0;
+
+    return strEQ(HvNAME(SvSTASH(sv)), name);
+}
+
+SV*
+newSVrv(rv, classname)
+SV *rv;
+char *classname;
+{
+    SV *sv;
+
+    new_SV();
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 0;
+    SvFLAGS(sv) = 0;
+    sv_upgrade(rv, SVt_RV);
+    SvRV(rv) = SvREFCNT_inc(sv);
+    SvROK_on(rv);
+
+    if (classname) {
+	HV* stash = gv_stashpv(classname, TRUE);
+	(void)sv_bless(rv, stash);
+    }
+    return sv;
+}
+
+SV*
+sv_setref_pv(rv, classname, pv)
+SV *rv;
+char *classname;
+void* pv;
+{
+    if (!pv)
+	sv_setsv(rv, &sv_undef);
+    else
+	sv_setiv(newSVrv(rv,classname), (IV)pv);
+    return rv;
+}
+
+SV*
+sv_setref_iv(rv, classname, iv)
+SV *rv;
+char *classname;
+IV iv;
+{
+    sv_setiv(newSVrv(rv,classname), iv);
+    return rv;
+}
+
+SV*
+sv_setref_nv(rv, classname, nv)
+SV *rv;
+char *classname;
+double nv;
+{
+    sv_setnv(newSVrv(rv,classname), nv);
+    return rv;
+}
+
+SV*
+sv_setref_pvn(rv, classname, pv, n)
+SV *rv;
+char *classname;
+char* pv;
+I32 n;
+{
+    sv_setpvn(newSVrv(rv,classname), pv, n);
+    return rv;
+}
+
+SV*
+sv_bless(sv,stash)
+SV* sv;
+HV* stash;
+{
+    SV *ref;
+    if (!SvROK(sv))
+        croak("Can't bless non-reference value");
+    ref = SvRV(sv);
+    if (SvFLAGS(ref) & (SVs_OBJECT|SVf_READONLY)) {
+	if (SvREADONLY(ref))
+	    croak(no_modify);
+	if (SvOBJECT(ref) && SvTYPE(ref) != SVt_PVIO)
+	    --sv_objcount;
+    }
+    SvOBJECT_on(ref);
+    ++sv_objcount;
+    (void)SvUPGRADE(ref, SVt_PVMG);
+    SvSTASH(ref) = (HV*)SvREFCNT_inc(stash);
+
+#ifdef OVERLOAD
+    SvAMAGIC_off(sv);
+    if (Gv_AMG(stash)) {
+      SvAMAGIC_on(sv);
+    }
+#endif /* OVERLOAD */
+
+    return sv;
+}
+
+static void
+sv_unglob(sv)
+SV* sv;
+{
+    assert(SvTYPE(sv) == SVt_PVGV);
+    SvFAKE_off(sv);
+    if (GvGP(sv))
+	gp_free(sv);
+    sv_unmagic(sv, '*');
+    Safefree(GvNAME(sv));
+    GvMULTI_off(sv);
+    SvFLAGS(sv) &= ~SVTYPEMASK;
+    SvFLAGS(sv) |= SVt_PVMG;
+}
+
+void
+sv_unref(sv)
+SV* sv;
+{
+    SV* rv = SvRV(sv);
+    
+    SvRV(sv) = 0;
+    SvROK_off(sv);
+    if (SvREFCNT(rv) != 1 || SvREADONLY(rv))
+	SvREFCNT_dec(rv);
+    else
+	sv_2mortal(rv);		/* Schedule for freeing later */
+}
+
+#ifdef DEBUGGING
+void
+sv_dump(sv)
+SV* sv;
+{
+    char tmpbuf[1024];
+    char *d = tmpbuf;
+    U32 flags;
+    U32 type;
+
+    if (!sv) {
+	fprintf(stderr, "SV = 0\n");
+	return;
+    }
+    
+    flags = SvFLAGS(sv);
+    type = SvTYPE(sv);
+
+    sprintf(d, "(0x%lx)\n  REFCNT = %ld\n  FLAGS = (",
+	(unsigned long)SvANY(sv), (long)SvREFCNT(sv));
+    d += strlen(d);
+    if (flags & SVs_PADBUSY)	strcat(d, "PADBUSY,");
+    if (flags & SVs_PADTMP)	strcat(d, "PADTMP,");
+    if (flags & SVs_PADMY)	strcat(d, "PADMY,");
+    if (flags & SVs_TEMP)	strcat(d, "TEMP,");
+    if (flags & SVs_OBJECT)	strcat(d, "OBJECT,");
+    if (flags & SVs_GMG)	strcat(d, "GMG,");
+    if (flags & SVs_SMG)	strcat(d, "SMG,");
+    if (flags & SVs_RMG)	strcat(d, "RMG,");
+    d += strlen(d);
+
+    if (flags & SVf_IOK)	strcat(d, "IOK,");
+    if (flags & SVf_NOK)	strcat(d, "NOK,");
+    if (flags & SVf_POK)	strcat(d, "POK,");
+    if (flags & SVf_ROK)	strcat(d, "ROK,");
+    if (flags & SVf_OOK)	strcat(d, "OOK,");
+    if (flags & SVf_FAKE)	strcat(d, "FAKE,");
+    if (flags & SVf_READONLY)	strcat(d, "READONLY,");
+    d += strlen(d);
+
+    if (flags & SVp_IOK)	strcat(d, "pIOK,");
+    if (flags & SVp_NOK)	strcat(d, "pNOK,");
+    if (flags & SVp_POK)	strcat(d, "pPOK,");
+    if (flags & SVp_SCREAM)	strcat(d, "SCREAM,");
+    d += strlen(d);
+    if (d[-1] == ',')
+	d--;
+    *d++ = ')';
+    *d = '\0';
+
+    fprintf(stderr, "SV = ");
+    switch (type) {
+    case SVt_NULL:
+	fprintf(stderr,"NULL%s\n", tmpbuf);
+	return;
+    case SVt_IV:
+	fprintf(stderr,"IV%s\n", tmpbuf);
+	break;
+    case SVt_NV:
+	fprintf(stderr,"NV%s\n", tmpbuf);
+	break;
+    case SVt_RV:
+	fprintf(stderr,"RV%s\n", tmpbuf);
+	break;
+    case SVt_PV:
+	fprintf(stderr,"PV%s\n", tmpbuf);
+	break;
+    case SVt_PVIV:
+	fprintf(stderr,"PVIV%s\n", tmpbuf);
+	break;
+    case SVt_PVNV:
+	fprintf(stderr,"PVNV%s\n", tmpbuf);
+	break;
+    case SVt_PVBM:
+	fprintf(stderr,"PVBM%s\n", tmpbuf);
+	break;
+    case SVt_PVMG:
+	fprintf(stderr,"PVMG%s\n", tmpbuf);
+	break;
+    case SVt_PVLV:
+	fprintf(stderr,"PVLV%s\n", tmpbuf);
+	break;
+    case SVt_PVAV:
+	fprintf(stderr,"PVAV%s\n", tmpbuf);
+	break;
+    case SVt_PVHV:
+	fprintf(stderr,"PVHV%s\n", tmpbuf);
+	break;
+    case SVt_PVCV:
+	fprintf(stderr,"PVCV%s\n", tmpbuf);
+	break;
+    case SVt_PVGV:
+	fprintf(stderr,"PVGV%s\n", tmpbuf);
+	break;
+    case SVt_PVFM:
+	fprintf(stderr,"PVFM%s\n", tmpbuf);
+	break;
+    case SVt_PVIO:
+	fprintf(stderr,"PVIO%s\n", tmpbuf);
+	break;
+    default:
+	fprintf(stderr,"UNKNOWN%s\n", tmpbuf);
+	return;
+    }
+    if (type >= SVt_PVIV || type == SVt_IV)
+	fprintf(stderr, "  IV = %ld\n", (long)SvIVX(sv));
+    if (type >= SVt_PVNV || type == SVt_NV)
+	fprintf(stderr, "  NV = %.*g\n", DBL_DIG, SvNVX(sv));
+    if (SvROK(sv)) {
+	fprintf(stderr, "  RV = 0x%lx\n", (long)SvRV(sv));
+	sv_dump(SvRV(sv));
+	return;
+    }
+    if (type < SVt_PV)
+	return;
+    if (type <= SVt_PVLV) {
+	if (SvPVX(sv))
+	    fprintf(stderr, "  PV = 0x%lx \"%s\"\n  CUR = %ld\n  LEN = %ld\n",
+		(long)SvPVX(sv), SvPVX(sv), (long)SvCUR(sv), (long)SvLEN(sv));
+	else
+	    fprintf(stderr, "  PV = 0\n");
+    }
+    if (type >= SVt_PVMG) {
+	if (SvMAGIC(sv)) {
+	    fprintf(stderr, "  MAGIC = 0x%lx\n", (long)SvMAGIC(sv));
+	}
+	if (SvSTASH(sv))
+	    fprintf(stderr, "  STASH = %s\n", HvNAME(SvSTASH(sv)));
+    }
+    switch (type) {
+    case SVt_PVLV:
+	fprintf(stderr, "  TYPE = %c\n", LvTYPE(sv));
+	fprintf(stderr, "  TARGOFF = %ld\n", (long)LvTARGOFF(sv));
+	fprintf(stderr, "  TARGLEN = %ld\n", (long)LvTARGLEN(sv));
+	fprintf(stderr, "  TARG = 0x%lx\n", (long)LvTARG(sv));
+	sv_dump(LvTARG(sv));
+	break;
+    case SVt_PVAV:
+	fprintf(stderr, "  ARRAY = 0x%lx\n", (long)AvARRAY(sv));
+	fprintf(stderr, "  ALLOC = 0x%lx\n", (long)AvALLOC(sv));
+	fprintf(stderr, "  FILL = %ld\n", (long)AvFILL(sv));
+	fprintf(stderr, "  MAX = %ld\n", (long)AvMAX(sv));
+	fprintf(stderr, "  ARYLEN = 0x%lx\n", (long)AvARYLEN(sv));
+	flags = AvFLAGS(sv);
+	d = tmpbuf;
+	if (flags & AVf_REAL)	strcat(d, "REAL,");
+	if (flags & AVf_REIFY)	strcat(d, "REIFY,");
+	if (flags & AVf_REUSED)	strcat(d, "REUSED,");
+	if (*d)
+	    d[strlen(d)-1] = '\0';
+	fprintf(stderr, "  FLAGS = (%s)\n", d);
+	break;
+    case SVt_PVHV:
+	fprintf(stderr, "  ARRAY = 0x%lx\n",(long)HvARRAY(sv));
+	fprintf(stderr, "  KEYS = %ld\n", (long)HvKEYS(sv));
+	fprintf(stderr, "  FILL = %ld\n", (long)HvFILL(sv));
+	fprintf(stderr, "  MAX = %ld\n", (long)HvMAX(sv));
+	fprintf(stderr, "  RITER = %ld\n", (long)HvRITER(sv));
+	fprintf(stderr, "  EITER = 0x%lx\n",(long) HvEITER(sv));
+	if (HvPMROOT(sv))
+	    fprintf(stderr, "  PMROOT = 0x%lx\n",(long)HvPMROOT(sv));
+	if (HvNAME(sv))
+	    fprintf(stderr, "  NAME = \"%s\"\n", HvNAME(sv));
+	break;
+    case SVt_PVFM:
+    case SVt_PVCV:
+	fprintf(stderr, "  STASH = 0x%lx\n", (long)CvSTASH(sv));
+	fprintf(stderr, "  START = 0x%lx\n", (long)CvSTART(sv));
+	fprintf(stderr, "  ROOT = 0x%lx\n", (long)CvROOT(sv));
+	fprintf(stderr, "  XSUB = 0x%lx\n", (long)CvXSUB(sv));
+	fprintf(stderr, "  XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32);
+	fprintf(stderr, "  FILEGV = 0x%lx\n", (long)CvFILEGV(sv));
+	fprintf(stderr, "  DEPTH = %ld\n", (long)CvDEPTH(sv));
+	fprintf(stderr, "  PADLIST = 0x%lx\n", (long)CvPADLIST(sv));
+	fprintf(stderr, "  OUTSIDE = 0x%lx\n", (long)CvOUTSIDE(sv));
+	if (type == SVt_PVFM)
+	    fprintf(stderr, "  LINES = %ld\n", (long)FmLINES(sv));
+	break;
+    case SVt_PVGV:
+	fprintf(stderr, "  NAME = %s\n", GvNAME(sv));
+	fprintf(stderr, "  NAMELEN = %ld\n", (long)GvNAMELEN(sv));
+	fprintf(stderr, "  STASH = 0x%lx\n", (long)GvSTASH(sv));
+	fprintf(stderr, "  GP = 0x%lx\n", (long)GvGP(sv));
+	fprintf(stderr, "    SV = 0x%lx\n", (long)GvSV(sv));
+	fprintf(stderr, "    REFCNT = %ld\n", (long)GvREFCNT(sv));
+	fprintf(stderr, "    IO = 0x%lx\n", (long)GvIOp(sv));
+	fprintf(stderr, "    FORM = 0x%lx\n", (long)GvFORM(sv));
+	fprintf(stderr, "    AV = 0x%lx\n", (long)GvAV(sv));
+	fprintf(stderr, "    HV = 0x%lx\n", (long)GvHV(sv));
+	fprintf(stderr, "    CV = 0x%lx\n", (long)GvCV(sv));
+	fprintf(stderr, "    CVGEN = 0x%lx\n", (long)GvCVGEN(sv));
+	fprintf(stderr, "    LASTEXPR = %ld\n", (long)GvLASTEXPR(sv));
+	fprintf(stderr, "    LINE = %ld\n", (long)GvLINE(sv));
+	fprintf(stderr, "    FLAGS = 0x%x\n", (int)GvFLAGS(sv));
+	fprintf(stderr, "    STASH = 0x%lx\n", (long)GvSTASH(sv));
+	fprintf(stderr, "    EGV = 0x%lx\n", (long)GvEGV(sv));
+	break;
+    case SVt_PVIO:
+	fprintf(stderr, "  IFP = 0x%lx\n", (long)IoIFP(sv));
+	fprintf(stderr, "  OFP = 0x%lx\n", (long)IoOFP(sv));
+	fprintf(stderr, "  DIRP = 0x%lx\n", (long)IoDIRP(sv));
+	fprintf(stderr, "  LINES = %ld\n", (long)IoLINES(sv));
+	fprintf(stderr, "  PAGE = %ld\n", (long)IoPAGE(sv));
+	fprintf(stderr, "  PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv));
+	fprintf(stderr, "  LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv));
+	fprintf(stderr, "  TOP_NAME = %s\n", IoTOP_NAME(sv));
+	fprintf(stderr, "  TOP_GV = 0x%lx\n", (long)IoTOP_GV(sv));
+	fprintf(stderr, "  FMT_NAME = %s\n", IoFMT_NAME(sv));
+	fprintf(stderr, "  FMT_GV = 0x%lx\n", (long)IoFMT_GV(sv));
+	fprintf(stderr, "  BOTTOM_NAME = %s\n", IoBOTTOM_NAME(sv));
+	fprintf(stderr, "  BOTTOM_GV = 0x%lx\n", (long)IoBOTTOM_GV(sv));
+	fprintf(stderr, "  SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv));
+	fprintf(stderr, "  TYPE = %c\n", IoTYPE(sv));
+	fprintf(stderr, "  FLAGS = 0x%lx\n", (long)IoFLAGS(sv));
+	break;
+    }
+}
+#else
+void
+sv_dump(sv)
+SV* sv;
+{
+}
+#endif
+
+IO*
+sv_2io(sv)
+SV *sv;
+{
+    IO* io;
+    GV* gv;
+
+    switch (SvTYPE(sv)) {
+    case SVt_PVIO:
+	io = (IO*)sv;
+	break;
+    case SVt_PVGV:
+	gv = (GV*)sv;
+	io = GvIO(gv);
+	if (!io)
+	    croak("Bad filehandle: %s", GvNAME(gv));
+	break;
+    default:
+	if (!SvOK(sv))
+	    croak(no_usym, "filehandle");
+	if (SvROK(sv))
+	    return sv_2io(SvRV(sv));
+	gv = gv_fetchpv(SvPV(sv,na), FALSE, SVt_PVIO);
+	if (gv)
+	    io = GvIO(gv);
+	else
+	    io = 0;
+	if (!io)
+	    croak("Bad filehandle: %s", SvPV(sv,na));
+	break;
+    }
+    return io;
+}
+
diff --git a/gnu/usr.bin/perl/sv.h b/gnu/usr.bin/perl/sv.h
new file mode 100644
index 00000000000..c586de4e02a
--- /dev/null
+++ b/gnu/usr.bin/perl/sv.h
@@ -0,0 +1,542 @@
+/*    sv.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#ifdef sv_flags
+#undef sv_flags		/* Convex has this in <signal.h> for sigvec() */
+#endif
+
+typedef enum {
+	SVt_NULL,	/* 0 */
+	SVt_IV,		/* 1 */
+	SVt_NV,		/* 2 */
+	SVt_RV,		/* 3 */
+	SVt_PV,		/* 4 */
+	SVt_PVIV,	/* 5 */
+	SVt_PVNV,	/* 6 */
+	SVt_PVMG,	/* 7 */
+	SVt_PVBM,	/* 8 */
+	SVt_PVLV,	/* 9 */
+	SVt_PVAV,	/* 10 */
+	SVt_PVHV,	/* 11 */
+	SVt_PVCV,	/* 12 */
+	SVt_PVGV,	/* 13 */
+	SVt_PVFM,	/* 14 */
+	SVt_PVIO	/* 15 */
+} svtype;
+
+/* Using C's structural equivalence to help emulate C++ inheritance here... */
+
+struct sv {
+    void*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+struct gv {
+    XPVGV*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+struct cv {
+    XPVCV*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+struct av {
+    XPVAV*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+struct hv {
+    XPVHV*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+struct io {
+    XPVIO*	sv_any;		/* pointer to something */
+    U32		sv_refcnt;	/* how many references to us */
+    U32		sv_flags;	/* what we are */
+};
+
+#define SvANY(sv)	(sv)->sv_any
+#define SvFLAGS(sv)	(sv)->sv_flags
+
+#define SvREFCNT(sv)	(sv)->sv_refcnt
+#ifdef CRIPPLED_CC
+#define SvREFCNT_inc(sv)	sv_newref((SV*)sv)
+#define SvREFCNT_dec(sv)	sv_free((SV*)sv)
+#else
+#define SvREFCNT_inc(sv)	((Sv = (SV*)(sv)), \
+				    (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
+#define SvREFCNT_dec(sv)	sv_free((SV*)sv)
+#endif
+
+#define SVTYPEMASK	0xff
+#define SvTYPE(sv)	((sv)->sv_flags & SVTYPEMASK)
+
+#define SvUPGRADE(sv, mt) (SvTYPE(sv) >= mt || sv_upgrade(sv, mt))
+
+#define SVs_PADBUSY	0x00000100	/* reserved for tmp or my already */
+#define SVs_PADTMP	0x00000200	/* in use as tmp */
+#define SVs_PADMY	0x00000400	/* in use a "my" variable */
+#define SVs_TEMP	0x00000800	/* string is stealable? */
+#define SVs_OBJECT	0x00001000	/* is "blessed" */
+#define SVs_GMG		0x00002000	/* has magical get method */
+#define SVs_SMG		0x00004000	/* has magical set method */
+#define SVs_RMG		0x00008000	/* has random magical methods */
+
+#define SVf_IOK		0x00010000	/* has valid public integer value */
+#define SVf_NOK		0x00020000	/* has valid public numeric value */
+#define SVf_POK		0x00040000	/* has valid public pointer value */
+#define SVf_ROK		0x00080000	/* has a valid reference pointer */
+
+#define SVf_FAKE	0x00100000	/* glob or lexical is just a copy */
+#define SVf_OOK		0x00200000	/* has valid offset value */
+#define SVf_BREAK	0x00400000	/* refcnt is artificially low */
+#define SVf_READONLY	0x00800000	/* may not be modified */
+
+#define SVf_THINKFIRST	(SVf_READONLY|SVf_ROK)
+
+#define SVp_IOK		0x01000000	/* has valid non-public integer value */
+#define SVp_NOK		0x02000000	/* has valid non-public numeric value */
+#define SVp_POK		0x04000000	/* has valid non-public pointer value */
+#define SVp_SCREAM	0x08000000	/* has been studied? */
+
+#define SVf_OK		(SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
+			 SVp_IOK|SVp_NOK|SVp_POK)
+
+#ifdef OVERLOAD
+#define SVf_AMAGIC    0x10000000      /* has magical overloaded methods */
+#endif /* OVERLOAD */
+
+#define PRIVSHIFT 8
+
+/* Some private flags. */
+
+#define SVpfm_COMPILED	0x80000000
+
+#define SVpbm_VALID	0x80000000
+#define SVpbm_CASEFOLD	0x40000000
+#define SVpbm_TAIL	0x20000000
+
+#ifdef OVERLOAD
+#define SVpgv_AM        0x40000000
+/* #define SVpgv_badAM     0x20000000 */
+#endif /* OVERLOAD */
+
+struct xrv {
+    SV *	xrv_rv;		/* pointer to another SV */
+};
+
+struct xpv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+};
+
+struct xpviv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+};
+
+struct xpvnv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+};
+
+struct xpvmg {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+};
+
+struct xpvlv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+
+    STRLEN	xlv_targoff;
+    STRLEN	xlv_targlen;
+    SV*		xlv_targ;
+    char	xlv_type;
+};
+
+struct xpvgv {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+
+    GP*		xgv_gp;
+    char*	xgv_name;
+    STRLEN	xgv_namelen;
+    HV*		xgv_stash;
+    U8		xgv_flags;
+};
+
+struct xpvbm {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+
+    I32		xbm_useful;	/* is this constant pattern being useful? */
+    U16		xbm_previous;	/* how many characters in string before rare? */
+    U8		xbm_rare;	/* rarest character in string */
+};
+
+struct xpvfm {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+
+    HV *	xcv_stash;
+    OP *	xcv_start;
+    OP *	xcv_root;
+    void      (*xcv_xsub)_((CV*));
+    ANY		xcv_xsubany;
+    GV *	xcv_gv;
+    GV *	xcv_filegv;
+    long	xcv_depth;		/* >= 2 indicates recursive call */
+    AV *	xcv_padlist;
+    CV *	xcv_outside;
+    I32		xfm_lines;
+};
+
+struct xpvio {
+    char *	xpv_pv;		/* pointer to malloced string */
+    STRLEN	xpv_cur;	/* length of xpv_pv as a C string */
+    STRLEN	xpv_len;	/* allocated size */
+    IV		xiv_iv;		/* integer value or pv offset */
+    double	xnv_nv;		/* numeric value, if any */
+    MAGIC*	xmg_magic;	/* linked list of magicalness */
+    HV*		xmg_stash;	/* class package */
+
+    FILE *	xio_ifp;	/* ifp and ofp are normally the same */
+    FILE *	xio_ofp;	/* but sockets need separate streams */
+    DIR *	xio_dirp;	/* for opendir, readdir, etc */
+    long	xio_lines;	/* $. */
+    long	xio_page;	/* $% */
+    long	xio_page_len;	/* $= */
+    long	xio_lines_left;	/* $- */
+    char *	xio_top_name;	/* $^ */
+    GV *	xio_top_gv;	/* $^ */
+    char *	xio_fmt_name;	/* $~ */
+    GV *	xio_fmt_gv;	/* $~ */
+    char *	xio_bottom_name;/* $^B */
+    GV *	xio_bottom_gv;	/* $^B */
+    short	xio_subprocess;	/* -| or |- */
+    char	xio_type;
+    char	xio_flags;
+};
+
+#define IOf_ARGV 1	/* this fp iterates over ARGV */
+#define IOf_START 2	/* check for null ARGV and substitute '-' */
+#define IOf_FLUSH 4	/* this fp wants a flush after write op */
+#define IOf_DIDTOP 8	/* just did top of form */
+
+/* The following macros define implementation-independent predicates on SVs. */
+
+#define SvNIOK(sv)		(SvFLAGS(sv) & (SVf_IOK|SVf_NOK))
+#define SvNIOKp(sv)		(SvFLAGS(sv) & (SVp_IOK|SVp_NOK))
+#define SvNIOK_off(sv)		(SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \
+						  SVp_IOK|SVp_NOK))
+
+#define SvOK(sv)		(SvFLAGS(sv) & SVf_OK)
+
+#ifdef OVERLOAD
+#define SvOK_off(sv)		(SvFLAGS(sv) &=	~(SVf_OK|SVf_AMAGIC),	\
+							SvOOK_off(sv))
+#else
+#define SvOK_off(sv)		(SvFLAGS(sv) &=	~SVf_OK, SvOOK_off(sv))
+#endif /* OVERLOAD */
+
+#define SvOKp(sv)		(SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK))
+#define SvIOKp(sv)		(SvFLAGS(sv) & SVp_IOK)
+#define SvIOKp_on(sv)		(SvOOK_off(sv), SvFLAGS(sv) |= SVp_IOK)
+#define SvNOKp(sv)		(SvFLAGS(sv) & SVp_NOK)
+#define SvNOKp_on(sv)		(SvFLAGS(sv) |= SVp_NOK)
+#define SvPOKp(sv)		(SvFLAGS(sv) & SVp_POK)
+#define SvPOKp_on(sv)		(SvFLAGS(sv) |= SVp_POK)
+
+#define SvIOK(sv)		(SvFLAGS(sv) & SVf_IOK)
+#define SvIOK_on(sv)		(SvOOK_off(sv), \
+				    SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
+#define SvIOK_off(sv)		(SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK))
+#define SvIOK_only(sv)		(SvOOK_off(sv), SvOK_off(sv), \
+				    SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
+
+#define SvNOK(sv)		(SvFLAGS(sv) & SVf_NOK)
+#define SvNOK_on(sv)		(SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
+#define SvNOK_off(sv)		(SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK))
+#define SvNOK_only(sv)		(SvOK_off(sv), \
+				    SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
+
+#define SvPOK(sv)		(SvFLAGS(sv) & SVf_POK)
+#define SvPOK_on(sv)		(SvFLAGS(sv) |= (SVf_POK|SVp_POK))
+#define SvPOK_off(sv)		(SvFLAGS(sv) &= ~(SVf_POK|SVp_POK))
+
+#ifdef OVERLOAD
+#define SvPOK_only(sv)            (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC),   \
+				    SvFLAGS(sv) |= (SVf_POK|SVp_POK))
+#else
+#define SvPOK_only(sv)            (SvFLAGS(sv) &= ~SVf_OK, \
+				    SvFLAGS(sv) |= (SVf_POK|SVp_POK))
+#endif /* OVERLOAD */
+
+#define SvOOK(sv)		(SvFLAGS(sv) & SVf_OOK)
+#define SvOOK_on(sv)		(SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK)
+#define SvOOK_off(sv)		(SvOOK(sv) && sv_backoff(sv))
+
+#define SvFAKE(sv)		(SvFLAGS(sv) & SVf_FAKE)
+#define SvFAKE_on(sv)		(SvFLAGS(sv) |= SVf_FAKE)
+#define SvFAKE_off(sv)		(SvFLAGS(sv) &= ~SVf_FAKE)
+
+#define SvROK(sv)		(SvFLAGS(sv) & SVf_ROK)
+#define SvROK_on(sv)		(SvFLAGS(sv) |= SVf_ROK)
+
+#ifdef OVERLOAD
+#define SvROK_off(sv)		(SvFLAGS(sv) &= ~(SVf_ROK|SVf_AMAGIC))
+#else
+#define SvROK_off(sv)		(SvFLAGS(sv) &= ~SVf_ROK)
+#endif /* OVERLOAD */
+
+#define SvMAGICAL(sv)		(SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG))
+#define SvMAGICAL_on(sv)	(SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG))
+#define SvMAGICAL_off(sv)	(SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG))
+
+#define SvGMAGICAL(sv)		(SvFLAGS(sv) & SVs_GMG)
+#define SvGMAGICAL_on(sv)	(SvFLAGS(sv) |= SVs_GMG)
+#define SvGMAGICAL_off(sv)	(SvFLAGS(sv) &= ~SVs_GMG)
+
+#define SvSMAGICAL(sv)		(SvFLAGS(sv) & SVs_SMG)
+#define SvSMAGICAL_on(sv)	(SvFLAGS(sv) |= SVs_SMG)
+#define SvSMAGICAL_off(sv)	(SvFLAGS(sv) &= ~SVs_SMG)
+
+#define SvRMAGICAL(sv)		(SvFLAGS(sv) & SVs_RMG)
+#define SvRMAGICAL_on(sv)	(SvFLAGS(sv) |= SVs_RMG)
+#define SvRMAGICAL_off(sv)	(SvFLAGS(sv) &= ~SVs_RMG)
+
+#ifdef OVERLOAD
+#define SvAMAGIC(sv)         (SvFLAGS(sv) & SVf_AMAGIC)
+#define SvAMAGIC_on(sv)      (SvFLAGS(sv) |= SVf_AMAGIC)
+#define SvAMAGIC_off(sv)     (SvFLAGS(sv) &= ~SVf_AMAGIC)
+
+/*
+#define Gv_AMG(stash) \
+        (HV_AMAGICmb(stash) && \
+         ((!HV_AMAGICbad(stash) && HV_AMAGIC(stash)) || Gv_AMupdate(stash)))
+*/
+#define Gv_AMG(stash)           (amagic_generation && Gv_AMupdate(stash))
+#endif /* OVERLOAD */
+
+#define SvTHINKFIRST(sv)	(SvFLAGS(sv) & SVf_THINKFIRST)
+
+#define SvPADBUSY(sv)		(SvFLAGS(sv) & SVs_PADBUSY)
+
+#define SvPADTMP(sv)		(SvFLAGS(sv) & SVs_PADTMP)
+#define SvPADTMP_on(sv)		(SvFLAGS(sv) |= SVs_PADTMP|SVs_PADBUSY)
+#define SvPADTMP_off(sv)	(SvFLAGS(sv) &= ~SVs_PADTMP)
+
+#define SvPADMY(sv)		(SvFLAGS(sv) & SVs_PADMY)
+#define SvPADMY_on(sv)		(SvFLAGS(sv) |= SVs_PADMY|SVs_PADBUSY)
+
+#define SvTEMP(sv)		(SvFLAGS(sv) & SVs_TEMP)
+#define SvTEMP_on(sv)		(SvFLAGS(sv) |= SVs_TEMP)
+#define SvTEMP_off(sv)		(SvFLAGS(sv) &= ~SVs_TEMP)
+
+#define SvOBJECT(sv)		(SvFLAGS(sv) & SVs_OBJECT)
+#define SvOBJECT_on(sv)		(SvFLAGS(sv) |= SVs_OBJECT)
+#define SvOBJECT_off(sv)	(SvFLAGS(sv) &= ~SVs_OBJECT)
+
+#define SvREADONLY(sv)		(SvFLAGS(sv) & SVf_READONLY)
+#define SvREADONLY_on(sv)	(SvFLAGS(sv) |= SVf_READONLY)
+#define SvREADONLY_off(sv)	(SvFLAGS(sv) &= ~SVf_READONLY)
+
+#define SvSCREAM(sv)		(SvFLAGS(sv) & SVp_SCREAM)
+#define SvSCREAM_on(sv)		(SvFLAGS(sv) |= SVp_SCREAM)
+#define SvSCREAM_off(sv)	(SvFLAGS(sv) &= ~SVp_SCREAM)
+
+#define SvCOMPILED(sv)		(SvFLAGS(sv) & SVpfm_COMPILED)
+#define SvCOMPILED_on(sv)	(SvFLAGS(sv) |= SVpfm_COMPILED)
+#define SvCOMPILED_off(sv)	(SvFLAGS(sv) &= ~SVpfm_COMPILED)
+
+#define SvTAIL(sv)		(SvFLAGS(sv) & SVpbm_TAIL)
+#define SvTAIL_on(sv)		(SvFLAGS(sv) |= SVpbm_TAIL)
+#define SvTAIL_off(sv)		(SvFLAGS(sv) &= ~SVpbm_TAIL)
+
+#define SvCASEFOLD(sv)		(SvFLAGS(sv) & SVpbm_CASEFOLD)
+#define SvCASEFOLD_on(sv)	(SvFLAGS(sv) |= SVpbm_CASEFOLD)
+#define SvCASEFOLD_off(sv)	(SvFLAGS(sv) &= ~SVpbm_CASEFOLD)
+
+#define SvVALID(sv)		(SvFLAGS(sv) & SVpbm_VALID)
+#define SvVALID_on(sv)		(SvFLAGS(sv) |= SVpbm_VALID)
+#define SvVALID_off(sv)		(SvFLAGS(sv) &= ~SVpbm_VALID)
+
+#define SvRV(sv) ((XRV*)  SvANY(sv))->xrv_rv
+#define SvRVx(sv) SvRV(sv)
+
+#define SvIVX(sv) ((XPVIV*)  SvANY(sv))->xiv_iv
+#define SvIVXx(sv) SvIVX(sv)
+#define SvNVX(sv)  ((XPVNV*)SvANY(sv))->xnv_nv
+#define SvNVXx(sv) SvNVX(sv)
+#define SvPVX(sv)  ((XPV*)  SvANY(sv))->xpv_pv
+#define SvPVXx(sv) SvPVX(sv)
+#define SvCUR(sv) ((XPV*)  SvANY(sv))->xpv_cur
+#define SvLEN(sv) ((XPV*)  SvANY(sv))->xpv_len
+#define SvLENx(sv) SvLEN(sv)
+#define SvEND(sv)(((XPV*)  SvANY(sv))->xpv_pv + ((XPV*)SvANY(sv))->xpv_cur)
+#define SvENDx(sv) ((Sv = (sv)), SvEND(Sv))
+#define SvMAGIC(sv)	((XPVMG*)  SvANY(sv))->xmg_magic
+#define SvSTASH(sv)	((XPVMG*)  SvANY(sv))->xmg_stash
+
+#define SvIV_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+		(((XPVIV*)  SvANY(sv))->xiv_iv = val); } STMT_END
+#define SvNV_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) == SVt_NV || SvTYPE(sv) >= SVt_PVNV); \
+		(((XPVNV*)  SvANY(sv))->xnv_nv = val); } STMT_END
+#define SvPV_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
+		(((XPV*)  SvANY(sv))->xpv_pv = val); } STMT_END
+#define SvCUR_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
+		(((XPV*)  SvANY(sv))->xpv_cur = val); } STMT_END
+#define SvLEN_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
+		(((XPV*)  SvANY(sv))->xpv_len = val); } STMT_END
+#define SvEND_set(sv, val) \
+	STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
+		(((XPV*)  SvANY(sv))->xpv_cur = val - SvPVX(sv)); } STMT_END
+
+#define BmRARE(sv)	((XPVBM*)  SvANY(sv))->xbm_rare
+#define BmUSEFUL(sv)	((XPVBM*)  SvANY(sv))->xbm_useful
+#define BmPREVIOUS(sv)	((XPVBM*)  SvANY(sv))->xbm_previous
+
+#define FmLINES(sv)	((XPVFM*)  SvANY(sv))->xfm_lines
+
+#define LvTYPE(sv)	((XPVLV*)  SvANY(sv))->xlv_type
+#define LvTARG(sv)	((XPVLV*)  SvANY(sv))->xlv_targ
+#define LvTARGOFF(sv)	((XPVLV*)  SvANY(sv))->xlv_targoff
+#define LvTARGLEN(sv)	((XPVLV*)  SvANY(sv))->xlv_targlen
+
+#define IoIFP(sv)	((XPVIO*)  SvANY(sv))->xio_ifp
+#define IoOFP(sv)	((XPVIO*)  SvANY(sv))->xio_ofp
+#define IoDIRP(sv)	((XPVIO*)  SvANY(sv))->xio_dirp
+#define IoLINES(sv)	((XPVIO*)  SvANY(sv))->xio_lines
+#define IoPAGE(sv)	((XPVIO*)  SvANY(sv))->xio_page
+#define IoPAGE_LEN(sv)	((XPVIO*)  SvANY(sv))->xio_page_len
+#define IoLINES_LEFT(sv)((XPVIO*)  SvANY(sv))->xio_lines_left
+#define IoTOP_NAME(sv)	((XPVIO*)  SvANY(sv))->xio_top_name
+#define IoTOP_GV(sv)	((XPVIO*)  SvANY(sv))->xio_top_gv
+#define IoFMT_NAME(sv)	((XPVIO*)  SvANY(sv))->xio_fmt_name
+#define IoFMT_GV(sv)	((XPVIO*)  SvANY(sv))->xio_fmt_gv
+#define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name
+#define IoBOTTOM_GV(sv)	((XPVIO*)  SvANY(sv))->xio_bottom_gv
+#define IoSUBPROCESS(sv)((XPVIO*)  SvANY(sv))->xio_subprocess
+#define IoTYPE(sv)	((XPVIO*)  SvANY(sv))->xio_type
+#define IoFLAGS(sv)	((XPVIO*)  SvANY(sv))->xio_flags
+
+#define SvTAINT(sv) if (tainting && tainted) sv_magic(sv, Nullsv, 't', Nullch, 0)
+
+#ifdef CRIPPLED_CC
+
+IV SvIV _((SV* sv));
+double SvNV _((SV* sv));
+#define SvPV_force(sv, lp) sv_pvn_force(sv, &lp)
+#define SvPV(sv, lp) sv_pvn(sv, &lp)
+char *sv_pvn _((SV *, STRLEN *));
+I32 SvTRUE _((SV *));
+
+#define SvIVx(sv) SvIV(sv)
+#define SvNVx(sv) SvNV(sv)
+#define SvPVx(sv, lp) sv_pvn(sv, &lp)
+#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
+#define SvTRUEx(sv) SvTRUE(sv)
+
+#else /* !CRIPPLED_CC */
+
+#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv))
+
+#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
+
+#define SvPV(sv, lp) (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp))
+
+#define SvPV_force(sv, lp) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force(sv, &lp))
+
+#define SvTRUE(sv) (						\
+    !sv								\
+    ? 0								\
+    :    SvPOK(sv)						\
+	?   ((Xpv = (XPV*)SvANY(sv)) &&				\
+	     (*Xpv->xpv_pv > '0' ||				\
+	      Xpv->xpv_cur > 1 ||				\
+	      (Xpv->xpv_cur && *Xpv->xpv_pv != '0'))		\
+	     ? 1						\
+	     : 0)						\
+	:							\
+	    SvIOK(sv)						\
+	    ? SvIVX(sv) != 0					\
+	    :   SvNOK(sv)					\
+		? SvNVX(sv) != 0.0				\
+		: sv_2bool(sv) )
+
+#define SvIVx(sv) ((Sv = (sv)), SvIV(Sv))
+#define SvNVx(sv) ((Sv = (sv)), SvNV(Sv))
+#define SvPVx(sv, lp) ((Sv = (sv)), SvPV(Sv, lp))
+#define SvTRUEx(sv) ((Sv = (sv)), SvTRUE(Sv))
+
+#endif /* CRIPPLED_CC */
+
+/* the following macro updates any magic values this sv is associated with */
+
+#define SvSETMAGIC(x) if (SvSMAGICAL(x)) mg_set(x)
+
+#define SvSetSV(dst,src) if (dst != src) sv_setsv(dst,src)
+
+#define SvPEEK(sv) sv_peek(sv)
+
+#define isGV(sv) (SvTYPE(sv) == SVt_PVGV)
+
+#ifndef DOSISH
+#  define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
+#  define Sv_Grow sv_grow
+#else
+    /* extra parentheses intentionally NOT placed around "len"! */
+#  define SvGROW(sv,len) ((SvLEN(sv) < (unsigned long)len) \
+		? sv_grow(sv,(unsigned long)len) : SvPVX(sv))
+#  define Sv_Grow(sv,len) sv_grow(sv,(unsigned long)(len))
+#endif /* DOSISH */
diff --git a/gnu/usr.bin/perl/t/README b/gnu/usr.bin/perl/t/README
new file mode 100644
index 00000000000..d714295dd25
--- /dev/null
+++ b/gnu/usr.bin/perl/t/README
@@ -0,0 +1,11 @@
+This is the perl test library.  To run all the tests, just type 'TEST'.
+
+To add new tests, just look at the current tests and do likewise.
+
+If a test fails, run it by itself to see if it prints any informative
+diagnostics.  If not, modify the test to print informative diagnostics.
+If you put out extra lines with a '#' character on the front, you don't
+have to worry about removing the extra print statements later since TEST
+ignores lines beginning with '#'.
+
+If you come up with new tests, send them to lwall@sems.com.
diff --git a/gnu/usr.bin/perl/t/TEST b/gnu/usr.bin/perl/t/TEST
new file mode 100644
index 00000000000..291eab5bdb3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/TEST
@@ -0,0 +1,112 @@
+#!./perl
+
+# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $
+
+# This is written in a peculiar style, since we're trying to avoid
+# most of the constructs we'll be testing for.
+
+$| = 1;
+
+if ($ARGV[0] eq '-v') {
+    $verbose = 1;
+    shift;
+}
+
+chdir 't' if -f 't/TEST';
+
+die "You need to run \"make test\" first to set things up.\n" 
+  unless -e 'perl' or -e 'perl.exe';
+
+$ENV{EMXSHELL} = 'sh';        # For OS/2
+
+if ($ARGV[0] eq '') {
+    @ARGV = split(/[ \n]/,
+      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
+}
+
+open(CONFIG,"../config.sh");
+while (<CONFIG>) {
+    if (/sharpbang='(.*)'/) {
+	$sharpbang = ($1 eq '#!');
+	last;
+    }
+}
+$sharpbang = 0 if $ENV{OS2_SHELL};		# OS/2
+$bad = 0;
+$good = 0;
+$total = @ARGV;
+while ($test = shift) {
+    if ($test =~ /^$/) {
+	next;
+    }
+    $te = $test;
+    chop($te);
+    print "$te" . '.' x (15 - length($te));
+    if ($sharpbang) {
+	open(results,"./$test |") || (print "can't run.\n");
+    } else {
+	open(script,"$test") || die "Can't run $test.\n";
+	$_ = <script>;
+	close(script);
+	if (/#!..perl(.*)/) {
+	    $switch = $1;
+	} else {
+	    $switch = '';
+	}
+	open(results,"./perl$switch $test |") || (print "can't run.\n");
+    }
+    $ok = 0;
+    $next = 0;
+    while (<results>) {
+	if ($verbose) {
+	    print $_;
+	}
+	unless (/^#/) {
+	    if (/^1\.\.([0-9]+)/) {
+		$max = $1;
+		$totmax += $max;
+		$files += 1;
+		$next = 1;
+		$ok = 1;
+	    } else {
+		$next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+		if (/^ok (.*)/ && $1 == $next) {
+		    $next = $next + 1;
+		} else {
+		    $ok = 0;
+		}
+	    }
+	}
+    }
+    $next = $next - 1;
+    if ($ok && $next == $max) {
+	print "ok\n";
+	$good = $good + 1;
+    } else {
+	$next += 1;
+	print "FAILED on test $next\n";
+	$bad = $bad + 1;
+	$_ = $test;
+	if (/^base/) {
+	    die "Failed a basic test--cannot continue.\n";
+	}
+    }
+}
+
+if ($bad == 0) {
+    if ($ok) {
+	print "All tests successful.\n";
+    } else {
+	die "FAILED--no tests were run for some reason.\n";
+    }
+} else {
+    $pct = sprintf("%.2f", $good / $total * 100);
+    if ($bad == 1) {
+	warn "Failed 1 test, $pct% okay.\n";
+    } else {
+	die "Failed $bad/$total tests, $pct% okay.\n";
+    }
+}
+($user,$sys,$cuser,$csys) = times;
+print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
+    $user,$sys,$cuser,$csys,$files,$totmax);
diff --git a/gnu/usr.bin/perl/t/base/cond.t b/gnu/usr.bin/perl/t/base/cond.t
new file mode 100644
index 00000000000..9a57348474e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/base/cond.t
@@ -0,0 +1,19 @@
+#!./perl
+
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:02 $
+
+# make sure conditional operators work
+
+print "1..4\n";
+
+$x = '0';
+
+$x eq $x && (print "ok 1\n");
+$x ne $x && (print "not ok 1\n");
+$x eq $x || (print "not ok 2\n");
+$x ne $x || (print "ok 2\n");
+
+$x == $x && (print "ok 3\n");
+$x != $x && (print "not ok 3\n");
+$x == $x || (print "not ok 4\n");
+$x != $x || (print "ok 4\n");
diff --git a/gnu/usr.bin/perl/t/base/if.t b/gnu/usr.bin/perl/t/base/if.t
new file mode 100644
index 00000000000..12db7652e49
--- /dev/null
+++ b/gnu/usr.bin/perl/t/base/if.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $RCSfile: if.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:03 $
+
+print "1..2\n";
+
+# first test to see if we can run the tests.
+
+$x = 'test';
+if ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";}
+if ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";}
diff --git a/gnu/usr.bin/perl/t/base/lex.t b/gnu/usr.bin/perl/t/base/lex.t
new file mode 100644
index 00000000000..f25cd2a12c5
--- /dev/null
+++ b/gnu/usr.bin/perl/t/base/lex.t
@@ -0,0 +1,91 @@
+#!./perl
+
+# $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
+
+print "1..24\n";
+
+$x = 'x';
+
+print "#1	:$x: eq :x:\n";
+if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = $#;	# this is the register $#
+
+if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = $#x;
+
+if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
+
+$x = '\\'; # ';
+
+if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
+
+eval 'while (0) {
+    print "foo\n";
+}
+/^/ && (print "ok 5\n");
+';
+
+eval '$foo{1} / 1;';
+if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
+
+eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
+
+$foo = int($foo * 100 + .5);
+if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}
+
+print <<'EOF';
+ok 8
+EOF
+
+$foo = 'ok 9';
+print <<EOF;
+$foo
+EOF
+
+eval <<\EOE, print $@;
+print <<'EOF';
+ok 10
+EOF
+
+$foo = 'ok 11';
+print <<EOF;
+$foo
+EOF
+EOE
+
+print <<`EOS` . <<\EOF;
+echo ok 12
+EOS
+ok 13
+EOF
+
+print qq/ok 14\n/;
+print qq(ok 15\n);
+
+print qq
+[ok 16\n]
+;
+
+print q<ok 17
+>;
+
+print <<;   # Yow!
+ok 18
+
+# previous line intentionally left blank.
+
+$foo = FOO;
+$bar = BAR;
+$foo{$bar} = BAZ;
+$ary[0] = ABC;
+
+print "$foo{$bar}" eq "BAZ" ? "ok 19\n" : "not ok 19\n";
+
+print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 20\n" : "not ok 20\n";
+print "${foo{$bar}}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
+
+print "FOO:" =~ /$foo[:]/ ? "ok 22\n" : "not ok 22\n";
+print "ABC" =~ /^$ary[$A]$/ ? "ok 23\n" : "not ok 23\n";
+print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 24\n" : "not ok 24\n";
diff --git a/gnu/usr.bin/perl/t/base/pat.t b/gnu/usr.bin/perl/t/base/pat.t
new file mode 100644
index 00000000000..c689f4552d9
--- /dev/null
+++ b/gnu/usr.bin/perl/t/base/pat.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:05 $
+
+print "1..2\n";
+
+# first test to see if we can run the tests.
+
+$_ = 'test';
+if (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";}
+if (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";}
diff --git a/gnu/usr.bin/perl/t/base/term.t b/gnu/usr.bin/perl/t/base/term.t
new file mode 100644
index 00000000000..42cd56fe0ba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/base/term.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $
+
+print "1..6\n";
+
+# check "" interpretation
+
+$x = "\n";
+if ($x lt ' ') {print "ok 1\n";} else {print "not ok 1\n";}
+
+# check `` processing
+
+$x = `echo hi there`;
+if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+# check $#array
+
+$x[0] = 'foo';
+$x[1] = 'foo';
+$tmp = $#x;
+print "#3\t:$tmp: == :1:\n";
+if ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";}
+
+# check numeric literal
+
+$x = 1;
+if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";}
+
+# check <> pseudoliteral
+
+open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null.");
+if (<try> eq '') {
+    print "ok 5\n";
+}
+else {
+    print "not ok 5\n";
+    die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null';
+}
+
+open(try, "../Configure") || (die "Can't open ../Configure.");
+if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
diff --git a/gnu/usr.bin/perl/t/cmd/elsif.t b/gnu/usr.bin/perl/t/cmd/elsif.t
new file mode 100644
index 00000000000..7eace161e04
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/elsif.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# $RCSfile: elsif.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:08 $
+
+sub foo {
+    if ($_[0] == 1) {
+	1;
+    }
+    elsif ($_[0] == 2) {
+	2;
+    }
+    elsif ($_[0] == 3) {
+	3;
+    }
+    else {
+	4;
+    }
+}
+
+print "1..4\n";
+
+if (($x = &foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if (($x = &foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";}
+if (($x = &foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";}
+if (($x = &foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";}
diff --git a/gnu/usr.bin/perl/t/cmd/for.t b/gnu/usr.bin/perl/t/cmd/for.t
new file mode 100644
index 00000000000..e45f05040bc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/for.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $
+
+print "1..7\n";
+
+for ($i = 0; $i <= 10; $i++) {
+    $x[$i] = $i;
+}
+$y = $x[10];
+print "#1	:$y: eq :10:\n";
+$y = join(' ', @x);
+print "#1	:$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
+if (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+	print "ok 1\n";
+} else {
+	print "not ok 1\n";
+}
+
+$i = $c = 0;
+for (;;) {
+	$c++;
+	last if $i++ > 10;
+}
+if ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$foo = 3210;
+@ary = (1,2,3,4,5);
+foreach $foo (@ary) {
+	$foo *= 2;
+}
+if (join('',@ary) eq '246810') {print "ok 3\n";} else {print "not ok 3\n";}
+
+for (@ary) {
+    s/(.*)/ok $1\n/;
+}
+
+print $ary[1];
+
+# test for internal scratch array generation
+# this also tests that $foo was restored to 3210 after test 3
+for (split(' ','a b c d e')) {
+	$foo .= $_;
+}
+if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
+
+foreach $foo (("ok 6\n","ok 7\n")) {
+	print $foo;
+}
diff --git a/gnu/usr.bin/perl/t/cmd/mod.t b/gnu/usr.bin/perl/t/cmd/mod.t
new file mode 100644
index 00000000000..9d9170ff3fa
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/mod.t
@@ -0,0 +1,33 @@
+#!./perl
+
+# $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
+
+print "1..7\n";
+
+print "ok 1\n" if 1;
+print "not ok 1\n" unless 1;
+
+print "ok 2\n" unless 0;
+print "not ok 2\n" if 0;
+
+1 && (print "not ok 3\n") if 0;
+1 && (print "ok 3\n") if 1;
+0 || (print "not ok 4\n") if 0;
+0 || (print "ok 4\n") if 1;
+
+$x = 0;
+do {$x[$x] = $x;} while ($x++) < 10;
+if (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+	print "ok 5\n";
+} else {
+	print "not ok 5 @x\n";
+}
+
+$x = 15;
+$x = 10 while $x < 10;
+if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
+
+open(foo,'./TEST') || open(foo,'TEST') || open(foo,'t/TEST');
+$x = 0;
+$x++ while <foo>;
+print $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
diff --git a/gnu/usr.bin/perl/t/cmd/subval.t b/gnu/usr.bin/perl/t/cmd/subval.t
new file mode 100644
index 00000000000..3c1ffb89ea7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/subval.t
@@ -0,0 +1,179 @@
+#!./perl
+
+# $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $
+
+sub foo1 {
+    'true1';
+    if ($_[0]) { 'true2'; }
+}
+
+sub foo2 {
+    'true1';
+    if ($_[0]) { return 'true2'; } else { return 'true3'; }
+    'true0';
+}
+
+sub foo3 {
+    'true1';
+    unless ($_[0]) { 'true2'; }
+}
+
+sub foo4 {
+    'true1';
+    unless ($_[0]) { 'true2'; } else { 'true3'; }
+}
+
+sub foo5 {
+    'true1';
+    'true2' if $_[0];
+}
+
+sub foo6 {
+    'true1';
+    'true2' unless $_[0];
+}
+
+print "1..34\n";
+
+if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
+if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
+if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
+
+if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
+if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
+if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
+if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
+if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
+if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
+if (&foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
+
+# Now test to see that recursion works using a Fibonacci number generator
+
+sub fib {
+    my($arg) = @_;
+    my($foo);
+    $level++;
+    if ($arg <= 2) {
+	$foo = 1;
+    }
+    else {
+	$foo = &fib($arg-1) + &fib($arg-2);
+    }
+    $level--;
+    $foo;
+}
+
+@good = (0,1,1,2,3,5,8,13,21,34,55,89);
+
+for ($i = 1; $i <= 10; $i++) {
+    $foo = $i + 12;
+    if (&fib($i) == $good[$i]) {
+	print "ok $foo\n";
+    }
+    else {
+	print "not ok $foo\n";
+    }
+}
+
+sub ary1 {
+    (1,2,3);
+}
+
+print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
+
+print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
+
+sub ary2 {
+    do {
+	return (1,2,3);
+	(3,2,1);
+    };
+    0;
+}
+
+print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
+
+$x = join(':',&ary2);
+print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
+
+sub somesub {
+    local($num,$P,$F,$L) = @_;
+    ($p,$f,$l) = caller;
+    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
+}
+
+&somesub(27, 'main', __FILE__, __LINE__);
+
+package foo;
+&main'somesub(28, 'foo', __FILE__, __LINE__);
+
+package main;
+$i = 28;
+open(FOO,">Cmd_subval.tmp");
+print FOO "blah blah\n";
+close FOO;
+
+&file_main(*F);
+close F;
+&info_main;
+
+&file_package(*F);
+close F;
+&info_package;
+
+unlink 'Cmd_subval.tmp';
+
+sub file_main {
+        local(*F) = @_;
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$i++;
+        eof F ? print "not ok $i\n" : print "ok $i\n";
+}
+
+sub info_main {
+        local(*F);
+
+        open(F, 'Cmd_subval.tmp') || die "test: can't open\n";
+	$i++;
+        eof F ? print "not ok $i\n" : print "ok $i\n";
+        &iseof(*F);
+	close F;
+}
+
+sub iseof {
+        local(*UNIQ) = @_;
+
+	$i++;
+        eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
+}
+
+{package foo;
+
+ sub main'file_package {
+        local(*F) = @_;
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$main'i++;
+        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+
+ sub main'info_package {
+        local(*F);
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$main'i++;
+        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+        &iseof(*F);
+ }
+
+ sub iseof {
+        local(*UNIQ) = @_;
+
+	$main'i++;
+        eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+}
diff --git a/gnu/usr.bin/perl/t/cmd/switch.t b/gnu/usr.bin/perl/t/cmd/switch.t
new file mode 100644
index 00000000000..faa5de470f3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/switch.t
@@ -0,0 +1,75 @@
+#!./perl
+
+# $RCSfile: switch.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:14 $
+
+print "1..18\n";
+
+sub foo1 {
+    $_ = shift(@_);
+    $a = 0;
+    until ($a++) {
+	next if $_ eq 1;
+	next if $_ eq 2;
+	next if $_ eq 3;
+	next if $_ eq 4;
+	return 20;
+    }
+    continue {
+	return $_;
+    }
+}
+
+print do foo1(0) == 20 ? "ok 1\n" : "not ok 1\n";
+print do foo1(1) == 1 ? "ok 2\n" : "not ok 2\n";
+print do foo1(2) == 2 ? "ok 3\n" : "not ok 3\n";
+print do foo1(3) == 3 ? "ok 4\n" : "not ok 4\n";
+print do foo1(4) == 4 ? "ok 5\n" : "not ok 5\n";
+print do foo1(5) == 20 ? "ok 6\n" : "not ok 6\n";
+
+sub foo2 {
+    $_ = shift(@_);
+    {
+	last if $_ == 1;
+	last if $_ == 2;
+	last if $_ == 3;
+	last if $_ == 4;
+    }
+    continue {
+	return 20;
+    }
+    return $_;
+}
+
+print do foo2(0) == 20 ? "ok 7\n" : "not ok 7\n";
+print do foo2(1) == 1 ? "ok 8\n" : "not ok 8\n";
+print do foo2(2) == 2 ? "ok 9\n" : "not ok 9\n";
+print do foo2(3) == 3 ? "ok 10\n" : "not ok 10\n";
+print do foo2(4) == 4 ? "ok 11\n" : "not ok 11\n";
+print do foo2(5) == 20 ? "ok 12\n" : "not ok 12\n";
+
+sub foo3 {
+    $_ = shift(@_);
+    if (/^1/) {
+	return 1;
+    }
+    elsif (/^2/) {
+	return 2;
+    }
+    elsif (/^3/) {
+	return 3;
+    }
+    elsif (/^4/) {
+	return 4;
+    }
+    else {
+	return 20;
+    }
+    return 40;
+}
+
+print do foo3(0) == 20 ? "ok 13\n" : "not ok 13\n";
+print do foo3(1) == 1 ? "ok 14\n" : "not ok 14\n";
+print do foo3(2) == 2 ? "ok 15\n" : "not ok 15\n";
+print do foo3(3) == 3 ? "ok 16\n" : "not ok 16\n";
+print do foo3(4) == 4 ? "ok 17\n" : "not ok 17\n";
+print do foo3(5) == 20 ? "ok 18\n" : "not ok 18\n";
diff --git a/gnu/usr.bin/perl/t/cmd/while.t b/gnu/usr.bin/perl/t/cmd/while.t
new file mode 100644
index 00000000000..4c8c10e990a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/cmd/while.t
@@ -0,0 +1,110 @@
+#!./perl
+
+# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
+
+print "1..10\n";
+
+open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
+print tmp "tvi925\n";
+print tmp "tvi920\n";
+print tmp "vt100\n";
+print tmp "Amiga\n";
+print tmp "paper\n";
+close tmp;
+
+# test "last" command
+
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    last if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
+
+# test "next" command
+
+$bad = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    next if /vt100/;
+    $bad = 1 if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
+
+# test "redo" command
+
+$bad = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+}
+if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
+
+# now do the same with a label and a continue block
+
+# test "last" command
+
+$badcont = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+line: while (<fh>) {
+    if (/vt100/) {last line;}
+} continue {
+    $badcont = 1 if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
+if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
+
+# test "next" command
+
+$bad = '';
+$badcont = 1;
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+entry: while (<fh>) {
+    next entry if /vt100/;
+    $bad = 1 if /vt100/;
+} continue {
+    $badcont = '' if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
+if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
+
+# test "redo" command
+
+$bad = '';
+$badcont = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+loop: while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo loop;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+} continue {
+    $badcont = 1 if /vt100/;
+}
+if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
+if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
+
+unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`;
+
+#$x = 0;
+#while (1) {
+#    if ($x > 1) {last;}
+#    next;
+#} continue {
+#    if ($x++ > 10) {last;}
+#    next;
+#}
+#
+#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
+
+$i = 9;
+{
+    $i++;
+}
+print "ok $i\n";
diff --git a/gnu/usr.bin/perl/t/comp/cmdopt.t b/gnu/usr.bin/perl/t/comp/cmdopt.t
new file mode 100644
index 00000000000..4d5c78a4cb5
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cmdopt.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $RCSfile: cmdopt.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:17 $
+
+print "1..40\n";
+
+# test the optimization of constants
+
+if (1) { print "ok 1\n";} else { print "not ok 1\n";}
+unless (0) { print "ok 2\n";} else { print "not ok 2\n";}
+
+if (0) { print "not ok 3\n";} else { print "ok 3\n";}
+unless (1) { print "not ok 4\n";} else { print "ok 4\n";}
+
+unless (!1) { print "ok 5\n";} else { print "not ok 5\n";}
+if (!0) { print "ok 6\n";} else { print "not ok 6\n";}
+
+unless (!0) { print "not ok 7\n";} else { print "ok 7\n";}
+if (!1) { print "not ok 8\n";} else { print "ok 8\n";}
+
+$x = 1;
+if (1 && $x) { print "ok 9\n";} else { print "not ok 9\n";}
+if (0 && $x) { print "not ok 10\n";} else { print "ok 10\n";}
+$x = '';
+if (1 && $x) { print "not ok 11\n";} else { print "ok 11\n";}
+if (0 && $x) { print "not ok 12\n";} else { print "ok 12\n";}
+
+$x = 1;
+if (1 || $x) { print "ok 13\n";} else { print "not ok 13\n";}
+if (0 || $x) { print "ok 14\n";} else { print "not ok 14\n";}
+$x = '';
+if (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";}
+if (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";}
+
+
+# test the optimization of variables
+
+$x = 1;
+if ($x) { print "ok 17\n";} else { print "not ok 17\n";}
+unless ($x) { print "not ok 18\n";} else { print "ok 18\n";}
+
+$x = '';
+if ($x) { print "not ok 19\n";} else { print "ok 19\n";}
+unless ($x) { print "ok 20\n";} else { print "not ok 20\n";}
+
+# test optimization of string operations
+
+$a = 'a';
+if ($a eq 'a') { print "ok 21\n";} else { print "not ok 21\n";}
+if ($a ne 'a') { print "not ok 22\n";} else { print "ok 22\n";}
+
+if ($a =~ /a/) { print "ok 23\n";} else { print "not ok 23\n";}
+if ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";}
+# test interaction of logicals and other operations
+
+$a = 'a';
+$x = 1;
+if ($a eq 'a' and $x) { print "ok 25\n";} else { print "not ok 25\n";}
+if ($a ne 'a' and $x) { print "not ok 26\n";} else { print "ok 26\n";}
+$x = '';
+if ($a eq 'a' and $x) { print "not ok 27\n";} else { print "ok 27\n";}
+if ($a ne 'a' and $x) { print "not ok 28\n";} else { print "ok 28\n";}
+
+$x = 1;
+if ($a eq 'a' or $x) { print "ok 29\n";} else { print "not ok 29\n";}
+if ($a ne 'a' or $x) { print "ok 30\n";} else { print "not ok 30\n";}
+$x = '';
+if ($a eq 'a' or $x) { print "ok 31\n";} else { print "not ok 31\n";}
+if ($a ne 'a' or $x) { print "not ok 32\n";} else { print "ok 32\n";}
+
+$x = 1;
+if ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
+if ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
+$x = '';
+if ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
+if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
+
+$x = 1;
+if ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
+if ($a !~ /a/ || $x) { print "ok 38\n";} else { print "not ok 38\n";}
+$x = '';
+if ($a =~ /a/ || $x) { print "ok 39\n";} else { print "not ok 39\n";}
+if ($a !~ /a/ || $x) { print "not ok 40\n";} else { print "ok 40\n";}
diff --git a/gnu/usr.bin/perl/t/comp/cpp.aux b/gnu/usr.bin/perl/t/comp/cpp.aux
new file mode 100644
index 00000000000..11865665d71
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cpp.aux
@@ -0,0 +1,39 @@
+#!./perl -P
+
+# $RCSfile: cpp.aux,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:11 $
+
+print "1..3\n";
+
+#this is a comment
+#define MESS "ok 1\n"
+print MESS;
+
+#If you capitalize, it's a comment.
+#ifdef MESS
+	print "ok 2\n";
+#else
+	print "not ok 2\n";
+#endif
+
+open(TRY,">Comp.cpp.tmp") || die "Can't open temp perl file.";
+
+($prog = <<'END') =~ s/X//g;
+X$ok = "not ok 3\n";
+X#include "Comp.cpp.inc"
+X#ifdef OK
+X$ok = OK;
+X#endif
+Xprint $ok;
+END
+print TRY $prog;
+close TRY;
+
+open(TRY,">Comp.cpp.inc") || (die "Can't open temp include file.");
+print TRY '#define OK "ok 3\n"' . "\n";
+close TRY;
+
+$pwd=`pwd`;
+$pwd =~ s/\n//;
+$x = `./perl -P Comp.cpp.tmp`;
+print $x;
+unlink "Comp.cpp.tmp", "Comp.cpp.inc";
diff --git a/gnu/usr.bin/perl/t/comp/cpp.t b/gnu/usr.bin/perl/t/comp/cpp.t
new file mode 100644
index 00000000000..cea46f0d964
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/cpp.t
@@ -0,0 +1,17 @@
+#!./perl
+
+# $RCSfile: cpp.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:11 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+if ( ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
+     ( ! -x $Config{'scriptdir'} . "/cppstdin") ) {
+    print "1..0\n";
+    exit; 		# Cannot test till after install, alas.
+}
+
+system "./perl -P comp/cpp.aux"
diff --git a/gnu/usr.bin/perl/t/comp/decl.t b/gnu/usr.bin/perl/t/comp/decl.t
new file mode 100644
index 00000000000..32b8509df77
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/decl.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: decl.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:19 $
+
+# check to see if subroutine declarations work everwhere
+
+sub one {
+    print "ok 1\n";
+}
+format one =
+ok 5
+.
+
+print "1..7\n";
+
+do one();
+do two();
+
+sub two {
+    print "ok 2\n";
+}
+format two =
+@<<<
+$foo
+.
+
+if ($x eq $x) {
+    sub three {
+	print "ok 3\n";
+    }
+    do three();
+}
+
+do four();
+$~ = 'one';
+write;
+$~ = 'two';
+$foo = "ok 6";
+write;
+$~ = 'three';
+write;
+
+format three =
+ok 7
+.
+
+sub four {
+    print "ok 4\n";
+}
diff --git a/gnu/usr.bin/perl/t/comp/multiline.t b/gnu/usr.bin/perl/t/comp/multiline.t
new file mode 100644
index 00000000000..634b06a7a84
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/multiline.t
@@ -0,0 +1,40 @@
+#!./perl
+
+# $RCSfile: multiline.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:20 $
+
+print "1..5\n";
+
+open(try,'>Comp.try') || (die "Can't open temp file.");
+
+$x = 'now is the time
+for all good men
+to come to.
+';
+
+$y = 'now is the time' . "\n" .
+'for all good men' . "\n" .
+'to come to.' . "\n";
+
+if ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
+
+print try $x;
+close try;
+
+open(try,'Comp.try') || (die "Can't reopen temp file.");
+$count = 0;
+$z = '';
+while (<try>) {
+    $z .= $_;
+    $count = $count + 1;
+}
+
+if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$_ = `cat Comp.try`;
+
+if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
+unlink 'Comp.try' || `/bin/rm -f Comp.try`;
+
+if ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
diff --git a/gnu/usr.bin/perl/t/comp/package.t b/gnu/usr.bin/perl/t/comp/package.t
new file mode 100644
index 00000000000..ca800bb3647
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/package.t
@@ -0,0 +1,35 @@
+#!./perl
+
+print "1..7\n";
+
+$blurfl = 123;
+$foo = 3;
+
+package XYZ;
+
+$bar = 4;
+
+{
+    package ABC;
+    $blurfl = 5;
+    $main'a = $'b;
+}
+
+$ABC'dyick = 6;
+
+$xyz = 2;
+
+$main = join(':', sort(keys %main::));
+$XYZ = join(':', sort(keys %XYZ::));
+$ABC = join(':', sort(keys %ABC::));
+
+print $XYZ eq 'ABC:XYZ:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$XYZ'\n";
+print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
+print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+
+package ABC;
+
+print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
+eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
+eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
+print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
diff --git a/gnu/usr.bin/perl/t/comp/script.t b/gnu/usr.bin/perl/t/comp/script.t
new file mode 100644
index 00000000000..7ca65037588
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/script.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $RCSfile: script.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:12 $
+
+print "1..3\n";
+
+$x = `./perl -e 'print "ok\n";'`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; }
+
+if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+open(try,">Comp.script") || (die "Can't open temp file.");
+print try 'print "ok\n";'; print try "\n";
+close try;
+
+$x = `./perl Comp.script`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; }
+
+if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = `./perl <Comp.script`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; }
+
+if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
+
+unlink 'Comp.script' || `/bin/rm -f Comp.script`;
diff --git a/gnu/usr.bin/perl/t/comp/term.t b/gnu/usr.bin/perl/t/comp/term.t
new file mode 100644
index 00000000000..b248e9b1613
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/term.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $
+
+# tests that aren't important enough for base.term
+
+print "1..14\n";
+
+$x = "\\n";
+print "#1\t:$x: eq " . ':\n:' . "\n";
+if ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = "#2\t:$x: eq :\\n:\n";
+print $x;
+unless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$one = 'a';
+
+if (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";}
+if (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";}
+if (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";}
+if (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";}
+if (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
+if (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
+if (length("\\${one}") == 2) {print "ok 10\n";} else {print "not ok 10\n";}
+
+if ("${one}b" eq "ab") { print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = (1,2,3);
+if ("$foo[1]b" eq "2b") { print "ok 12\n";} else {print "not ok 12\n";}
+if ("@foo[0..1]b" eq "1 2b") { print "ok 13\n";} else {print "not ok 13\n";}
+$" = '::';
+if ("@foo[0..1]b" eq "1::2b") { print "ok 14\n";} else {print "not ok 14\n";}
diff --git a/gnu/usr.bin/perl/t/harness b/gnu/usr.bin/perl/t/harness
new file mode 100644
index 00000000000..c98d91e360e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/harness
@@ -0,0 +1,15 @@
+#!./perl
+
+# We suppose that perl _mostly_ works at this moment, so may use
+# sophisticated testing.
+
+# Note that _before install_ you may need to run it with -I ../lib flag
+
+use lib '../lib';
+use Test::Harness;
+
+$Test::Harness::switches = "";	# Too much noise otherwise
+
+@tests = @ARGV;
+@tests = <*/*.t> unless @tests;
+Test::Harness::runtests @tests;
diff --git a/gnu/usr.bin/perl/t/io/argv.t b/gnu/usr.bin/perl/t/io/argv.t
new file mode 100644
index 00000000000..40ed23b373b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/argv.t
@@ -0,0 +1,36 @@
+#!./perl
+
+# $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $
+
+print "1..5\n";
+
+open(try, '>Io.argv.tmp') || (die "Can't open temp file.");
+print try "a line\n";
+close try;
+
+$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`;
+
+if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`;
+
+if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
+
+if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
+
+@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
+while (<>) {
+    $y .= $. . $_;
+    if (eof()) {
+	if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";}
+    }
+}
+
+if ($y eq "1a line\n2a line\n3a line\n")
+    {print "ok 5\n";}
+else
+    {print "not ok 5\n";}
+
+`/bin/rm -f Io.argv.tmp` if -x '/bin/rm';
diff --git a/gnu/usr.bin/perl/t/io/dup.t b/gnu/usr.bin/perl/t/io/dup.t
new file mode 100644
index 00000000000..901642d8f66
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/dup.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $
+
+print "1..6\n";
+
+print "ok 1\n";
+
+open(dupout,">&STDOUT");
+open(duperr,">&STDERR");
+
+open(STDOUT,">Io.dup") || die "Can't open stdout";
+open(STDERR,">&STDOUT") || die "Can't open stderr";
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print STDOUT "ok 2\n";
+print STDERR "ok 3\n";
+system 'echo ok 4';
+system 'echo ok 5 1>&2';
+
+close(STDOUT);
+close(STDERR);
+
+open(STDOUT,">&dupout");
+open(STDERR,">&duperr");
+
+system 'cat Io.dup';
+unlink 'Io.dup';
+
+print STDOUT "ok 6\n";
diff --git a/gnu/usr.bin/perl/t/io/fs.t b/gnu/usr.bin/perl/t/io/fs.t
new file mode 100644
index 00000000000..a219b81eef1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/fs.t
@@ -0,0 +1,85 @@
+#!./perl
+
+# $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $
+
+print "1..22\n";
+
+$wd = `pwd`;
+chop($wd);
+
+`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
+chdir './tmp';
+`/bin/rm -rf a b c x` if -x '/bin/rm';
+
+umask(022);
+
+if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
+open(fh,'>x') || die "Can't create x";
+close(fh);
+open(fh,'>a') || die "Can't create a";
+close(fh);
+
+if (eval {link('a','b')}) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (eval {link('b','c')}) {print "ok 3\n";} else {print "not ok 3\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+
+if ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
+if (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
+
+if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
+
+if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
+
+if ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
+
+if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('a');
+if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
+$foo = (utime 500000000,500000001,'b');
+if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
+if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
+    {print "ok 18\n";}
+else
+    {print "not ok 18 $atime $mtime\n";}
+
+if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
+unlink 'c';
+
+chdir $wd || die "Can't cd back to $wd";
+
+unlink 'c';
+if (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
+    if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
+    $foo = `grep perl c`;
+    if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
+}
+else {
+    print "ok 21\nok 22\n";
+}
diff --git a/gnu/usr.bin/perl/t/io/inplace.t b/gnu/usr.bin/perl/t/io/inplace.t
new file mode 100644
index 00000000000..477add19423
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/inplace.t
@@ -0,0 +1,21 @@
+#!./perl
+
+$^I = '.bak';
+
+# $RCSfile: inplace.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:29 $
+
+print "1..2\n";
+
+@ARGV = ('.a','.b','.c');
+`echo foo | tee .a .b .c`;
+while (<>) {
+    s/foo/bar/;
+}
+continue {
+    print;
+}
+
+if (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
+if (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+unlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak';
diff --git a/gnu/usr.bin/perl/t/io/pipe.t b/gnu/usr.bin/perl/t/io/pipe.t
new file mode 100644
index 00000000000..95df4dccb65
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/pipe.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
+
+$| = 1;
+print "1..8\n";
+
+open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
+print PIPE "Xk 1\n";
+print PIPE "oY 2\n";
+close PIPE;
+
+if (open(PIPE, "-|")) {
+    while(<PIPE>) {
+	s/^not //;
+	print;
+    }
+}
+else {
+    print STDOUT "not ok 3\n";
+    exec 'echo', 'not ok 4';
+}
+
+pipe(READER,WRITER) || die "Can't open pipe";
+
+if ($pid = fork) {
+    close WRITER;
+    while(<READER>) {
+	s/^not //;
+	y/A-Z/a-z/;
+	print;
+    }
+}
+else {
+    die "Couldn't fork" unless defined $pid;
+    close READER;
+    print WRITER "not ok 5\n";
+    open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
+    close WRITER;
+    exec 'echo', 'not ok 6';
+}
+
+
+pipe(READER,WRITER) || die "Can't open pipe";
+close READER;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+    print "ok 7\n";
+}
+
+print WRITER "not ok 7\n";
+close WRITER;
+
+print "ok 8\n";
diff --git a/gnu/usr.bin/perl/t/io/print.t b/gnu/usr.bin/perl/t/io/print.t
new file mode 100644
index 00000000000..180b1e88d72
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/print.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $RCSfile: print.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:32 $
+
+print "1..16\n";
+
+$foo = 'STDOUT';
+print $foo "ok 1\n";
+
+print "ok 2\n","ok 3\n","ok 4\n";
+print STDOUT "ok 5\n";
+
+open(foo,">-");
+print foo "ok 6\n";
+
+printf "ok %d\n",7;
+printf("ok %d\n",8);
+
+@a = ("ok %d%c",9,ord("\n"));
+printf @a;
+
+$a[1] = 10;
+printf STDOUT @a;
+
+$, = ' ';
+$\ = "\n";
+
+print "ok","11";
+
+@x = ("ok","12\nok","13\nok");
+@y = ("15\nok","16");
+print @x,"14\nok",@y;
diff --git a/gnu/usr.bin/perl/t/io/tell.t b/gnu/usr.bin/perl/t/io/tell.t
new file mode 100644
index 00000000000..5badafeacba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/tell.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $RCSfile: tell.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:33 $
+
+print "1..13\n";
+
+$TST = 'tst';
+
+open($TST, '../Configure') || (die "Can't open ../Configure");
+
+if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; }
+
+$firstline = <$TST>;
+$secondpos = tell;
+
+$x = 0;
+while (<tst>) {
+    if (eof) {$x++;}
+}
+if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+$lastpos = tell;
+
+unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
+
+if (seek($TST,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
+
+if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
+
+if ($firstline eq <tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
+
+if (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+if (eof($TST)) { print "not ok 9\n"; } else { print "ok 9\n"; }
+
+if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
+
+if (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
+
+if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
+
+unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
diff --git a/gnu/usr.bin/perl/t/lib/anydbm.t b/gnu/usr.bin/perl/t/lib/anydbm.t
new file mode 100644
index 00000000000..44bdeabc656
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/anydbm.t
@@ -0,0 +1,114 @@
+#!./perl
+
+# $RCSfile: anydbm.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:13 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+require AnyDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/bigint.t b/gnu/usr.bin/perl/t/lib/bigint.t
new file mode 100644
index 00000000000..034c5c64571
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/bigint.t
@@ -0,0 +1,282 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+	chop;
+	if (/^&/) {
+		$f = $_;
+	} else {
+		++$test;
+		@args = split(/:/,$_,99);
+		$ans = pop(@args);
+		$try = "$f('" . join("','", @args) . "');";
+		if (($ans1 = eval($try)) eq $ans) {
+			print "ok $test\n";
+		} else {
+			print "not ok $test\n";
+			print "# '$try' expected: '$ans' got: '$ans1'\n";
+		}
+	}
+} 
+__END__
+&bnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000  0000000   00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1
diff --git a/gnu/usr.bin/perl/t/lib/bigintpm.t b/gnu/usr.bin/perl/t/lib/bigintpm.t
new file mode 100644
index 00000000000..b229d7c67ba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/bigintpm.t
@@ -0,0 +1,310 @@
+#!./perl
+
+BEGIN { unshift @INC, './lib', '../lib';
+    require Config; import Config;
+}
+use Math::BigInt;
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+       chop;
+       if (s/^&//) {
+               $f = $_;
+       } else {
+               ++$test;
+               @args = split(/:/,$_,99);
+               $ans = pop(@args);
+               $try = "\$x = new Math::BigInt \"$args[0]\";";
+               if ($f eq "bnorm"){
+                   $try .= "\$x+0;";
+               } elsif ($f eq "bneg") {
+                   $try .= "-\$x;";
+               } elsif ($f eq "babs") {
+                   $try .= "abs \$x;";
+               } else {
+                   $try .= "\$y = new Math::BigInt \"$args[1]\";";
+                   if ($f eq bcmp){
+                       $try .= "\$x <=> \$y;";
+                   }elsif ($f eq badd){
+                       $try .= "\$x + \$y;";
+                   }elsif ($f eq bsub){
+                       $try .= "\$x - \$y;";
+                   }elsif ($f eq bmul){
+                       $try .= "\$x * \$y;";
+                   }elsif ($f eq bdiv){
+                       $try .= "\$x / \$y;";
+                   }elsif ($f eq bmod){
+                       $try .= "\$x % \$y;";
+                   }elsif ($f eq bgcd){
+                       $try .= "Math::BigInt::bgcd(\$x, \$y);";
+                   } else { warn "Unknown op"; }
+               }
+               #print ">>>",$try,"<<<\n";
+               $ans1 = eval $try;
+               if ("$ans1" eq $ans) { #bug!
+                       print "ok $test\n";
+               } else {
+                       print "not ok $test\n";
+                       print "# '$try' expected: '$ans' got: '$ans1'\n";
+               }
+       }
+} 
+__END__
+&bnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000  0000000   00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
+-1:+0:-1
++0:-1:+1
++1:+0:+1
++0:+1:-1
+-1:+1:-1
++1:-1:+1
+-1:-1:+0
++1:+1:+0
++123:+123:+0
++123:+12:+1
++12:+123:-1
+-123:-123:+0
+-123:-12:-1
+-12:-123:+1
++123:+124:-1
++124:+123:+1
+-123:-124:+1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1
diff --git a/gnu/usr.bin/perl/t/lib/db-btree.t b/gnu/usr.bin/perl/t/lib/db-btree.t
new file mode 100644
index 00000000000..d90de6cd590
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-btree.t
@@ -0,0 +1,404 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..76\n";
+
+$Dfile = "Op.db-btree";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to BTREEINFO
+
+$dbh = TIEHASH DB_File::BTREEINFO ;
+print (($dbh->{flags} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{lorder} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{minkeypage} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{maxkeypage} == undef) ? "ok 6\n" : "not ok 6\n") ;
+print (($dbh->{compare} == undef) ? "ok 7\n" : "not ok 7\n") ;
+print (($dbh->{prefix} == undef) ? "ok 8\n" : "not ok 8\n") ;
+
+$dbh->{flags} = 3000 ;
+print ($dbh->{flags} == 3000 ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{cachesize} = 9000 ;
+print ($dbh->{cachesize} == 9000 ? "ok 10\n" : "not ok 10\n") ;
+#
+$dbh->{psize} = 400 ;
+print (($dbh->{psize} == 400) ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 65 ;
+print (($dbh->{lorder} == 65) ? "ok 12\n" : "not ok 12\n") ;
+
+$dbh->{minkeypage} = 123 ;
+print (($dbh->{minkeypage} == 123) ? "ok 13\n" : "not ok 13\n") ;
+
+$dbh->{maxkeypage} = 1234 ;
+print ($dbh->{maxkeypage} == 1234 ? "ok 14\n" : "not ok 14\n") ;
+
+$dbh->{compare} = 1234 ;
+print ($dbh->{compare} == 1234 ? "ok 15\n" : "not ok 15\n") ;
+
+$dbh->{prefix} = 1234 ;
+print ($dbh->{prefix} == 1234 ? "ok 16\n" : "not ok 16\n") ;
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 17\n" : "not ok 17\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 18\n" : "not ok 18\n") ;
+
+# Now check the interface to BTREE
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 19\n" : "not ok 19");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 20\n" : "not ok 20\n");
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 21\n" : "not ok 21\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+print ($h{'abc'} == 'ABC' ? "ok 22\n" : "not ok 22\n") ;
+print (defined $h{'jimmy'} ? "not ok 23\n" : "ok 23\n");
+
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+
+#$h{'b'} = 'B';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+
+# tie to the same file again
+print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE)) ? "ok 24\n" : "not ok 24\n");
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+$X->DELETE('goner3');
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 25\n";} else {print "not ok 25\n";}
+
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 26\n";} else {print "not ok 26\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 27\n";} else {print "not ok 27\n";}
+
+#Check that the keys can be retrieved in order
+$ok = 1 ;
+foreach (keys %h)
+{
+    ($ok = 0), last if defined $previous && $previous gt $_ ;
+    $previous = $_ ;
+}
+print ($ok ? "ok 28\n" : "not ok 28\n") ;
+
+$h{'foo'} = '';
+print ($h{'foo'} eq '' ? "ok 29\n" : "not ok 29\n") ;
+
+$h{''} = 'bar';
+print ($h{''} eq 'bar' ? "ok 30\n" : "not ok 30\n") ;
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 31\n" : "not ok 31\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 32\n" : "not ok 32\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 33\n" : "not ok 33\n";
+
+# Now check all the non-tie specific stuff
+
+
+# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite
+# an existing record.
+ 
+$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+print ($status == 1 ? "ok 34\n" : "not ok 34\n") ;
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+print ($h{'x'} eq 'X' ? "ok 35\n" : "not ok 35\n") ;
+
+# standard put
+$status = $X->put('key', 'value') ;
+print ($status == 0 ? "ok 36\n" : "not ok 36\n") ;
+
+#check that previous put can be retrieved
+$status = $X->get('key', $value) ;
+print ($status == 0 ? "ok 37\n" : "not ok 37\n") ;
+print ($value eq 'value' ? "ok 38\n" : "not ok 38\n") ;
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+print ($status == 0 ? "ok 39\n" : "not ok 39\n") ;
+$status = $X->del('') ;
+print ($status == 0 ? "ok 40\n" : "not ok 40\n") ;
+
+# Make sure that the key deleted, cannot be retrieved
+print (($h{'q'} eq undef) ? "ok 41\n" : "not ok 41\n") ;
+print (($h{''} eq undef) ? "ok 42\n" : "not ok 42\n") ;
+
+undef $X ;
+untie %h ;
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE )) ? "ok 43\n" : "not ok 43");
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+print ($status == 1 ? "ok 44\n" : "not ok 44\n") ;
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+print ($status == 1 ? "ok 45\n" : "not ok 45\n") ;
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+print ($status == 0 ? "ok 46\n" : "not ok 46\n") ;
+print ($value eq 'A' ? "ok 47\n" : "not ok 47\n") ;
+
+# seq
+# ###
+
+# use seq to find an approximate match
+$key = 'ke' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 48\n" : "not ok 48\n") ;
+print ($key eq 'key' ? "ok 49\n" : "not ok 49\n") ;
+print ($value eq 'value' ? "ok 50\n" : "not ok 50\n") ;
+
+# seq when the key does not match
+$key = 'zzz' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 1 ? "ok 51\n" : "not ok 51\n") ;
+
+
+# use seq to set the cursor, then delete the record @ the cursor.
+
+$key = 'x' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 52\n" : "not ok 52\n") ;
+print ($key eq 'x' ? "ok 53\n" : "not ok 53\n") ;
+print ($value eq 'X' ? "ok 54\n" : "not ok 54\n") ;
+$status = $X->del(0, R_CURSOR) ;
+print ($status == 0 ? "ok 55\n" : "not ok 55\n") ;
+$status = $X->get('x', $value) ;
+print ($status == 1 ? "ok 56\n" : "not ok 56\n") ;
+
+# ditto, but use put to replace the key/value pair.
+$key = 'y' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 57\n" : "not ok 57\n") ;
+print ($key eq 'y' ? "ok 58\n" : "not ok 58\n") ;
+print ($value eq 'Y' ? "ok 59\n" : "not ok 59\n") ;
+
+$key = "replace key" ;
+$value = "replace value" ;
+$status = $X->put($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 60\n" : "not ok 60\n") ;
+print ($key eq 'replace key' ? "ok 61\n" : "not ok 61\n") ;
+print ($value eq 'replace value' ? "ok 62\n" : "not ok 62\n") ;
+$status = $X->get('y', $value) ;
+print ($status == 1 ? "ok 63\n" : "not ok 63\n") ;
+
+# use seq to walk forwards through a file 
+
+$status = $X->seq($key, $value, R_FIRST) ;
+print ($status == 0 ? "ok 64\n" : "not ok 64\n") ;
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_NEXT)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == 1 ;
+}
+
+print ($status == 1 ? "ok 65\n" : "not ok 65\n") ;
+print ($ok == 1 ? "ok 66\n" : "not ok 66\n") ;
+
+# use seq to walk backwards through a file 
+$status = $X->seq($key, $value, R_LAST) ;
+print ($status == 0 ? "ok 67\n" : "not ok 67\n") ;
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_PREV)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == -1 ;
+    #print "key = [$key] value = [$value]\n" ;
+}
+
+print ($status == 1 ? "ok 68\n" : "not ok 68\n") ;
+print ($ok == 1 ? "ok 69\n" : "not ok 69\n") ;
+
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+print ($status == 0 ? "ok 70\n" : "not ok 70\n") ;
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+print ($status != 0 ? "ok 71\n" : "not ok 71\n") ;
+
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+print (($Y = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 72\n" : "not ok 72");
+
+# fd with an in memory file should return failure
+$status = $Y->fd ;
+print ($status == -1 ? "ok 73\n" : "not ok 73\n") ;
+
+undef $Y ;
+untie %h ;
+
+# test multiple callbacks
+$Dfile1 = "btree1" ;
+$Dfile2 = "btree2" ;
+$Dfile3 = "btree3" ;
+ 
+$dbh1 = TIEHASH DB_File::BTREEINFO ;
+$dbh1->{compare} = sub { $_[0] <=> $_[1] } ;
+ 
+$dbh2 = TIEHASH DB_File::BTREEINFO ;
+$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
+ 
+$dbh3 = TIEHASH DB_File::BTREEINFO ;
+$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ;
+ 
+ 
+tie(%h, DB_File,$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ;
+tie(%g, DB_File,$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ;
+tie(%k, DB_File,$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ;
+ 
+@Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
+@srt_1 = sort { $a <=> $b } @Keys ;
+@srt_2 = sort { $a cmp $b } @Keys ;
+@srt_3 = sort { length $a <=> length $b } @Keys ;
+ 
+foreach (@Keys) {
+    $h{$_} = 1 ;
+    $g{$_} = 1 ;
+    $k{$_} = 1 ;
+}
+ 
+sub ArrayCompare
+{
+    my($a, $b) = @_ ;
+ 
+    return 0 if @$a != @$b ;
+ 
+    foreach (1 .. length @$a)
+    {
+        return 0 unless $$a[$_] eq $$b[$_] ;
+    }
+ 
+    1 ;
+}
+ 
+print ( ArrayCompare (\@srt_1, [keys %h]) ? "ok 74\n" : "not ok 74\n") ;
+print ( ArrayCompare (\@srt_2, [keys %g]) ? "ok 75\n" : "not ok 75\n") ;
+print ( ArrayCompare (\@srt_3, [keys %k]) ? "ok 76\n" : "not ok 76\n") ;
+
+untie %h ;
+untie %g ;
+untie %k ;
+unlink $Dfile1, $Dfile2, $Dfile3 ;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/db-hash.t b/gnu/usr.bin/perl/t/lib/db-hash.t
new file mode 100644
index 00000000000..6c3ef552001
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-hash.t
@@ -0,0 +1,253 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..43\n";
+
+$Dfile = "Op.db-hash";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to HASHINFO
+
+$dbh = TIEHASH DB_File::HASHINFO ;
+print (($dbh->{bsize} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{ffactor} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{nelem} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{hash} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{lorder} == undef) ? "ok 6\n" : "not ok 6\n") ;
+
+$dbh->{bsize} = 3000 ;
+print ($dbh->{bsize} == 3000 ? "ok 7\n" : "not ok 7\n") ;
+
+$dbh->{ffactor} = 9000 ;
+print ($dbh->{ffactor} == 9000 ? "ok 8\n" : "not ok 8\n") ;
+#
+$dbh->{nelem} = 400 ;
+print (($dbh->{nelem} == 400) ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{cachesize} = 65 ;
+print (($dbh->{cachesize} == 65) ? "ok 10\n" : "not ok 10\n") ;
+
+$dbh->{hash} = "abc" ;
+print (($dbh->{hash} eq "abc") ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 1234 ;
+print ($dbh->{lorder} == 1234 ? "ok 12\n" : "not ok 12\n") ;
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 13\n" : "not ok 13\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 14\n" : "not ok 14\n") ;
+
+# Now check the interface to HASH
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 15\n" : "not ok 15");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 16\n" : "not ok 16\n");
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 17\n" : "not ok 17\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+print ($h{'abc'} == 'ABC' ? "ok 18\n" : "not ok 18\n") ;
+print (defined $h{'jimmy'} ? "not ok 19\n" : "ok 19\n");
+
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+
+#$h{'b'} = 'B';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+
+# tie to the same file again, do not supply a type - should default to HASH
+print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640)) ? "ok 20\n" : "not ok 20: $!\n");
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+$X->DELETE('goner3');
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 21\n";} else {print "not ok 21\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 22\n";} else {print "not ok 22\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$h{'foo'} = '';
+print ($h{'foo'} eq '' ? "ok 24\n" : "not ok 24\n") ;
+
+$h{''} = 'bar';
+print ($h{''} eq 'bar' ? "ok 25\n" : "not ok 25\n") ;
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 26\n" : "not ok 26\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 27\n" : "not ok 27\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 28\n" : "not ok 28\n";
+
+
+# Now check all the non-tie specific stuff
+
+# Check NOOVERWRITE will make put fail when attempting to overwrite
+# an existing record.
+ 
+$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+print ($status == 1 ? "ok 29\n" : "not ok 29\n") ;
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+print ($h{'x'} eq 'X' ? "ok 30\n" : "not ok 30\n") ;
+
+# standard put
+$status = $X->put('key', 'value') ;
+print ($status == 0 ? "ok 31\n" : "not ok 31\n") ;
+
+#check that previous put can be retrieved
+$status = $X->get('key', $value) ;
+print ($status == 0 ? "ok 32\n" : "not ok 32\n") ;
+print ($value eq 'value' ? "ok 33\n" : "not ok 33\n") ;
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+print ($status == 0 ? "ok 34\n" : "not ok 34\n") ;
+
+# Make sure that the key deleted, cannot be retrieved
+print (($h{'q'} eq undef) ? "ok 35\n" : "not ok 35\n") ;
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+print ($status == 1 ? "ok 36\n" : "not ok 36\n") ;
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+print ($status == 1 ? "ok 37\n" : "not ok 37\n") ;
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+print ($status == 0 ? "ok 38\n" : "not ok 38\n") ;
+print ($value eq 'A' ? "ok 39\n" : "not ok 39\n") ;
+
+# seq
+# ###
+
+# ditto, but use put to replace the key/value pair.
+
+# use seq to walk backwards through a file - check that this reversed is
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+print ($status == 0 ? "ok 40\n" : "not ok 40\n") ;
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+print ($status != 0 ? "ok 41\n" : "not ok 41\n") ;
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+print (($X = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 42\n" : "not ok 42");
+
+# fd with an in memory file should return fail
+$status = $X->fd ;
+print ($status == -1 ? "ok 43\n" : "not ok 43\n") ;
+
+untie %h ;
+undef $X ;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/db-recno.t b/gnu/usr.bin/perl/t/lib/db-recno.t
new file mode 100644
index 00000000000..64ad7b8a9ef
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-recno.t
@@ -0,0 +1,142 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..30\n";
+
+$Dfile = "Op.db-recno";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to RECNOINFO
+
+$dbh = TIEHASH DB_File::RECNOINFO ;
+print (($dbh->{bval} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{flags} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{lorder} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{reclen} == undef) ? "ok 6\n" : "not ok 6\n") ;
+print (($dbh->{bfname} == undef) ? "ok 7\n" : "not ok 7\n") ;
+
+$dbh->{bval} = 3000 ;
+print ($dbh->{bval} == 3000 ? "ok 8\n" : "not ok 8\n") ;
+
+$dbh->{cachesize} = 9000 ;
+print ($dbh->{cachesize} == 9000 ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{psize} = 400 ;
+print (($dbh->{psize} == 400) ? "ok 10\n" : "not ok 10\n") ;
+
+$dbh->{flags} = 65 ;
+print (($dbh->{flags} == 65) ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 123 ;
+print (($dbh->{lorder} == 123) ? "ok 12\n" : "not ok 12\n") ;
+
+$dbh->{reclen} = 1234 ;
+print ($dbh->{reclen} == 1234 ? "ok 13\n" : "not ok 13\n") ;
+
+$dbh->{bfname} = 1234 ;
+print ($dbh->{bfname} == 1234 ? "ok 14\n" : "not ok 14\n") ;
+
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 15\n" : "not ok 15\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 16\n" : "not ok 16\n") ;
+
+# Now check the interface to RECNOINFO
+
+print (($X = tie(@h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO )) ? "ok 17\n" : "not ok 17");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 18\n" : "not ok 18\n");
+
+#$l = @h ;
+$l = $X->length ;
+print (!$l ? "ok 19\n" : "not ok 19\n");
+
+@data = qw( a b c d ever f g h  i j k longername m n o p) ;
+
+$h[0] = shift @data ;
+print ($h[0] eq 'a' ? "ok 20\n" : "not ok 20\n") ;
+
+foreach (@data)
+  { $h[++$i] = $_ }
+
+unshift (@data, 'a') ;
+
+print (defined $h[1] ? "ok 21\n" : "not ok 21\n");
+print (! defined $h[16] ? "ok 22\n" : "not ok 22\n");
+print ($X->length == @data ? "ok 23\n" : "not ok 23\n") ;
+
+
+# Overwrite an entry & check fetch it
+$h[3] = 'replaced' ;
+$data[3] = 'replaced' ;
+print ($h[3] eq 'replaced' ? "ok 24\n" : "not ok 24\n");
+
+#PUSH
+@push_data = qw(added to the end) ;
+#push (@h, @push_data) ;
+$X->push(@push_data) ;
+push (@data, @push_data) ;
+print ($h[++$i] eq 'added' ? "ok 25\n" : "not ok 25\n");
+
+# POP
+pop (@data) ;
+#$value = pop(@h) ;
+$value = $X->pop ;
+print ($value eq 'end' ? "not ok 26\n" : "ok 26\n");
+
+# SHIFT
+#$value = shift @h
+$value = $X->shift ;
+print ($value eq shift @data ? "not ok 27\n" : "ok 27\n");
+
+# UNSHIFT
+
+# empty list
+$X->unshift ;
+print ($X->length == @data ? "ok 28\n" : "not ok 28\n") ;
+
+@new_data = qw(add this to the start of the array) ;
+#unshift @h, @new_data ;
+$X->unshift (@new_data) ;
+unshift (@data, @new_data) ;
+print ($X->length == @data ? "ok 29\n" : "not ok 29\n") ;
+
+# SPLICE
+
+# Now both arrays should be identical
+
+$ok = 1 ;
+$j = 0 ;
+foreach (@data)
+{
+   $ok = 0, last if $_ ne $h[$j ++] ; 
+}
+print ($ok ? "ok 30\n" : "not ok 30\n") ;
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(@h);
+
+unlink $Dfile;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/dirhand.t b/gnu/usr.bin/perl/t/lib/dirhand.t
new file mode 100644
index 00000000000..8403609578e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dirhand.t
@@ -0,0 +1,33 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bPOSIX\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DirHandle;
+
+print "1..5\n";
+
+$dot = new DirHandle ".";
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = <*>;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+
+@b = sort($first, (grep {/^[^.]/} $dot->read));
+print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+
+$dot->rewind;
+@c = sort grep {/^[^.]/} $dot->read;
+print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+
+$dot->close;
+$dot->rewind;
+print defined($dot->read) ? "not ok" : "ok", " 5\n";
diff --git a/gnu/usr.bin/perl/t/lib/english.t b/gnu/usr.bin/perl/t/lib/english.t
new file mode 100644
index 00000000000..d7a30f9305c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/english.t
@@ -0,0 +1,41 @@
+#!./perl
+
+print "1..16\n";
+
+BEGIN { @INC = '../lib' }
+use English;
+
+print $PID == $$ ? "ok 1\n" : "not ok 1\n";
+
+$_ = 1;
+print $ARG == $_ ? "ok 2\n" : "not ok 2\n";
+
+sub foo {
+    print $ARG[0] == $_[0] ? "ok 3\n" : "not ok 3\n";
+}
+&foo(1);
+
+$ARG = "ok 4\nok 5\nok 6\n";
+/ok 5\n/;
+print $PREMATCH, $MATCH, $POSTMATCH;
+
+$OFS = " ";
+$ORS = "\n";
+print 'ok',7;
+undef $OUTPUT_FIELD_SEPARATOR;
+
+$LIST_SEPARATOR = "\n";
+@foo = ("ok 8", "ok 9");
+print "@foo";
+undef $OUTPUT_RECORD_SEPARATOR;
+
+eval 'NO SUCH FUNCTION';
+print "ok 10\n" if $EVAL_ERROR =~ /method/;
+
+print $UID == $< ? "ok 11\n" : "not ok 11\n";
+print $GID == $( ? "ok 12\n" : "not ok 12\n";
+print $EUID == $> ? "ok 13\n" : "not ok 13\n";
+print $EGID == $) ? "ok 14\n" : "not ok 14\n";
+
+print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
diff --git a/gnu/usr.bin/perl/t/lib/filehand.t b/gnu/usr.bin/perl/t/lib/filehand.t
new file mode 100644
index 00000000000..fc433502126
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/filehand.t
@@ -0,0 +1,35 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFileHandle\b/ && $^O ne 'VMS') {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use FileHandle;
+use strict subs;
+
+$mystdout = new_from_fd FileHandle 1,"w";
+autoflush STDOUT;
+autoflush $mystdout;
+print "1..4\n";
+
+print $mystdout "ok ",fileno($mystdout),"\n";
+
+$fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n";
+$buffer = <$fh>;
+print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
+
+if ($^O eq 'VMS') {
+    ungetc $fh 65;
+    CORE::read($fh, $buf,1);
+}
+else {
+    ungetc STDIN 65;
+    CORE::read(STDIN, $buf,1);
+}
+print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
diff --git a/gnu/usr.bin/perl/t/lib/gdbm.t b/gnu/usr.bin/perl/t/lib/gdbm.t
new file mode 100644
index 00000000000..e79df424657
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gdbm.t
@@ -0,0 +1,117 @@
+#!./perl
+
+# $RCSfile: gdbm.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use GDBM_File;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/ndbm.t b/gnu/usr.bin/perl/t/lib/ndbm.t
new file mode 100644
index 00000000000..77f331ca441
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ndbm.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $RCSfile: ndbm.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bNDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+require NDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,NDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,NDBM_File,'Op.dbmx', &O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/odbm.t b/gnu/usr.bin/perl/t/lib/odbm.t
new file mode 100644
index 00000000000..1c5b4ac4612
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/odbm.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $RCSfile: odbm.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bODBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+require ODBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,ODBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,ODBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/posix.t b/gnu/usr.bin/perl/t/lib/posix.t
new file mode 100644
index 00000000000..23007ff0595
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/posix.t
@@ -0,0 +1,66 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write);
+use strict subs;
+
+$| = 1;
+print "1..14\n";
+
+$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
+read($testfd, $buffer, 9) if $testfd > 2;
+print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
+
+write(1,"ok 3\nnot ok 3\n", 5);
+
+@fds = POSIX::pipe();
+print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n";
+CORE::open($reader = \*READER, "<&=".$fds[0]);
+CORE::open($writer = \*WRITER, ">&=".$fds[1]);
+print $writer "ok 5\n";
+close $writer;
+print <$reader>;
+close $reader;
+
+$sigset = new POSIX::SigSet 1,3;
+delset $sigset 1;
+if (!ismember $sigset 1) { print "ok 6\n" }
+if (ismember $sigset 3) { print "ok 7\n" }
+$mask = new POSIX::SigSet &SIGINT;
+$action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
+sigaction(&SIGHUP, $action);
+$SIG{'INT'} = 'SigINT';
+kill 'HUP', $$;
+sleep 1;
+print "ok 11\n";
+
+sub SigHUP {
+    print "ok 8\n";
+    kill 'INT', $$;
+    sleep 2;
+    print "ok 9\n";
+}
+
+sub SigINT {
+    print "ok 10\n";
+}
+
+print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
+
+print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n";
+
+# Pick up whether we're really able to dynamically load everything.
+print &POSIX::acos(1.0) == 0.0 ? "ok 14\n" : "not ok 14\n";
+
+$| = 0;
+print '@#!*$@(!@#$';
+_exit(0);
diff --git a/gnu/usr.bin/perl/t/lib/safe.t b/gnu/usr.bin/perl/t/lib/safe.t
new file mode 100644
index 00000000000..e59c81406b1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/safe.t
@@ -0,0 +1,96 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSafe\b/ && $^O ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+use Safe qw(opname opcode ops_to_mask mask_to_ops);
+
+print "1..23\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+$bar .= "";
+
+$bar = "invisible";
+$cpt = new Safe "Root";
+$cpt->reval(q{
+    system("echo not ok 1");
+});
+if ($@ =~ /^system trapped by operation mask/) {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}
+
+$cpt->reval(q{
+    print $foo eq 'visible' ? "ok 2\n" : "not ok 2\n";
+    print $main::foo  eq 'visible' ? "ok 3\n" : "not ok 3\n";
+    print defined($bar) ? "not ok 4\n" : "ok 4\n";
+    print defined($::bar) ? "not ok 5\n" : "ok 5\n";
+    print defined($main::bar) ? "not ok 6\n" : "ok 6\n";
+});
+print $@ ? "not ok 7\n" : "ok 7\n";
+
+$foo = "ok 8\n";
+%bar = (key => "ok 9\n");
+@baz = "o";
+push(@baz, "10"); # Two steps to prevent "Identifier used only once..."
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+$" = 'k ';
+
+sub sayok12 { print "ok 12\n" }
+
+$cpt->share(qw($foo %bar @baz *glob &sayok12 $"));
+
+$cpt->reval(q{
+    print $foo ? $foo : "not ok 8\n";
+    print $bar{key} ? $bar{key} : "not ok 9\n";
+    if (@baz) {
+	print "@baz\n";
+    } else {
+	print "not ok 10\n";
+    }
+    print $glob;
+    sayok12();
+    $foo =~ s/8/14/;
+    $bar{new} = "ok 15\n";
+    @glob = qw(ok 16);
+});
+print $@ ? "not ok 13\n#$@" : "ok 13\n";
+$" = ' ';
+print $foo, $bar{new}, "@glob\n";
+
+$Root::foo = "not ok 17";
+@{$cpt->varglob('bar')} = qw(not ok 18);
+${$cpt->varglob('foo')} = "ok 17";
+@Root::bar = "ok";
+push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+print "$Root::foo\n";
+print "@{$cpt->varglob('bar')}\n";
+
+print opname(23) eq "bless" ? "ok 19\n" : "not ok 19\n";
+print opcode("bless") == 23 ? "ok 20\n" : "not ok 20\n";
+
+$m1 = $cpt->mask();
+$cpt->trap("negate");
+$m2 = $cpt->mask();
+@masked = mask_to_ops($m1);
+print $m2 eq ops_to_mask("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+$cpt->untrap(187);
+substr($m2, 187, 1) = "\0";
+print $m2 eq $cpt->mask() ? "ok 22\n" : "not ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
diff --git a/gnu/usr.bin/perl/t/lib/sdbm.t b/gnu/usr.bin/perl/t/lib/sdbm.t
new file mode 100644
index 00000000000..3a56f5ccbf5
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/sdbm.t
@@ -0,0 +1,119 @@
+#!./perl
+
+# $RCSfile: sdbm.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+require SDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/socket.t b/gnu/usr.bin/perl/t/lib/socket.t
new file mode 100644
index 00000000000..afc2a5bb751
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/socket.t
@@ -0,0 +1,68 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSocket\b/ && 
+        !(($^O eq 'VMS') && $Config{d_has_socket})) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+	
+use Socket;
+
+print "1..6\n";
+
+if (socket(T,PF_INET,SOCK_STREAM,6)) {
+  print "ok 1\n";
+
+  if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){
+	print "ok 2\n";
+
+	print "# Connected to ",
+		inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1]),"\n";
+
+	syswrite(T,"hello",5);
+	$read = sysread(T,$buff,10);	# Connection may be granted, then closed!
+	print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n");
+  }
+  else {
+	print "# You're allowed to fail tests 2 and 3 if.\n";
+	print "# The echo service has been disabled.\n";
+	print "# $!\n";
+	print "ok 2\n";
+	print "ok 3\n";
+  }
+}
+else {
+	print "# $!\n";
+	print "not ok 1\n";
+}
+
+if( socket(S,PF_INET,SOCK_STREAM,6) ){
+  print "ok 4\n";
+
+  if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){
+	print "ok 5\n";
+
+	print "# Connected to ",
+		inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1]),"\n";
+
+	syswrite(S,"olleh",5);
+	$read = sysread(S,$buff,10);	# Connection may be granted, then closed!
+	print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n");
+  }
+  else {
+	print "# You're allowed to fail tests 5 and 6 if.\n";
+	print "# The echo service has been disabled.\n";
+	print "# $!\n";
+	print "ok 5\n";
+	print "ok 6\n";
+  }
+}
+else {
+	print "# $!\n";
+	print "not ok 4\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/soundex.t b/gnu/usr.bin/perl/t/lib/soundex.t
new file mode 100644
index 00000000000..6a3fbbf0547
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/soundex.t
@@ -0,0 +1,147 @@
+#!./perl
+#
+# $Id: soundex.t,v 1.1.1.1 1996/08/19 10:13:15 downsj Exp $
+#
+# test module for soundex.pl
+#
+# $Log: soundex.t,v $
+# Revision 1.1.1.1  1996/08/19 10:13:15  downsj
+# Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+# config.sh.OpenBSD are the only local changes.
+#
+# Revision 1.2  1994/03/24  00:30:27  mike
+# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
+# in the way I handles leasing characters which were different but had
+# the same soundex code.  This showed up comparing it with Oracle's
+# soundex output.
+#
+# Revision 1.1  1994/03/02  13:03:02  mike
+# Initial revision
+#
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Soundex;
+
+$test = 0;
+print "1..13\n";
+
+while (<DATA>)
+{
+  chop;
+  next if /^\s*;?#/;
+  next if /^\s*$/;
+
+  ++$test;
+  $bad = 0;
+
+  if (/^eval\s+/)
+  {
+    ($try = $_) =~ s/^eval\s+//;
+
+    eval ($try);
+    if ($@)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# eval '$try' returned $@";
+    }
+  }
+  elsif (/^\(/)
+  {
+    ($in, $out) = split (':');
+
+    $try = "\@expect = $out; \@got = &soundex $in;";
+    eval ($try);
+
+    if (@expect != @got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
+      print "# expected (", join (', ', @expect),
+	    ") got (", join (', ', @got), ")\n";
+    }
+    else
+    {
+      while (@got)
+      {
+	$expect = shift @expect;
+	$got = shift @got;
+
+	if ($expect ne $got)
+	{
+	  $bad++;
+	  print "not ok $test\n";
+	  print "# expected $expect, got $got\n";
+	}
+      }
+    }
+  }
+  else
+  {
+    ($in, $out) = split (':');
+
+    $try = "\$expect = $out; \$got = &soundex ($in);";
+    eval ($try);
+
+    if ($expect ne $got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected $expect, got $got\n";
+    }
+  }
+
+  print "ok $test\n" unless $bad;
+}
+
+__END__
+#
+# 1..6
+#
+# Knuth's test cases, scalar in, scalar out
+#
+'Euler':'E460'
+'Gauss':'G200'
+'Hilbert':'H416'
+'Knuth':'K530'
+'Lloyd':'L300'
+'Lukasiewicz':'L222'
+#
+# 7..8
+#
+# check default bad code
+#
+'2 + 2 = 4':undef
+undef:undef
+#
+# 9
+#
+# check array in, array out
+#
+('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
+#
+# 10
+#
+# check array with explicit undef
+#
+('Mike', undef, 'Stok'):('M200', undef, 'S320')
+#
+# 11..12
+#
+# check setting $Text::Soundex::noCode
+#
+eval $soundex_nocode = 'Z000';
+('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
+#
+# 13
+#
+# a subtle difference between me & oracle, spotted by Rich Pinder
+# <rpinder@hsc.usc.edu>
+#
+CZARKOWSKA:C622
diff --git a/gnu/usr.bin/perl/t/op/append.t b/gnu/usr.bin/perl/t/op/append.t
new file mode 100644
index 00000000000..d11514615ac
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/append.t
@@ -0,0 +1,21 @@
+#!./perl
+
+# $RCSfile: append.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:36 $
+
+print "1..3\n";
+
+$a = 'ab' . 'c';	# compile time
+$b = 'def';
+
+$c = $a . $b;
+print "#1\t:$c: eq :abcdef:\n";
+if ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$c .= 'xyz';
+print "#2\t:$c: eq :abcdefxyz:\n";
+if ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = $a;
+$_ .= $b;
+print "#3\t:$_: eq :abcdef:\n";
+if ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/t/op/array.t b/gnu/usr.bin/perl/t/op/array.t
new file mode 100644
index 00000000000..ed471b4c4d7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/array.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $
+
+print "1..36\n";
+
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 2\n";} else {print "not ok 2\n";}
+if ($#ary == 3) {print "ok 3\n";} else {print "not ok 3\n";}
+if (join('',@ary) eq '1234') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$[ = 1;
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 5\n";} else {print "not ok 5\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 6\n";} else {print "not ok 6\n";}
+if ($#ary == 4) {print "ok 7\n";} else {print "not ok 7\n";}
+if (join('',@ary) eq '1234') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if ($ary[5] eq '') {print "ok 9\n";} else {print "not ok 9\n";}
+
+$#ary += 1;	# see if element 5 gone for good
+if ($#ary == 5) {print "ok 10\n";} else {print "not ok 10\n";}
+if (defined $ary[5]) {print "not ok 11\n";} else {print "ok 11\n";}
+
+$[ = 0;
+@foo = ();
+$r = join(',', $#foo, @foo);
+if ($r eq "-1") {print "ok 12\n";} else {print "not ok 12 $r\n";}
+$foo[0] = '0';
+$r = join(',', $#foo, @foo);
+if ($r eq "0,0") {print "ok 13\n";} else {print "not ok 13 $r\n";}
+$foo[2] = '2';
+$r = join(',', $#foo, @foo);
+if ($r eq "2,0,,2") {print "ok 14\n";} else {print "not ok 14 $r\n";}
+@bar = ();
+$bar[0] = '0';
+$bar[1] = '1';
+$r = join(',', $#bar, @bar);
+if ($r eq "1,0,1") {print "ok 15\n";} else {print "not ok 15 $r\n";}
+@bar = ();
+$r = join(',', $#bar, @bar);
+if ($r eq "-1") {print "ok 16\n";} else {print "not ok 16 $r\n";}
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 17\n";} else {print "not ok 17 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 18\n";} else {print "not ok 18 $r\n";}
+reset 'b';
+@bar = ();
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 19\n";} else {print "not ok 19 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 20\n";} else {print "not ok 20 $r\n";}
+
+$foo = 'now is the time';
+if (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)) {
+    if ($F1 eq 'now' && $F2 eq 'is' && $Etc eq 'the time') {
+	print "ok 21\n";
+    }
+    else {
+	print "not ok 21\n";
+    }
+}
+else {
+    print "not ok 21\n";
+}
+
+$foo = 'lskjdf';
+if ($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))) {
+    print "not ok 22 $cnt $F1:$F2:$Etc\n";
+}
+else {
+    print "ok 22\n";
+}
+
+%foo = ('blurfl','dyick','foo','bar','etc.','etc.');
+%bar = %foo;
+print $bar{'foo'} eq 'bar' ? "ok 23\n" : "not ok 23\n";
+%bar = ();
+print $bar{'foo'} eq '' ? "ok 24\n" : "not ok 24\n";
+(%bar,$a,$b) = (%foo,'how','now');
+print $bar{'foo'} eq 'bar' ? "ok 25\n" : "not ok 25\n";
+print $bar{'how'} eq 'now' ? "ok 26\n" : "not ok 26\n";
+@bar{keys %foo} = values %foo;
+print $bar{'foo'} eq 'bar' ? "ok 27\n" : "not ok 27\n";
+print $bar{'how'} eq 'now' ? "ok 28\n" : "not ok 28\n";
+
+@foo = grep(/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'the time men come' ? "ok 29\n" : "not ok 29\n";
+
+@foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'now is for all good to to' ? "ok 30\n" : "not ok 30\n";
+
+$foo = join('',('a','b','c','d','e','f')[0..5]);
+print $foo eq 'abcdef' ? "ok 31\n" : "not ok 31\n";
+
+$foo = join('',('a','b','c','d','e','f')[0..1]);
+print $foo eq 'ab' ? "ok 32\n" : "not ok 32\n";
+
+$foo = join('',('a','b','c','d','e','f')[6]);
+print $foo eq '' ? "ok 33\n" : "not ok 33\n";
+
+@foo = ('a','b','c','d','e','f')[0,2,4];
+@bar = ('a','b','c','d','e','f')[1,3,5];
+$foo = join('',(@foo,@bar)[0..5]);
+print $foo eq 'acebdf' ? "ok 34\n" : "not ok 34\n";
+
+$foo = ('a','b','c','d','e','f')[0,2,4];
+print $foo eq 'e' ? "ok 35\n" : "not ok 35\n";
+
+$foo = ('a','b','c','d','e','f')[1];
+print $foo eq 'b' ? "ok 36\n" : "not ok 36\n";
diff --git a/gnu/usr.bin/perl/t/op/auto.t b/gnu/usr.bin/perl/t/op/auto.t
new file mode 100644
index 00000000000..93a42f8472b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/auto.t
@@ -0,0 +1,48 @@
+#!./perl
+
+# $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
+
+print "1..34\n";
+
+$x = 10000;
+if (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
+if (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
+if (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
+if (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
+if (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
+if (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
+if (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
+if (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
+if (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
+if ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
+
+$x[0] = 10000;
+if (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
+if (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
+if (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
+if (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
+if (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
+if (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
+if (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
+if (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
+if (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
+if ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
+
+$x{0} = 10000;
+if (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
+if (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
+if (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
+if (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
+if (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
+if (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
+if (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
+if (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
+if (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
+if ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
+
+# test magical autoincrement
+
+if (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
+if (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
+if (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
+if (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
diff --git a/gnu/usr.bin/perl/t/op/chop.t b/gnu/usr.bin/perl/t/op/chop.t
new file mode 100644
index 00000000000..3516c2d18cc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/chop.t
@@ -0,0 +1,72 @@
+#!./perl
+
+# $RCSfile: chop.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:40 $
+
+print "1..22\n";
+
+# optimized
+
+$_ = 'abc';
+$c = do foo();
+if ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1 $c$_\n";}
+
+# unoptimized
+
+$_ = 'abc';
+$c = chop($_);
+if ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
+
+sub foo {
+    chop;
+}
+
+@foo = ("hi \n","there\n","!\n");
+@bar = @foo;
+chop(@bar);
+print join('',@bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n";
+
+$foo = "\n";
+chop($foo,@foo);
+print join('',$foo,@foo) eq 'hi there!' ? "ok 4\n" : "not ok 4\n";
+
+$_ = "foo\n\n";
+print chomp() == 1 ? "ok 5\n" : "not ok 5\n";
+print $_ eq "foo\n" ? "ok 6\n" : "not ok 6\n";
+
+$_ = "foo\n";
+print chomp() == 1 ? "ok 7\n" : "not ok 7\n";
+print $_ eq "foo" ? "ok 8\n" : "not ok 8\n";
+
+$_ = "foo";
+print chomp() == 0 ? "ok 9\n" : "not ok 9\n";
+print $_ eq "foo" ? "ok 10\n" : "not ok 10\n";
+
+$_ = "foo";
+$/ = "oo";
+print chomp() == 2 ? "ok 11\n" : "not ok 11\n";
+print $_ eq "f" ? "ok 12\n" : "not ok 12\n";
+
+$_ = "bar";
+$/ = "oo";
+print chomp() == 0 ? "ok 13\n" : "not ok 13\n";
+print $_ eq "bar" ? "ok 14\n" : "not ok 14\n";
+
+$_ = "f\n\n\n\n\n";
+$/ = "";
+print chomp() == 5 ? "ok 15\n" : "not ok 15\n";
+print $_ eq "f" ? "ok 16\n" : "not ok 16\n";
+
+$_ = "f\n\n";
+$/ = "";
+print chomp() == 2 ? "ok 17\n" : "not ok 17\n";
+print $_ eq "f" ? "ok 18\n" : "not ok 18\n";
+
+$_ = "f\n";
+$/ = "";
+print chomp() == 1 ? "ok 19\n" : "not ok 19\n";
+print $_ eq "f" ? "ok 20\n" : "not ok 20\n";
+
+$_ = "f";
+$/ = "";
+print chomp() == 0 ? "ok 21\n" : "not ok 21\n";
+print $_ eq "f" ? "ok 22\n" : "not ok 22\n";
diff --git a/gnu/usr.bin/perl/t/op/cond.t b/gnu/usr.bin/perl/t/op/cond.t
new file mode 100644
index 00000000000..427efb48879
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/cond.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:41 $
+
+print "1..4\n";
+
+print 1 ? "ok 1\n" : "not ok 1\n";	# compile time
+print 0 ? "not ok 2\n" : "ok 2\n";
+
+$x = 1;
+print $x ? "ok 3\n" : "not ok 3\n";	# run time
+print !$x ? "not ok 4\n" : "ok 4\n";
diff --git a/gnu/usr.bin/perl/t/op/delete.t b/gnu/usr.bin/perl/t/op/delete.t
new file mode 100644
index 00000000000..010cbf10035
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/delete.t
@@ -0,0 +1,37 @@
+#!./perl
+
+# $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $
+
+print "1..7\n";
+
+$foo{1} = 'a';
+$foo{2} = 'b';
+$foo{3} = 'c';
+
+$foo = delete $foo{2};
+
+if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
+if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
+if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$foo = join('',values(foo));
+if ($foo eq 'ac' || $foo eq 'ca') {print "ok 5\n";} else {print "not ok 5\n";}
+
+foreach $key (keys foo) {
+    delete $foo{$key};
+}
+
+$foo{'foo'} = 'x';
+$foo{'bar'} = 'y';
+
+$foo = join('',values(foo));
+if ($foo eq 'xy' || $foo eq 'yx') {print "ok 6\n";} else {print "not ok 6\n";}
+
+$refhash{"top"}->{"foo"} = "FOO";
+$refhash{"top"}->{"bar"} = "BAR";
+
+delete $refhash{"top"}->{"bar"};
+@list = keys %{$refhash{"top"}};
+
+print "@list" eq "foo" ? "ok 7\n" : "not ok 7 @list\n";
diff --git a/gnu/usr.bin/perl/t/op/do.t b/gnu/usr.bin/perl/t/op/do.t
new file mode 100644
index 00000000000..db4623720e0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/do.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $RCSfile: do.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:45 $
+
+sub foo1
+{
+    print $_[0];
+    'value';
+}
+
+sub foo2
+{
+    shift(_);
+    print $_[0];
+    $x = 'value';
+    $x;
+}
+
+print "1..15\n";
+
+$_[0] = "not ok 1\n";
+$result = do foo1("ok 1\n");
+print "#2\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; }
+if ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; }
+
+$_[0] = "not ok 4\n";
+$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n");
+print "#5\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; }
+if ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+$result = do{print "ok 7\n"; 'value';};
+print "#8\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+sub blather {
+    print @_;
+}
+
+do blather("ok 9\n","ok 10\n");
+@x = ("ok 11\n", "ok 12\n");
+@y = ("ok 14\n", "ok 15\n");
+do blather(@x,"ok 13\n",@y);
diff --git a/gnu/usr.bin/perl/t/op/each.t b/gnu/usr.bin/perl/t/op/each.t
new file mode 100644
index 00000000000..7a58fc8dcc1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/each.t
@@ -0,0 +1,53 @@
+#!./perl
+
+# $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
+
+print "1..3\n";
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+@keys = keys %h;
+@values = values %h;
+
+if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/t/op/eval.t b/gnu/usr.bin/perl/t/op/eval.t
new file mode 100644
index 00000000000..6d0a67b5331
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/eval.t
@@ -0,0 +1,57 @@
+#!./perl
+
+# $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
+
+print "1..16\n";
+
+eval 'print "ok 1\n";';
+
+if ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";}
+
+eval "\$foo\n    = # this is a comment\n'ok 3';";
+print $foo,"\n";
+
+eval "\$foo\n    = # this is a comment\n'ok 4\n';";
+print $foo;
+
+print eval '
+$foo =;';		# this tests for a call through yyerror()
+if ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
+
+print eval '$foo = /';	# this tests for a call through fatal()
+if ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
+
+print eval '"ok 7\n";';
+
+# calculate a factorial with recursive evals
+
+$foo = 5;
+$fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
+$ans = eval $fact;
+if ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
+
+$foo = 5;
+$fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
+$ans = eval $fact;
+if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
+
+open(try,'>Op.eval');
+print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
+close try;
+
+do 'Op.eval'; print $@;
+
+# Test the singlequoted eval optimizer
+
+$i = 11;
+for (1..3) {
+    eval 'print "ok ", $i++, "\n"';
+}
+
+eval {
+    print "ok 14\n";
+    die "ok 16\n";
+    1;
+} || print "ok 15\n$@";
+
+
diff --git a/gnu/usr.bin/perl/t/op/exec.t b/gnu/usr.bin/perl/t/op/exec.t
new file mode 100644
index 00000000000..1103a1a4649
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/exec.t
@@ -0,0 +1,21 @@
+#!./perl
+
+# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $
+
+$| = 1;				# flush stdout
+print "1..8\n";
+
+print "not ok 1\n" if system "echo ok \\1";	# shell interpreted
+print "not ok 2\n" if system "echo ok 2";	# split and directly called
+print "not ok 3\n" if system "echo", "ok", "3"; # directly called
+
+if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
+
+if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
+print "ok 5\n";
+
+if ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";}
+
+unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
+
+exec "echo","ok","8";
diff --git a/gnu/usr.bin/perl/t/op/exp.t b/gnu/usr.bin/perl/t/op/exp.t
new file mode 100644
index 00000000000..5efc9ba950f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/exp.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# $RCSfile: exp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:50 $
+
+print "1..6\n";
+
+# compile time evaluation
+
+$s = sqrt(2);
+if (substr($s,0,5) eq '1.414') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$s = exp(1);
+if (substr($s,0,7) eq '2.71828') {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (exp(log(1)) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
+
+# run time evaluation
+
+$x1 = 1;
+$x2 = 2;
+$s = sqrt($x2);
+if (substr($s,0,5) eq '1.414') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$s = exp($x1);
+if (substr($s,0,7) eq '2.71828') {print "ok 5\n";} else {print "not ok 5\n";}
+
+if (exp(log($x1)) == 1) {print "ok 6\n";} else {print "not ok 6\n";}
diff --git a/gnu/usr.bin/perl/t/op/flip.t b/gnu/usr.bin/perl/t/op/flip.t
new file mode 100644
index 00000000000..475f55a8c87
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/flip.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $RCSfile: flip.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:52 $
+
+print "1..8\n";
+
+@a = (1,2,3,4,5,6,7,8,9,10,11,12);
+
+while ($_ = shift(a)) {
+    if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
+    $y .= /1/../2/;
+}
+
+if ($z eq '5E0') {print "ok 6\n";} else {print "not ok 6\n";}
+
+if ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";}
+
+@a = ('a','b','c','d','e','f','g');
+
+open(of,'../Configure');
+while (<of>) {
+    (3 .. 5) && ($foo .= $_);
+}
+$x = ($foo =~ y/\n/\n/);
+
+if ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";}
diff --git a/gnu/usr.bin/perl/t/op/fork.t b/gnu/usr.bin/perl/t/op/fork.t
new file mode 100644
index 00000000000..598310b63f5
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/fork.t
@@ -0,0 +1,16 @@
+#!./perl
+
+# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $
+
+$| = 1;
+print "1..2\n";
+
+if ($cid = fork) {
+    sleep 2;
+    if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";}
+}
+else {
+    $| = 1;
+    print "ok 1\n";
+    sleep 10;
+}
diff --git a/gnu/usr.bin/perl/t/op/glob.t b/gnu/usr.bin/perl/t/op/glob.t
new file mode 100644
index 00000000000..b4038442bdc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/glob.t
@@ -0,0 +1,22 @@
+#!./perl
+
+# $RCSfile: glob.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:55 $
+
+print "1..4\n";
+
+@ops = <op/*>;
+$list = join(' ',@ops);
+
+chop($otherway = `echo op/*`);
+
+print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n";
+
+print $/ eq "\n" ? "ok 2\n" : "not ok 2\n";
+
+while (<jskdfjskdfj* op/* jskdjfjkosvk*>) {
+    $not = "not " unless $_ eq shift @ops;
+    $not = "not at all " if $/ eq "\0";
+}
+print "${not}ok 3\n";
+
+print $/ eq "\n" ? "ok 4\n" : "not ok 4\n";
diff --git a/gnu/usr.bin/perl/t/op/goto.t b/gnu/usr.bin/perl/t/op/goto.t
new file mode 100644
index 00000000000..087331907e3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/goto.t
@@ -0,0 +1,89 @@
+#!./perl
+
+# $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
+
+# "This IS structured code.  It's just randomly structured."
+
+print "1..9\n";
+
+while ($?) {
+    $foo = 1;
+  label1:
+    $foo = 2;
+    goto label2;
+} continue {
+    $foo = 0;
+    goto label4;
+  label3:
+    $foo = 4;
+    goto label4;
+}
+goto label1;
+
+$foo = 3;
+
+label2:
+print "#1\t:$foo: == 2\n";
+if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
+goto label3;
+
+label4:
+print "#2\t:$foo: == 4\n";
+if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = `./perl -e 'goto foo;' 2>&1`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
+
+if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
+
+sub foo {
+    goto bar;
+    print "not ok 4\n";
+    return;
+bar:
+    print "ok 4\n";
+}
+
+&foo;
+
+sub bar {
+    $x = 'bypass';
+    eval "goto $x";
+}
+
+&bar;
+exit;
+
+FINALE:
+print "ok 9\n";
+exit;
+
+bypass:
+print "ok 5\n";
+
+# Test autoloading mechanism.
+
+sub two {
+    ($pack, $file, $line) = caller;	# Should indicate original call stats.
+    print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
+	? "ok 7\n"
+	: "not ok 7\n";
+}
+
+sub one {
+    eval <<'END';
+    sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
+END
+    goto &one;
+}
+
+$FILE = __FILE__;
+$LINE = __LINE__ + 1;
+&one(1,2,3);
+
+$wherever = NOWHERE;
+eval { goto $wherever };
+print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
+
+$wherever = FINALE;
+goto $wherever;
diff --git a/gnu/usr.bin/perl/t/op/groups.t b/gnu/usr.bin/perl/t/op/groups.t
new file mode 100644
index 00000000000..4445953966b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/groups.t
@@ -0,0 +1,47 @@
+#!./perl
+
+if (! -x '/usr/ucb/groups') {
+    print "1..0\n";
+    exit 0;
+}
+
+print "1..2\n";
+
+$pwgid = $( + 0;
+($pwgnam) = getgrgid($pwgid);
+@basegroup{$pwgid,$pwgnam} = (1,1);
+
+$seen{$pwgid}++;
+
+for (split(' ', $()) {
+    next if $seen{$_}++;
+    ($group) = getgrgid($_);
+    if (defined $group) {
+	push(@gr, $group);
+    }
+    else {
+	push(@gr, $_);
+    }
+} 
+
+$gr1 = join(' ', sort @gr);
+
+$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`/usr/ucb/groups`)));
+
+if ($gr1 eq $gr2) {
+    print "ok 1\n";
+}
+else {
+    print "#gr1 is <$gr1>\n";
+    print "#gr2 is <$gr2>\n";
+    print "not ok 1\n";
+}
+
+# multiple 0's indicate GROUPSTYPE is currently long but should be short
+
+if ($pwgid == 0 || $seen{0} < 2) {
+    print "ok 2\n";
+}
+else {
+    print "not ok 2 (groupstype should be type short, not long)\n";
+}
diff --git a/gnu/usr.bin/perl/t/op/index.t b/gnu/usr.bin/perl/t/op/index.t
new file mode 100644
index 00000000000..0b08f0879d7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/index.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $RCSfile: index.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:59 $
+
+print "1..20\n";
+
+
+$foo = 'Now is the time for all good men to come to the aid of their country.';
+
+$first = substr($foo,0,index($foo,'the'));
+print ($first eq "Now is " ? "ok 1\n" : "not ok 1\n");
+
+$last = substr($foo,rindex($foo,'the'),100);
+print ($last eq "their country." ? "ok 2\n" : "not ok 2\n");
+
+$last = substr($foo,index($foo,'Now'),2);
+print ($last eq "No" ? "ok 3\n" : "not ok 3\n");
+
+$last = substr($foo,rindex($foo,'Now'),2);
+print ($last eq "No" ? "ok 4\n" : "not ok 4\n");
+
+$last = substr($foo,index($foo,'.'),100);
+print ($last eq "." ? "ok 5\n" : "not ok 5\n");
+
+$last = substr($foo,rindex($foo,'.'),100);
+print ($last eq "." ? "ok 6\n" : "not ok 6\n");
+
+print index("ababa","a",-1) == 0 ? "ok 7\n" : "not ok 7\n";
+print index("ababa","a",0) == 0 ? "ok 8\n" : "not ok 8\n";
+print index("ababa","a",1) == 2 ? "ok 9\n" : "not ok 9\n";
+print index("ababa","a",2) == 2 ? "ok 10\n" : "not ok 10\n";
+print index("ababa","a",3) == 4 ? "ok 11\n" : "not ok 11\n";
+print index("ababa","a",4) == 4 ? "ok 12\n" : "not ok 12\n";
+print index("ababa","a",5) == -1 ? "ok 13\n" : "not ok 13\n";
+
+print rindex("ababa","a",-1) == -1 ? "ok 14\n" : "not ok 14\n";
+print rindex("ababa","a",0) == 0 ? "ok 15\n" : "not ok 15\n";
+print rindex("ababa","a",1) == 0 ? "ok 16\n" : "not ok 16\n";
+print rindex("ababa","a",2) == 2 ? "ok 17\n" : "not ok 17\n";
+print rindex("ababa","a",3) == 2 ? "ok 18\n" : "not ok 18\n";
+print rindex("ababa","a",4) == 4 ? "ok 19\n" : "not ok 19\n";
+print rindex("ababa","a",5) == 4 ? "ok 20\n" : "not ok 20\n";
diff --git a/gnu/usr.bin/perl/t/op/int.t b/gnu/usr.bin/perl/t/op/int.t
new file mode 100644
index 00000000000..eb060acd727
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/int.t
@@ -0,0 +1,17 @@
+#!./perl
+
+# $RCSfile: int.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:00 $
+
+print "1..4\n";
+
+# compile time evaluation
+
+if (int(1.234) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
+
+if (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";}
+
+# run time evaluation
+
+$x = 1.234;
+if (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
+if (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";}
diff --git a/gnu/usr.bin/perl/t/op/join.t b/gnu/usr.bin/perl/t/op/join.t
new file mode 100644
index 00000000000..eec4611e625
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/join.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $RCSfile: join.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:01 $
+
+print "1..3\n";
+
+@x = (1, 2, 3);
+if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
+
+if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/t/op/list.t b/gnu/usr.bin/perl/t/op/list.t
new file mode 100644
index 00000000000..a4230b681b3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/list.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $RCSfile: list.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:02 $
+
+print "1..27\n";
+
+@foo = (1, 2, 3, 4);
+if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
+
+$_ = join(':',@foo);
+if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+
+($a,$b,$c,$d) = (1,2,3,4);
+if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
+
+($c,$b,$a) = split(/ /,"111 222 333");
+if ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
+
+($a,$b,$c) = ($c,$b,$a);
+if ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5 $a;$b;$c\n";}
+
+($a, $b) = ($b, $a);
+if ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
+
+($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
+if ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
+if ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
+
+@foo = (1,2,3,4,5,6,7,8);
+($a, $b, $c, $d) = @foo;
+print "#11	$a;$b;$c;$d eq 1;2;3;4\n";
+if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = @bar = (1);
+if (join(':',@foo,@bar) eq '1:1') {print "ok 12\n";} else {print "not ok 12\n";}
+
+@foo = ();
+@foo = 1+2+3;
+if (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
+
+for ($x = 0; $x < 3; $x++) {
+    ($a, $b, $c) = 
+	    $x == 0?
+		    ('ok ', 14, "\n"):
+	    $x == 1?
+		    ('ok ', 15, "\n"):
+	    # default
+		    ('ok ', 16, "\n");
+
+    print $a,$b,$c;
+}
+
+@a = ($x == 12345 || (1,2,3));
+if (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
+
+@a = ($x == $x || (4,5,6));
+if (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
+
+if (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
+if (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
+if (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
+if (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
+if (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
+if (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
+
+for ($x = 0; $x < 3; $x++) {
+    ($a, $b, $c) = do {
+	    if ($x == 0) {
+		('ok ', 25, "\n");
+	    }
+	    elsif ($x == 1) {
+		('ok ', 26, "\n");
+	    }
+	    else {
+		('ok ', 27, "\n");
+	    }
+	};
+
+    print $a,$b,$c;
+}
+
diff --git a/gnu/usr.bin/perl/t/op/local.t b/gnu/usr.bin/perl/t/op/local.t
new file mode 100644
index 00000000000..043201072db
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/local.t
@@ -0,0 +1,45 @@
+#!./perl
+
+# $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
+
+print "1..20\n";
+
+sub foo {
+    local($a, $b) = @_;
+    local($c, $d);
+    $c = "ok 3\n";
+    $d = "ok 4\n";
+    { local($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+    print $a, $b;
+    $c . $d;
+}
+
+$a = "ok 5\n";
+$b = "ok 6\n";
+$c = "ok 7\n";
+$d = "ok 8\n";
+
+print &foo("ok 1\n","ok 2\n");
+
+print $a,$b,$c,$d,$x,$y;
+
+# same thing, only with arrays and associative arrays
+
+sub foo2 {
+    local($a, @b) = @_;
+    local(@c, %d);
+    @c = "ok 13\n";
+    $d{''} = "ok 14\n";
+    { local($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
+    print $a, @b;
+    $c[0] . $d{''};
+}
+
+$a = "ok 15\n";
+@b = "ok 16\n";
+@c = "ok 17\n";
+$d{''} = "ok 18\n";
+
+print &foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
diff --git a/gnu/usr.bin/perl/t/op/magic.t b/gnu/usr.bin/perl/t/op/magic.t
new file mode 100644
index 00000000000..b43f71c809c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/magic.t
@@ -0,0 +1,45 @@
+#!./perl
+
+# $RCSfile: magic.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:05 $
+
+$| = 1;		# command buffering
+
+print "1..6\n";
+
+eval '$ENV{"foo"} = "hi there";';	# check that ENV is inited inside eval
+if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+unlink 'ajslkdfpqjsjfk';
+$! = 0;
+open(foo,'ajslkdfpqjsjfk');
+if ($!) {print "ok 2\n";} else {print "not ok 2\n";}
+
+# the next tests are embedded inside system simply because sh spits out
+# a newline onto stderr when a child process kills itself with SIGINT.
+
+system './perl', '-e', <<'END';
+
+    $| = 1;		# command buffering
+
+    $SIG{"INT"} = "ok3"; kill "INT",$$;
+    $SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";
+    $SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";
+
+    sub ok3 {
+	if (($x = pop(@_)) eq "INT") {
+	    print "ok 3\n";
+	}
+	else {
+	    print "not ok 3 $a\n";
+	}
+    }
+
+END
+
+@val1 = @ENV{keys(%ENV)};	# can we slice ENV?
+@val2 = values(%ENV);
+
+print join(':',@val1) eq join(':',@val2) ? "ok 5\n" : "not ok 5\n";
+
+print @val1 > 1 ? "ok 6\n" : "not ok 6\n";
+
diff --git a/gnu/usr.bin/perl/t/op/misc.t b/gnu/usr.bin/perl/t/op/misc.t
new file mode 100644
index 00000000000..8fdd11a7d4a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/misc.t
@@ -0,0 +1,171 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = "../lib";
+$ENV{PERL5LIB} = "../lib";
+
+$|=1;
+
+undef $/;
+@prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+$tmpfile = "misctmp000";
+1 while -f ++$tmpfile;
+END { unlink $tmpfile if $tmpfile; }
+
+for (@prgs){
+    my $switch;
+    if (s/^\s*-\w+//){
+	$switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+    print TEST $prog, "\n";
+    close TEST;
+    $status = $?;
+    $results = `cat $tmpfile`;
+    $results =~ s/\n+$//;
+    $expected =~ s/\n+$//;
+    if ( $results ne $expected){
+	print STDERR "PROG: $switch\n$prog\n";
+	print STDERR "EXPECTED:\n$expected\n";
+	print STDERR "GOT:\n$results\n";
+	print "not ";
+    }
+    print "ok ", ++$i, "\n";
+}
+
+__END__
+$foo=undef; $foo->go;
+EXPECT
+Can't call method "go" without a package or object reference at - line 1.
+########
+BEGIN
+        {
+	    "foo";
+        }
+########
+$array[128]=1
+########
+$x=0x0eabcd; print $x->ref;
+EXPECT
+Can't call method "ref" without a package or object reference at - line 1.
+########
+chop ($str .= <STDIN>);
+########
+close ($banana);
+########
+$x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
+EXPECT
+25
+########
+eval {sub bar {print "In bar";}}
+########
+system "./perl -ne 'print if eof' /dev/null"
+########
+chop($file = <>);
+########
+package N;
+sub new {my ($obj,$n)=@_; bless \$n}  
+$aa=new N 1;
+$aa=12345;
+print $aa;
+EXPECT
+12345
+########
+%@x=0;
+EXPECT
+Can't coerce HASH to string in repeat at - line 1.
+########
+$_="foo";
+printf(STDOUT "%s\n", $_);
+EXPECT
+foo
+########
+push(@a, 1, 2, 3,)
+########
+quotemeta ""
+########
+for ("ABCDE") {
+ &sub;
+s/./&sub($&)/eg;
+print;}
+sub sub {local($_) = @_;
+$_ x 4;}
+EXPECT
+Modification of a read-only value attempted at - line 3.
+########
+package FOO;sub new {bless {FOO => BAR}};
+package main;
+use strict vars;   
+my $self = new FOO;
+print $$self{FOO};
+EXPECT
+BAR
+########
+$_="foo";
+s/.{1}//s;
+print;
+EXPECT
+oo
+########
+print scalar ("foo","bar")
+EXPECT
+bar
+########
+sub by_number { $a <=> $b; };# inline function for sort below
+$as_ary{0}="a0";
+@ordered_array=sort by_number keys(%as_ary);
+########
+sub NewShell
+{
+  local($Host) = @_;
+  my($m2) = $#Shells++;
+  $Shells[$m2]{HOST} = $Host;
+  return $m2;
+}
+ 
+sub ShowShell
+{
+  local($i) = @_;
+}
+ 
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+########
+   {
+       package FAKEARRAY;
+   
+       sub TIEARRAY
+       { print "TIEARRAY @_\n"; 
+         die "bomb out\n" unless $count ++ ;
+         bless ['foo'] 
+       }
+       sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
+       sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
+       sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
+   }
+   
+eval 'tie @h, FAKEARRAY, fred' ;
+tie @h, FAKEARRAY, fred ;
+EXPECT
+TIEARRAY FAKEARRAY fred
+TIEARRAY FAKEARRAY fred
+DESTROY 
+########
+BEGIN { die "phooey\n" }
+EXPECT
+phooey
+BEGIN failed--compilation aborted at - line 1.
+########
+BEGIN { 1/$zero }
+EXPECT
+Illegal division by zero at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+########
+BEGIN { undef = 0 }
+EXPECT
+Modification of a read-only value attempted at - line 1.
+BEGIN failed--compilation aborted at - line 1.
diff --git a/gnu/usr.bin/perl/t/op/mkdir.t b/gnu/usr.bin/perl/t/op/mkdir.t
new file mode 100644
index 00000000000..7db5ec91e45
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/mkdir.t
@@ -0,0 +1,15 @@
+#!./perl
+
+# $RCSfile: mkdir.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:06 $
+
+print "1..7\n";
+
+`rm -rf blurfl`;
+
+print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
+print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
+print ($! =~ /exist/ ? "ok 3\n" : "not ok 3\n");
+print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
+print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
+print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
+print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
diff --git a/gnu/usr.bin/perl/t/op/my.t b/gnu/usr.bin/perl/t/op/my.t
new file mode 100644
index 00000000000..4ce020f2066
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/my.t
@@ -0,0 +1,46 @@
+#!./perl
+
+# $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
+
+print "1..20\n";
+
+sub foo {
+    my($a, $b) = @_;
+    my $c;
+    my $d;
+    $c = "ok 3\n";
+    $d = "ok 4\n";
+    { my($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+    print $a, $b;
+    $c . $d;
+}
+
+$a = "ok 5\n";
+$b = "ok 6\n";
+$c = "ok 7\n";
+$d = "ok 8\n";
+
+print &foo("ok 1\n","ok 2\n");
+
+print $a,$b,$c,$d,$x,$y;
+
+# same thing, only with arrays and associative arrays
+
+sub foo2 {
+    my($a, @b) = @_;
+    my(@c, %d);
+    @c = "ok 13\n";
+    $d{''} = "ok 14\n";
+    { my($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
+    print $a, @b;
+    $c[0] . $d{''};
+}
+
+$a = "ok 15\n";
+@b = "ok 16\n";
+@c = "ok 17\n";
+$d{''} = "ok 18\n";
+
+print &foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
diff --git a/gnu/usr.bin/perl/t/op/oct.t b/gnu/usr.bin/perl/t/op/oct.t
new file mode 100644
index 00000000000..7890643aef4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/oct.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
+
+print "1..6\n";
+
+print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
+print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
+print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 3\n";
+print +(oct('20000000000') == 020000000000) ? "ok" : "not ok", " 4\n";
+print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
+print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
diff --git a/gnu/usr.bin/perl/t/op/ord.t b/gnu/usr.bin/perl/t/op/ord.t
new file mode 100644
index 00000000000..37128382d86
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/ord.t
@@ -0,0 +1,16 @@
+#!./perl
+
+# $RCSfile: ord.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:09 $
+
+print "1..3\n";
+
+# compile time evaluation
+
+if (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
+
+# run time evaluation
+
+$x = 'ABC';
+if (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (chr 65 == A) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/gnu/usr.bin/perl/t/op/overload.t b/gnu/usr.bin/perl/t/op/overload.t
new file mode 100644
index 00000000000..183cb273f70
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/overload.t
@@ -0,0 +1,267 @@
+#!./perl
+
+BEGIN { unshift @INC, './lib', '../lib';
+    require Config; import Config;
+}
+
+package Oscalar;
+use overload ( 
+				# Anonymous subroutines:
+'+'	=>	sub {new Oscalar $ {$_[0]}+$_[1]},
+'-'	=>	sub {new Oscalar
+		       $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'<=>'	=>	sub {new Oscalar
+		       $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'cmp'	=>	sub {new Oscalar
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Oscalar ${$_[0]}*$_[1]},
+'/'	=>	sub {new Oscalar 
+		       $_[2]? $_[1]/${$_[0]} :
+			 ${$_[0]}/$_[1]},
+'%'	=>	sub {new Oscalar
+		       $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
+'**'	=>	sub {new Oscalar
+		       $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+);
+
+sub new {
+  my $foo = $_[1];
+  bless \$foo;
+}
+
+sub stringify { "${$_[0]}" }
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+
+package main;
+
+$test = 0;
+$| = 1;
+print "1..",&last,"\n";
+
+sub test {
+  $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0}
+}
+
+$a = new Oscalar "087";
+$b= "$a";
+
+# All test numbers in comments are off by 1.
+# So much for hard-wiring them in :-)
+test ($b eq $a);		# 2
+test ($b eq "087");		# 3
+test (ref $a eq "Oscalar");	# 4
+test ($a eq $a);		# 5
+test ($a eq "087");		# 6
+
+$c = $a + 7;
+
+test (ref $c eq "Oscalar");	# 7
+test (!($c eq $a));		# 8
+test ($c eq "94");		# 9
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 10
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 11
+test ( $a eq "087");		# 12
+test ( $b eq "88");		# 13
+test (ref $a eq "Oscalar");	# 14
+
+$c=$b;
+$c-=$a;
+
+test (ref $c eq "Oscalar");	# 15
+test ( $a eq "087");		# 16
+test ( $c eq "1");		# 17
+test (ref $a eq "Oscalar");	# 18
+
+$b=1;
+$b+=$a;
+
+test (ref $b eq "Oscalar");	# 19
+test ( $a eq "087");		# 20
+test ( $b eq "88");		# 21
+test (ref $a eq "Oscalar");	# 22
+
+eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 23
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 24
+test ( $a eq "087");		# 25
+test ( $b eq "88");		# 26
+test (ref $a eq "Oscalar");	# 27
+
+package Oscalar;
+$dummy=bless \$dummy;		# Now cache of method should be reloaded
+package main;
+
+$b=$a;
+$b++;				
+
+test (ref $b eq "Oscalar");	# 28
+test ( $a eq "087");		# 29
+test ( $b eq "88");		# 30
+test (ref $a eq "Oscalar");	# 31
+
+
+eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 32
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 33
+test ( $a eq "087");		# 34
+test ( $b eq "88");		# 35
+test (ref $a eq "Oscalar");	# 36
+
+package Oscalar;
+$dummy=bless \$dummy;		# Now cache of method should be reloaded
+package main;
+
+$b++;				
+
+test (ref $b eq "Oscalar");	# 37
+test ( $a eq "087");		# 38
+test ( $b eq "90");		# 39
+test (ref $a eq "Oscalar");	# 40
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar");	# 41
+test ( $a eq "087");		# 42
+test ( $b eq "89");		# 43
+test (ref $a eq "Oscalar");	# 44
+
+
+test ($b? 1:0);			# 45
+
+eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
+						   package Oscalar;
+						   local $new=$ {$_[0]};
+						   bless \$new } ) ];
+
+$b=new Oscalar "$a";
+
+test (ref $b eq "Oscalar");	# 46
+test ( $a eq "087");		# 47
+test ( $b eq "087");		# 48
+test (ref $a eq "Oscalar");	# 49
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 50
+test ( $a eq "087");		# 51
+test ( $b eq "89");		# 52
+test (ref $a eq "Oscalar");	# 53
+test ($copies == 0);		# 54
+
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 55
+test ( $a eq "087");		# 56
+test ( $b eq "90");		# 57
+test (ref $a eq "Oscalar");	# 58
+test ($copies == 0);		# 59
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 60
+test ( $a eq "087");		# 61
+test ( $b eq "88");		# 62
+test (ref $a eq "Oscalar");	# 63
+test ($copies == 0);		# 64
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n";	# 65
+test ( $a eq "087");		# 66
+test ( $b eq "89");		# 67
+test (ref $a eq "Oscalar");	# 68
+test ($copies == 1);		# 69
+
+eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
+						   $_[0] } ) ];
+$c=new Oscalar;			# Cause rehash
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 70
+test ( $a eq "087");		# 71
+test ( $b eq "90");		# 72
+test (ref $a eq "Oscalar");	# 73
+test ($copies == 2);		# 74
+
+$b+=$b;
+
+test (ref $b eq "Oscalar");	# 75
+test ( $b eq "360");		# 76
+test ($copies == 2);		# 77
+$b=-$b;
+
+test (ref $b eq "Oscalar");	# 78
+test ( $b eq "-360");		# 79
+test ($copies == 2);		# 80
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");	# 81
+test ( $b eq "360");		# 82
+test ($copies == 2);		# 83
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");	# 84
+test ( $b eq "360");		# 85
+test ($copies == 2);		# 86
+
+eval q[package Oscalar; 
+       use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
+					      : "_.${$_[0]}._" x $_[1])}) ];
+
+$a=new Oscalar "yy";
+$a x= 3;
+test ($a eq "_.yy.__.yy.__.yy._"); # 87
+
+eval q[package Oscalar; 
+       use overload ('.' => sub {new Oscalar ( $_[2] ? 
+					      "_.$_[1].__.$ {$_[0]}._"
+					      : "_.$ {$_[0]}.__.$_[1]._")}) ];
+
+$a=new Oscalar "xx";
+
+test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
+
+# Here we test blessing to a package updates hash
+
+eval "package Oscalar; no overload '.'";
+
+test ("b${a}" eq "_.b.__.xx._"); # 89
+$x="1";
+bless \$x, Oscalar;
+test ("b${a}c" eq "bxxc");	# 90
+new Oscalar 1;
+test ("b${a}c" eq "bxxc");	# 91
+
+# Last test is number 90.
+sub last {90}
diff --git a/gnu/usr.bin/perl/t/op/pack.t b/gnu/usr.bin/perl/t/op/pack.t
new file mode 100644
index 00000000000..1cfcd60b086
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/pack.t
@@ -0,0 +1,43 @@
+#!./perl
+
+# $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
+
+print "1..8\n";
+
+$format = "c2x5CCxsdila6";
+# Need the expression in here to force ary[5] to be numeric.  This avoids
+# test2 failing because ary2 goes str->numeric->str and ary doesn't.
+@ary = (1,-100,127,128,32767,987.654321098 / 100.0,12345,123456,"abcdef");
+$foo = pack($format,@ary);
+@ary2 = unpack($format,$foo);
+
+print ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n");
+
+$out1=join(':',@ary);
+$out2=join(':',@ary2);
+print ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n");
+
+print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n");
+
+# How about counting bits?
+
+print +($x = unpack("%32B*", "\001\002\004\010\020\040\100\200\377")) == 16
+	? "ok 4\n" : "not ok 4 $x\n";
+
+print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
+	? "ok 5\n" : "not ok 5 $x\n";
+
+print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
+	? "ok 6\n" : "not ok 6 $x\n";
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == 129
+	? "ok 7\n" : "not ok 7 $x\n";
+
+open(BIN, "./perl") || open(BIN, "./perl.exe") 
+    || die "Can't open ../perl or ../perl.exe: $!\n";
+sysread BIN, $foo, 8192;
+close BIN;
+
+$sum = unpack("%32b*", $foo);
+$longway = unpack("b*", $foo);
+print $sum == $longway =~ tr/1/1/ ? "ok 8\n" : "not ok 8\n";
diff --git a/gnu/usr.bin/perl/t/op/pat.t b/gnu/usr.bin/perl/t/op/pat.t
new file mode 100644
index 00000000000..d5d1aa63010
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/pat.t
@@ -0,0 +1,206 @@
+#!./perl
+
+# $RCSfile: pat.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:20 $
+
+print "1..60\n";
+
+$x = "abc\ndef\n";
+
+if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$* = 1;
+if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
+$* = 0;
+
+$_ = '123';
+if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
+if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+
+if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+
+if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+
+if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+
+$_ = 'aaabbbccc';
+if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
+	print "ok 13\n";
+} else {
+	print "not ok 13\n";
+}
+if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
+	print "ok 14\n";
+} else {
+	print "not ok 14\n";
+}
+
+if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+
+$_ = 'aaabccc';
+if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
+if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+
+$_ = 'aaaccc';
+if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
+if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+
+$_ = 'abcdef';
+if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
+if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
+
+if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$* = 1;		# test 3 only tested the optimized version--this one is for real
+if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
+$* = 0;
+
+$XXX{123} = 123;
+$XXX{234} = 234;
+$XXX{345} = 345;
+
+@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
+while ($_ = shift(XXX)) {
+    ?(.*)? && (print $1,"\n");
+    /not/ && reset;
+    /not ok 26/ && reset 'X';
+}
+
+while (($key,$val) = each(%XXX)) {
+    print "not ok 27\n";
+    exit;
+}
+
+print "ok 27\n";
+
+'cde' =~ /[^ab]*/;
+'xyz' =~ //;
+if ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
+
+$foo = '[^ab]*';
+'cde' =~ /$foo/;
+'xyz' =~ //;
+if ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
+
+$foo = '[^ab]*';
+'cde' =~ /$foo/;
+'xyz' =~ /$null/;
+if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
+
+$_ = 'abcdefghi';
+/def/;		# optimized up to cmd
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
+
+/cde/ + 0;	# optimized only to spat
+if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
+
+/[d][e][f]/;	# not optimized
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
+
+$_ = 'now is the {time for all} good men to come to.';
+/ {([^}]*)}/;
+if ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
+
+$_ = 'xxx {3,4}  yyy   zzz';
+print /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
+print $1 eq '   ' ? "ok 36\n" : "not ok 36\n";
+print /( {4,})/ ? "not ok 37\n" : "ok 37\n";
+print /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
+print $1 eq '  y' ? "ok 39\n" : "not ok 39\n";
+print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
+print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
+print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
+print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
+
+$_ = "now is the time for all good men to come to.";
+@words = /(\w+)/g;
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 44\n"
+    : "not ok 44\n";
+
+@words = ();
+while (/\w+/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 45\n"
+    : "not ok 45\n";
+
+@words = ();
+while (/to/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "to:to"
+    ? "ok 46\n"
+    : "not ok 46 @words\n";
+
+@words = /to/g;
+print join(':',@words) eq "to:to"
+    ? "ok 47\n"
+    : "not ok 47 @words\n";
+
+$_ = "abcdefghi";
+
+$pat1 = 'def';
+$pat2 = '^def';
+$pat3 = '.def.';
+$pat4 = 'abc';
+$pat5 = '^abc';
+$pat6 = 'abc$';
+$pat7 = 'ghi';
+$pat8 = '\w*ghi';
+$pat9 = 'ghi$';
+
+$t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
+
+for $iter (1..5) {
+    $t1++ if /$pat1/o;
+    $t2++ if /$pat2/o;
+    $t3++ if /$pat3/o;
+    $t4++ if /$pat4/o;
+    $t5++ if /$pat5/o;
+    $t6++ if /$pat6/o;
+    $t7++ if /$pat7/o;
+    $t8++ if /$pat8/o;
+    $t9++ if /$pat9/o;
+}
+
+$x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
+print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
+
+$xyz = 'xyz';
+print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
+
+# perl 4.009 says "unmatched ()"
+eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
+print $@ eq "" ? "ok 50\n" : "not ok 50\n";
+print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
+
+
+$_="abcfooabcbar";
+$x=/abc/g;
+print $` eq "" ? "ok 52\n" : "not ok 52\n" if $x;
+$x=/abc/g;
+print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x;
+$x=/abc/g;
+print $x == 0 ? "ok 54\n" : "not ok 54\n";
+$x=/ABC/gi;
+print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x;
+$x=/ABC/gi;
+print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x;
+$x=/ABC/gi;
+print $x == 0 ? "ok 57\n" : "not ok 57\n";
+$x=/abc/g;
+print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x;
+$x=/abc/g;
+print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x;
+$_ .= '';
+@x=/abc/g;
+print scalar @x == 2 ? "ok 60\n" : "not ok 60\n";
diff --git a/gnu/usr.bin/perl/t/op/push.t b/gnu/usr.bin/perl/t/op/push.t
new file mode 100644
index 00000000000..68fab66af77
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/push.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: push.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:13 $
+
+@tests = split(/\n/, <<EOF);
+0 3,			0 1 2,		3 4 5 6 7
+0 0 a b c,		,		a b c 0 1 2 3 4 5 6 7
+8 0 a b c,		,		0 1 2 3 4 5 6 7 a b c
+7 0 6.5,		,		0 1 2 3 4 5 6 6.5 7
+1 0 a b c d e f g h i j,,		0 a b c d e f g h i j 1 2 3 4 5 6 7
+0 1 a,			0,		a 1 2 3 4 5 6 7
+1 6 x y z,		1 2 3 4 5 6,	0 x y z 7
+0 7 x y z,		0 1 2 3 4 5 6,	x y z 7
+1 7 x y z,		1 2 3 4 5 6 7,	0 x y z
+4,			4 5 6 7,	0 1 2 3
+-4,			4 5 6 7,	0 1 2 3
+EOF
+
+print "1..", 2 + @tests, "\n";
+die "blech" unless @tests;
+
+@x = (1,2,3);
+push(@x,@x);
+if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
+push(x,4);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$test = 3;
+foreach $line (@tests) {
+    ($list,$get,$leave) = split(/,\t*/,$line);
+    ($pos, $len, @list) = split(' ',$list);
+    @get = split(' ',$get);
+    @leave = split(' ',$leave);
+    @x = (0,1,2,3,4,5,6,7);
+    if (defined $len) {
+	@got = splice(@x, $pos, $len, @list);
+    }
+    else {
+	@got = splice(@x, $pos);
+    }
+    if (join(':',@got) eq join(':',@get) &&
+	join(':',@x) eq join(':',@leave)) {
+	print "ok ",$test++,"\n";
+    }
+    else {
+	print "not ok ",$test++," got: @got == @get left: @x == @leave\n";
+    }
+}
+
diff --git a/gnu/usr.bin/perl/t/op/quotemeta.t b/gnu/usr.bin/perl/t/op/quotemeta.t
new file mode 100644
index 00000000000..09794571b1d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/quotemeta.t
@@ -0,0 +1,26 @@
+#!./perl
+print "1..15\n";
+
+$_=join "", grep $_=chr($_), 32..127;
+
+#95 characters - 52 letters - 10 digits = 33 backslashes
+#95 characters + 33 backslashes = 128 characters
+$_=quotemeta $_;
+if ( length == 128 ){print "ok 1\n"} else {print "not ok 1\n"}
+if (tr/\\//cd == 94){print "ok 2\n"} else {print "not ok 2\n"}
+
+#perl5a11 bus errors on this:
+if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"}
+
+print "aA\UbB\LcC\EdD" eq "aABBccdD" ? "ok 4\n" : "not ok 4 \n";
+print "aA\LbB\UcC\EdD" eq "aAbbCCdD" ? "ok 5\n" : "not ok 5 \n";
+print "\L\upERL" eq "Perl" ? "ok 6\n" : "not ok 6 \n";
+print "\u\LpERL" eq "Perl" ? "ok 7\n" : "not ok 7 \n";
+print "\U\lPerl" eq "pERL" ? "ok 8\n" : "not ok 8 \n";
+print "\l\UPerl" eq "pERL" ? "ok 9\n" : "not ok 9 \n";
+print "\u\LpE\Q#X#\ER\EL" eq "Pe\\#x\\#rL" ? "ok 10\n" : "not ok 10 \n";
+print "\l\UPe\Q!x!\Er\El" eq "pE\\!X\\!Rl" ? "ok 11\n" : "not ok 11 \n";
+print "\Q\u\LpE.X.R\EL\E." eq "Pe\\.x\\.rL." ? "ok 12\n" : "not ok 12 \n";
+print "\Q\l\UPe*x*r\El\E*" eq "pE\\*X\\*Rl*" ? "ok 13\n" : "not ok 13 \n";
+print "\U\lPerl\E\E\E\E" eq "pERL" ? "ok 14\n" : "not ok 14 \n";
+print "\l\UPerl\E\E\E\E" eq "pERL" ? "ok 15\n" : "not ok 15 \n";
diff --git a/gnu/usr.bin/perl/t/op/rand.t b/gnu/usr.bin/perl/t/op/rand.t
new file mode 100644
index 00000000000..5c0eccf15f1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/rand.t
@@ -0,0 +1,52 @@
+#!./perl
+
+# From: kgb@ast.cam.ac.uk (Karl Glazebrook)
+
+print "1..4\n";
+
+srand;
+
+$m=0; 
+for(1..1000){ 
+   $n = rand(1);
+   if ($n<0 || $n>=1) {
+       print "not ok 1\n# The value of randbits is likely too low in config.sh\n";
+       exit
+   }
+   $m += $n;
+
+}
+$m=$m/1000;
+print "ok 1\n";
+
+if ($m<0.4) {
+    print "not ok 2\n# The value of randbits is likely too high in config.sh\n";
+}
+elsif ($m>0.6) {
+    print "not ok 2\n# Something's really weird about rand()'s distribution.\n";
+}else{
+    print "ok 2\n";
+}
+
+srand;
+
+$m=0; 
+for(1..1000){ 
+   $n = rand(100);
+   if ($n<0 || $n>=100) {
+       print "not ok 3\n";
+       exit
+   }
+   $m += $n;
+
+}
+$m=$m/1000;
+print "ok 3\n";
+
+if ($m<40 || $m>60) {
+    print "not ok 4\n";
+}else{
+    print "ok 4\n";
+}
+
+
diff --git a/gnu/usr.bin/perl/t/op/range.t b/gnu/usr.bin/perl/t/op/range.t
new file mode 100644
index 00000000000..746da468005
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/range.t
@@ -0,0 +1,36 @@
+#!./perl
+
+# $RCSfile: range.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:14 $
+
+print "1..8\n";
+
+print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
+
+@foo = (1,2,3,4,5,6,7,8,9);
+@foo[2..4] = ('c','d','e');
+
+print join(':',@foo[$foo[0]..5]) eq '2:c:d:e:6' ? "ok 2\n" : "not ok 2\n";
+
+@bar[2..4] = ('c','d','e');
+print join(':',@bar[1..5]) eq ':c:d:e:' ? "ok 3\n" : "not ok 3\n";
+
+($a,@bcd[0..2],$e) = ('a','b','c','d','e');
+print join(':',$a,@bcd[0..2],$e) eq 'a:b:c:d:e' ? "ok 4\n" : "not ok 4\n";
+
+$x = 0;
+for (1..100) {
+    $x += $_;
+}
+print $x == 5050 ? "ok 5\n" : "not ok 5 $x\n";
+
+$x = 0;
+for ((100,2..99,1)) {
+    $x += $_;
+}
+print $x == 5050 ? "ok 6\n" : "not ok 6 $x\n";
+
+$x = join('','a'..'z');
+print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n";
+
+@x = 'A'..'ZZ';
+print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n";
diff --git a/gnu/usr.bin/perl/t/op/re_tests b/gnu/usr.bin/perl/t/op/re_tests
new file mode 100644
index 00000000000..f8c4c6eafbc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/re_tests
@@ -0,0 +1,267 @@
+abc	abc	y	$&	abc
+abc	xbc	n	-	-
+abc	axc	n	-	-
+abc	abx	n	-	-
+abc	xabcy	y	$&	abc
+abc	ababc	y	$&	abc
+ab*c	abc	y	$&	abc
+ab*bc	abc	y	$&	abc
+ab*bc	abbc	y	$&	abbc
+ab*bc	abbbbc	y	$&	abbbbc
+ab{0,}bc	abbbbc	y	$&	abbbbc
+ab+bc	abbc	y	$&	abbc
+ab+bc	abc	n	-	-
+ab+bc	abq	n	-	-
+ab{1,}bc	abq	n	-	-
+ab+bc	abbbbc	y	$&	abbbbc
+ab{1,}bc	abbbbc	y	$&	abbbbc
+ab{1,3}bc	abbbbc	y	$&	abbbbc
+ab{3,4}bc	abbbbc	y	$&	abbbbc
+ab{4,5}bc	abbbbc	n	-	-
+ab?bc	abbc	y	$&	abbc
+ab?bc	abc	y	$&	abc
+ab{0,1}bc	abc	y	$&	abc
+ab?bc	abbbbc	n	-	-
+ab?c	abc	y	$&	abc
+ab{0,1}c	abc	y	$&	abc
+^abc$	abc	y	$&	abc
+^abc$	abcc	n	-	-
+^abc	abcc	y	$&	abc
+^abc$	aabc	n	-	-
+abc$	aabc	y	$&	abc
+^	abc	y	$&	
+$	abc	y	$&	
+a.c	abc	y	$&	abc
+a.c	axc	y	$&	axc
+a.*c	axyzc	y	$&	axyzc
+a.*c	axyzd	n	-	-
+a[bc]d	abc	n	-	-
+a[bc]d	abd	y	$&	abd
+a[b-d]e	abd	n	-	-
+a[b-d]e	ace	y	$&	ace
+a[b-d]	aac	y	$&	ac
+a[-b]	a-	y	$&	a-
+a[b-]	a-	y	$&	a-
+a[b-a]	-	c	-	-
+a[]b	-	c	-	-
+a[	-	c	-	-
+a]	a]	y	$&	a]
+a[]]b	a]b	y	$&	a]b
+a[^bc]d	aed	y	$&	aed
+a[^bc]d	abd	n	-	-
+a[^-b]c	adc	y	$&	adc
+a[^-b]c	a-c	n	-	-
+a[^]b]c	a]c	n	-	-
+a[^]b]c	adc	y	$&	adc
+ab|cd	abc	y	$&	ab
+ab|cd	abcd	y	$&	ab
+()ef	def	y	$&-$1	ef-
+*a	-	c	-	-
+(*)b	-	c	-	-
+$b	b	n	-	-
+a\	-	c	-	-
+a\(b	a(b	y	$&-$1	a(b-
+a\(*b	ab	y	$&	ab
+a\(*b	a((b	y	$&	a((b
+a\\b	a\b	y	$&	a\b
+abc)	-	c	-	-
+(abc	-	c	-	-
+((a))	abc	y	$&-$1-$2	a-a-a
+(a)b(c)	abc	y	$&-$1-$2	abc-a-c
+a+b+c	aabbabc	y	$&	abc
+a{1,}b{1,}c	aabbabc	y	$&	abc
+a**	-	c	-	-
+a.+?c	abcabc	y	$&	abc
+(a+|b)*	ab	y	$&-$1	ab-b
+(a+|b){0,}	ab	y	$&-$1	ab-b
+(a+|b)+	ab	y	$&-$1	ab-b
+(a+|b){1,}	ab	y	$&-$1	ab-b
+(a+|b)?	ab	y	$&-$1	a-a
+(a+|b){0,1}	ab	y	$&-$1	a-a
+)(	-	c	-	-
+[^ab]*	cde	y	$&	cde
+abc		n	-	-
+a*		y	$&	
+([abc])*d	abbbcd	y	$&-$1	abbbcd-c
+([abc])*bcd	abcd	y	$&-$1	abcd-a
+a|b|c|d|e	e	y	$&	e
+(a|b|c|d|e)f	ef	y	$&-$1	ef-e
+abcd*efg	abcdefg	y	$&	abcdefg
+ab*	xabyabbbz	y	$&	ab
+ab*	xayabbbz	y	$&	a
+(ab|cd)e	abcde	y	$&-$1	cde-cd
+[abhgefdc]ij	hij	y	$&	hij
+^(ab|cd)e	abcde	n	x$1y	xy
+(abc|)ef	abcdef	y	$&-$1	ef-
+(a|b)c*d	abcd	y	$&-$1	bcd-b
+(ab|ab*)bc	abc	y	$&-$1	abc-a
+a([bc]*)c*	abc	y	$&-$1	abc-bc
+a([bc]*)(c*d)	abcd	y	$&-$1-$2	abcd-bc-d
+a([bc]+)(c*d)	abcd	y	$&-$1-$2	abcd-bc-d
+a([bc]*)(c+d)	abcd	y	$&-$1-$2	abcd-b-cd
+a[bcd]*dcdcde	adcdcde	y	$&	adcdcde
+a[bcd]+dcdcde	adcdcde	n	-	-
+(ab|a)b*c	abc	y	$&-$1	abc-ab
+((a)(b)c)(d)	abcd	y	$1-$2-$3-$4	abc-a-b-d
+[a-zA-Z_][a-zA-Z0-9_]*	alpha	y	$&	alpha
+^a(bc+|b[eh])g|.h$	abh	y	$&-$1	bh-
+(bc+d$|ef*g.|h?i(j|k))	effgz	y	$&-$1-$2	effgz-effgz-
+(bc+d$|ef*g.|h?i(j|k))	ij	y	$&-$1-$2	ij-ij-j
+(bc+d$|ef*g.|h?i(j|k))	effg	n	-	-
+(bc+d$|ef*g.|h?i(j|k))	bcdd	n	-	-
+(bc+d$|ef*g.|h?i(j|k))	reffgz	y	$&-$1-$2	effgz-effgz-
+((((((((((a))))))))))	a	y	$10	a
+((((((((((a))))))))))\10	aa	y	$&	aa
+((((((((((a))))))))))\41	aa	n	-	-
+((((((((((a))))))))))\41	a!	y	$&	a!
+(((((((((a)))))))))	a	y	$&	a
+multiple words of text	uh-uh	n	-	-
+multiple words	multiple words, yeah	y	$&	multiple words
+(.*)c(.*)	abcde	y	$&-$1-$2	abcde-ab-de
+\((.*), (.*)\)	(a, b)	y	($2, $1)	(b, a)
+[k]	ab	n	-	-
+abcd	abcd	y	$&-\$&-\\$&	abcd-$&-\abcd
+a(bc)d	abcd	y	$1-\$1-\\$1	bc-$1-\bc
+a[-]?c	ac	y	$&	ac
+(abc)\1	abcabc	y	$1	abc
+([a-c]*)\1	abcabc	y	$1	abc
+'abc'i	ABC	y	$&	ABC
+'abc'i	XBC	n	-	-
+'abc'i	AXC	n	-	-
+'abc'i	ABX	n	-	-
+'abc'i	XABCY	y	$&	ABC
+'abc'i	ABABC	y	$&	ABC
+'ab*c'i	ABC	y	$&	ABC
+'ab*bc'i	ABC	y	$&	ABC
+'ab*bc'i	ABBC	y	$&	ABBC
+'ab*?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{0,}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab+?bc'i	ABBC	y	$&	ABBC
+'ab+bc'i	ABC	n	-	-
+'ab+bc'i	ABQ	n	-	-
+'ab{1,}bc'i	ABQ	n	-	-
+'ab+bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,3}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{3,4}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{4,5}?bc'i	ABBBBC	n	-	-
+'ab??bc'i	ABBC	y	$&	ABBC
+'ab??bc'i	ABC	y	$&	ABC
+'ab{0,1}?bc'i	ABC	y	$&	ABC
+'ab??bc'i	ABBBBC	n	-	-
+'ab??c'i	ABC	y	$&	ABC
+'ab{0,1}?c'i	ABC	y	$&	ABC
+'^abc$'i	ABC	y	$&	ABC
+'^abc$'i	ABCC	n	-	-
+'^abc'i	ABCC	y	$&	ABC
+'^abc$'i	AABC	n	-	-
+'abc$'i	AABC	y	$&	ABC
+'^'i	ABC	y	$&	
+'$'i	ABC	y	$&	
+'a.c'i	ABC	y	$&	ABC
+'a.c'i	AXC	y	$&	AXC
+'a.*?c'i	AXYZC	y	$&	AXYZC
+'a.*c'i	AXYZD	n	-	-
+'a[bc]d'i	ABC	n	-	-
+'a[bc]d'i	ABD	y	$&	ABD
+'a[b-d]e'i	ABD	n	-	-
+'a[b-d]e'i	ACE	y	$&	ACE
+'a[b-d]'i	AAC	y	$&	AC
+'a[-b]'i	A-	y	$&	A-
+'a[b-]'i	A-	y	$&	A-
+'a[b-a]'i	-	c	-	-
+'a[]b'i	-	c	-	-
+'a['i	-	c	-	-
+'a]'i	A]	y	$&	A]
+'a[]]b'i	A]B	y	$&	A]B
+'a[^bc]d'i	AED	y	$&	AED
+'a[^bc]d'i	ABD	n	-	-
+'a[^-b]c'i	ADC	y	$&	ADC
+'a[^-b]c'i	A-C	n	-	-
+'a[^]b]c'i	A]C	n	-	-
+'a[^]b]c'i	ADC	y	$&	ADC
+'ab|cd'i	ABC	y	$&	AB
+'ab|cd'i	ABCD	y	$&	AB
+'()ef'i	DEF	y	$&-$1	EF-
+'*a'i	-	c	-	-
+'(*)b'i	-	c	-	-
+'$b'i	B	n	-	-
+'a\'i	-	c	-	-
+'a\(b'i	A(B	y	$&-$1	A(B-
+'a\(*b'i	AB	y	$&	AB
+'a\(*b'i	A((B	y	$&	A((B
+'a\\b'i	A\B	y	$&	A\B
+'abc)'i	-	c	-	-
+'(abc'i	-	c	-	-
+'((a))'i	ABC	y	$&-$1-$2	A-A-A
+'(a)b(c)'i	ABC	y	$&-$1-$2	ABC-A-C
+'a+b+c'i	AABBABC	y	$&	ABC
+'a{1,}b{1,}c'i	AABBABC	y	$&	ABC
+'a**'i	-	c	-	-
+'a.+?c'i	ABCABC	y	$&	ABC
+'a.*?c'i	ABCABC	y	$&	ABC
+'a.{0,5}?c'i	ABCABC	y	$&	ABC
+'(a+|b)*'i	AB	y	$&-$1	AB-B
+'(a+|b){0,}'i	AB	y	$&-$1	AB-B
+'(a+|b)+'i	AB	y	$&-$1	AB-B
+'(a+|b){1,}'i	AB	y	$&-$1	AB-B
+'(a+|b)?'i	AB	y	$&-$1	A-A
+'(a+|b){0,1}'i	AB	y	$&-$1	A-A
+'(a+|b){0,1}?'i	AB	y	$&-$1	-
+')('i	-	c	-	-
+'[^ab]*'i	CDE	y	$&	CDE
+'abc'i		n	-	-
+'a*'i		y	$&	
+'([abc])*d'i	ABBBCD	y	$&-$1	ABBBCD-C
+'([abc])*bcd'i	ABCD	y	$&-$1	ABCD-A
+'a|b|c|d|e'i	E	y	$&	E
+'(a|b|c|d|e)f'i	EF	y	$&-$1	EF-E
+'abcd*efg'i	ABCDEFG	y	$&	ABCDEFG
+'ab*'i	XABYABBBZ	y	$&	AB
+'ab*'i	XAYABBBZ	y	$&	A
+'(ab|cd)e'i	ABCDE	y	$&-$1	CDE-CD
+'[abhgefdc]ij'i	HIJ	y	$&	HIJ
+'^(ab|cd)e'i	ABCDE	n	x$1y	XY
+'(abc|)ef'i	ABCDEF	y	$&-$1	EF-
+'(a|b)c*d'i	ABCD	y	$&-$1	BCD-B
+'(ab|ab*)bc'i	ABC	y	$&-$1	ABC-A
+'a([bc]*)c*'i	ABC	y	$&-$1	ABC-BC
+'a([bc]*)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]+)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]*)(c+d)'i	ABCD	y	$&-$1-$2	ABCD-B-CD
+'a[bcd]*dcdcde'i	ADCDCDE	y	$&	ADCDCDE
+'a[bcd]+dcdcde'i	ADCDCDE	n	-	-
+'(ab|a)b*c'i	ABC	y	$&-$1	ABC-AB
+'((a)(b)c)(d)'i	ABCD	y	$1-$2-$3-$4	ABC-A-B-D
+'[a-zA-Z_][a-zA-Z0-9_]*'i	ALPHA	y	$&	ALPHA
+'^a(bc+|b[eh])g|.h$'i	ABH	y	$&-$1	BH-
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'(bc+d$|ef*g.|h?i(j|k))'i	IJ	y	$&-$1-$2	IJ-IJ-J
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFG	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	BCDD	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	REFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'((((((((((a))))))))))'i	A	y	$10	A
+'((((((((((a))))))))))\10'i	AA	y	$&	AA
+'((((((((((a))))))))))\41'i	AA	n	-	-
+'((((((((((a))))))))))\41'i	A!	y	$&	A!
+'(((((((((a)))))))))'i	A	y	$&	A
+'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i	A	y	$1	A
+'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i	C	y	$1	C
+'multiple words of text'i	UH-UH	n	-	-
+'multiple words'i	MULTIPLE WORDS, YEAH	y	$&	MULTIPLE WORDS
+'(.*)c(.*)'i	ABCDE	y	$&-$1-$2	ABCDE-AB-DE
+'\((.*), (.*)\)'i	(A, B)	y	($2, $1)	(B, A)
+'[k]'i	AB	n	-	-
+'abcd'i	ABCD	y	$&-\$&-\\$&	ABCD-$&-\ABCD
+'a(bc)d'i	ABCD	y	$1-\$1-\\$1	BC-$1-\BC
+'a[-]?c'i	AC	y	$&	AC
+'(abc)\1'i	ABCABC	y	$1	ABC
+'([a-c]*)\1'i	ABCABC	y	$1	ABC
+a(?!b).	abad	y	$&	ad
+a(?=d).	abad	y	$&	ad
+a(?=c|d).	abad	y	$&	ad
+a(?:b|c|d)(.)	ace	y	$1	e
+a(?:b|c|d)*(.)	ace	y	$1	e
+a(?:b|c|d)+?(.)	ace	y	$1	e
+a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
+^(.+)?B	AB	y	$1	A
diff --git a/gnu/usr.bin/perl/t/op/read.t b/gnu/usr.bin/perl/t/op/read.t
new file mode 100644
index 00000000000..2746970d157
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/read.t
@@ -0,0 +1,19 @@
+#!./perl
+
+# $RCSfile: read.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:17 $
+
+print "1..4\n";
+
+
+open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || die "Can't open op.read";
+seek(FOO,4,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 4 ? "ok 1\n" : "not ok 1\n");
+print ($buf eq "perl" ? "ok 2\n" : "not ok 2 :$buf:\n");
+
+seek (FOO,0,2) || seek(FOO,20000,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 0 ? "ok 3\n" : "not ok 3\n");
+print ($buf eq "" ? "ok 4\n" : "not ok 4\n");
diff --git a/gnu/usr.bin/perl/t/op/readdir.t b/gnu/usr.bin/perl/t/op/readdir.t
new file mode 100644
index 00000000000..1215f11c8a3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/readdir.t
@@ -0,0 +1,25 @@
+#!./perl
+
+eval 'opendir(NOSUCH, "no/such/directory");';
+if ($@) { print "1..0\n"; exit; }
+
+print "1..3\n";
+
+if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; }
+@D = grep(/^[^\.].*\.t$/i, readdir(OP));
+closedir(OP);
+
+if (@D > 20 && @D < 100) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+@R = sort @D;
+@G = <op/*.t>;
+if ($G[0] =~ m#.*\](\w+\.t)#i) {
+    # grep is to convert filespecs returned from glob under VMS to format
+    # identical to that returned by readdir
+    @G = grep(s#.*\](\w+\.t).*#op/$1#i,<op/*.t>);
+}
+while (@R && @G && "op/".$R[0] eq $G[0]) {
+	shift(@R);
+	shift(@G);
+}
+if (@R == 0 && @G == 0) { print "ok 3\n"; } else { print "not ok 3\n"; }
diff --git a/gnu/usr.bin/perl/t/op/ref.t b/gnu/usr.bin/perl/t/op/ref.t
new file mode 100644
index 00000000000..38e34f002b1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/ref.t
@@ -0,0 +1,203 @@
+#!./perl
+
+print "1..41\n";
+
+# Test glob operations.
+
+$bar = "ok 1\n";
+$foo = "ok 2\n";
+{
+    local(*foo) = *bar;
+    print $foo;
+}
+print $foo;
+
+$baz = "ok 3\n";
+$foo = "ok 4\n";
+{
+    local(*foo) = 'baz';
+    print $foo;
+}
+print $foo;
+
+$foo = "ok 6\n";
+{
+    local(*foo);
+    print $foo;
+    $foo = "ok 5\n";
+    print $foo;
+}
+print $foo;
+
+# Test fake references.
+
+$baz = "ok 7\n";
+$bar = 'baz';
+$foo = 'bar';
+print $$$foo;
+
+# Test real references.
+
+$FOO = \$BAR;
+$BAR = \$BAZ;
+$BAZ = "ok 8\n";
+print $$$FOO;
+
+# Test references to real arrays.
+
+@ary = (9,10,11,12);
+$ref[0] = \@a;
+$ref[1] = \@b;
+$ref[2] = \@c;
+$ref[3] = \@d;
+for $i (3,1,2,0) {
+    push(@{$ref[$i]}, "ok $ary[$i]\n");
+}
+print @a;
+print ${$ref[1]}[0];
+print @{$ref[2]}[0];
+print @{'d'};
+
+# Test references to references.
+
+$refref = \\$x;
+$x = "ok 13\n";
+print $$$refref;
+
+# Test nested anonymous lists.
+
+$ref = [[],2,[3,4,5,]];
+print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n";
+print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n";
+print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
+print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";
+
+print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
+print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 19\n";
+
+# Test references to hashes of references.
+
+$refref = \%whatever;
+$refref->{"key"} = $ref;
+print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n";
+
+# Test to see if anonymous subarrays spring into existence.
+
+$spring[5]->[0] = 123;
+$spring[5]->[1] = 456;
+push(@{$spring[5]}, 789);
+print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n";
+
+# Test to see if anonymous subhashes spring into existence.
+
+@{$spring2{"foo"}} = (1,2,3);
+$spring2{"foo"}->[3] = 4;
+print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n";
+
+# Test references to subroutines.
+
+sub mysub { print "ok 23\n" }
+$subref = \&mysub;
+&$subref;
+
+$subrefref = \\&mysub2;
+&$$subrefref("ok 24\n");
+sub mysub2 { print shift }
+
+# Test the ref operator.
+
+print ref $subref	eq CODE  ? "ok 25\n" : "not ok 25\n";
+print ref $ref		eq ARRAY ? "ok 26\n" : "not ok 26\n";
+print ref $refref	eq HASH  ? "ok 27\n" : "not ok 27\n";
+
+# Test anonymous hash syntax.
+
+$anonhash = {};
+print ref $anonhash	eq HASH  ? "ok 28\n" : "not ok 28\n";
+$anonhash2 = {FOO => BAR, ABC => XYZ,};
+print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n";
+
+# Test bless operator.
+
+package MYHASH;
+
+$object = bless $main'anonhash2;
+print ref $object	eq MYHASH  ? "ok 30\n" : "not ok 30\n";
+print $object->{ABC}	eq XYZ     ? "ok 31\n" : "not ok 31\n";
+
+$object2 = bless {};
+print ref $object2	eq MYHASH  ? "ok 32\n" : "not ok 32\n";
+
+# Test ordinary call on object method.
+
+&mymethod($object,33);
+
+sub mymethod {
+    local($THIS, @ARGS) = @_;
+    die 'Got a "' . ref($THIS). '" instead of a MYHASH'
+	unless ref $THIS eq MYHASH;
+    print $THIS->{FOO} eq BAR  ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n";
+}
+
+# Test automatic destructor call.
+
+$string = "not ok 34\n";
+$object = "foo";
+$string = "ok 34\n";
+$main'anonhash2 = "foo";
+$string = "";
+
+DESTROY {
+    return unless $string;
+    print $string;
+
+    # Test that the object has not already been "cursed".
+    print ref shift ne HASH ? "ok 35\n" : "not ok 35\n";
+}
+
+# Now test inheritance of methods.
+
+package OBJ;
+
+@ISA = (BASEOBJ);
+
+$main'object = bless {FOO => foo, BAR => bar};
+
+package main;
+
+# Test arrow-style method invocation.
+
+print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n";
+
+# Test indirect-object-style method invocation.
+
+$foo = doit $object "FOO";
+print $foo eq foo ? "ok 37\n" : "not ok 37\n";
+
+sub BASEOBJ'doit {
+    local $ref = shift;
+    die "Not an OBJ" unless ref $ref eq OBJ;
+    $ref->{shift()};
+}
+
+package UNIVERSAL;
+@ISA = 'LASTCHANCE';
+
+package LASTCHANCE;
+sub foo { print $_[1] }
+
+package WHATEVER;
+foo WHATEVER "ok 38\n";
+
+package FINALE;
+
+{
+    $ref3 = bless ["ok 41\n"];		# package destruction
+    my $ref2 = bless ["ok 40\n"];	# lexical destruction
+    local $ref1 = bless ["ok 39\n"];	# dynamic destruction
+    1;					# flush any temp values on stack
+}
+
+DESTROY {
+    print $_[0][0];
+}
diff --git a/gnu/usr.bin/perl/t/op/regexp.t b/gnu/usr.bin/perl/t/op/regexp.t
new file mode 100644
index 00000000000..2ef6791110e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/regexp.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $RCSfile: regexp.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:22 $
+
+open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
+    || die "Can't open re_tests";
+while (<TESTS>) { }
+$numtests = $.;
+close(TESTS);
+
+print "1..$numtests\n";
+open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
+    || die "Can't open re_tests";
+$| = 1;
+while (<TESTS>) {
+    ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
+    $input = join(':',$pat,$subject,$result,$repl,$expect);
+    $pat = "'$pat'" unless $pat =~ /^'/;
+    eval "\$match = (\$subject =~ m$pat); \$got = \"$repl\";";
+    if ($result eq 'c') {
+	if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";}
+    }
+    elsif ($result eq 'n') {
+	if (!$match) {print "ok $.\n";} else {print "not ok $. $input => $got\n";}
+    }
+    else {
+	if ($match && $got eq $expect) {
+	    print "ok $.\n";
+	}
+	else {
+	    print "not ok $. $input => $got\n";
+	}
+    }
+}
+close(TESTS);
diff --git a/gnu/usr.bin/perl/t/op/repeat.t b/gnu/usr.bin/perl/t/op/repeat.t
new file mode 100644
index 00000000000..54fa590836f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/repeat.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
+
+print "1..19\n";
+
+# compile time
+
+if ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";}
+if ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";}
+if ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";}
+
+if ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";}
+
+# run time
+
+$a = '-';
+if ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";}
+if ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";}
+if ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";}
+
+$a = 'ab';
+if ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";}
+
+$a = 'xyz';
+$a x= 2;
+if ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";}
+$a x= 1;
+if ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";}
+$a x= 0;
+if ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";}
+
+@x = (1,2,3);
+
+print join('', @x x 4) eq '3333' ? "ok 12\n" : "not ok 12\n";
+print join('', (@x) x 4) eq '123123123123' ? "ok 13\n" : "not ok 13\n";
+print join('', (@x,()) x 4) eq '123123123123' ? "ok 14\n" : "not ok 14\n";
+print join('', (@x,1) x 4) eq '1231123112311231' ? "ok 15\n" : "not ok 15\n";
+print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n";
+print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n";
+print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n";
+print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n";
diff --git a/gnu/usr.bin/perl/t/op/sleep.t b/gnu/usr.bin/perl/t/op/sleep.t
new file mode 100644
index 00000000000..07cdb826d18
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/sleep.t
@@ -0,0 +1,8 @@
+#!./perl
+
+# $RCSfile: sleep.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:23 $
+
+print "1..1\n";
+
+$x = sleep 2;
+if ($x >= 2 && $x <= 10) {print "ok 1\n";} else {print "not ok 1 $x\n";}
diff --git a/gnu/usr.bin/perl/t/op/sort.t b/gnu/usr.bin/perl/t/op/sort.t
new file mode 100644
index 00000000000..dc01e5f11dd
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/sort.t
@@ -0,0 +1,48 @@
+#!./perl
+
+# $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
+
+print "1..10\n";
+
+sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
+
+@harry = ('dog','cat','x','Cain','Abel');
+@george = ('gone','chased','yz','Punished','Axed');
+
+$x = join('', sort @harry);
+print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
+
+$x = join('', sort( backwards @harry));
+print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
+
+$x = join('', sort @george, 'to', @harry);
+print ($x eq 'AbelAxedCainPunishedcatchaseddoggonetoxyz'?"ok 3\n":"not ok 3\n");
+
+@a = ();
+@b = reverse @a;
+print ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n");
+
+@a = (1);
+@b = reverse @a;
+print ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n");
+
+@a = (1,2);
+@b = reverse @a;
+print ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n");
+
+@a = (1,2,3);
+@b = reverse @a;
+print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
+
+@a = (1,2,3,4);
+@b = reverse @a;
+print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
+
+@a = (10,2,3,4);
+@b = sort {$a <=> $b;} @a;
+print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
+
+$sub = 'backwards';
+$x = join('', sort $sub @harry);
+print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n");
+
diff --git a/gnu/usr.bin/perl/t/op/split.t b/gnu/usr.bin/perl/t/op/split.t
new file mode 100644
index 00000000000..23545308179
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/split.t
@@ -0,0 +1,60 @@
+#!./perl
+
+# $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
+
+print "1..12\n";
+
+$FS = ':';
+
+$_ = 'a:b:c';
+
+($a,$b,$c) = split($FS,$_);
+
+if (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
+
+@ary = split(/:b:/);
+if (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = "abc\n";
+@xyz = (@ary = split(//));
+if (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
+
+$_ = "a:b:c::::";
+@ary = split(/:/);
+if (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
+
+$_ = join(':',split(' ',"    a b\tc \t d "));
+if ($_ eq 'a:b:c:d') {print "ok 5\n";} else {print "not ok 5 #$_#\n";}
+
+$_ = join(':',split(/ */,"foo  bar bie\tdoll"));
+if ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
+	{print "ok 6\n";} else {print "not ok 6\n";}
+
+$_ = join(':', 'foo', split(/ /,'a b  c'), 'bar');
+if ($_ eq "foo:a:b::c:bar") {print "ok 7\n";} else {print "not ok 7 $_\n";}
+
+# Can we say how many fields to split to?
+$_ = join(':', split(' ','1 2 3 4 5 6', 3));
+print $_ eq '1:2:3 4 5 6' ? "ok 8\n" : "not ok 8 $_\n";
+
+# Can we do it as a variable?
+$x = 4;
+$_ = join(':', split(' ','1 2 3 4 5 6', $x));
+print $_ eq '1:2:3:4 5 6' ? "ok 9\n" : "not ok 9 $_\n";
+
+# Does the 999 suppress null field chopping?
+$_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
+print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
+
+# Does assignment to a list imply split to one more field than that?
+$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
+if ($foo =~ /DCL-W-NOCOMD/) {
+  $foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`;
+}
+print $foo =~ /DEBUGGING/ || $foo =~ /SV = IV\(3\)/ ? "ok 11\n" : "not ok 11\n";
+
+# Can we say how many fields to split to when assigning to a list?
+($a,$b) = split(' ','1 2 3 4 5 6', 2);
+$_ = join(':',$a,$b);
+print $_ eq '1:2 3 4 5 6' ? "ok 12\n" : "not ok 12 $_\n";
+
diff --git a/gnu/usr.bin/perl/t/op/sprintf.t b/gnu/usr.bin/perl/t/op/sprintf.t
new file mode 100644
index 00000000000..8e1ef6958f2
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/sprintf.t
@@ -0,0 +1,8 @@
+#!./perl
+
+# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $
+
+print "1..1\n";
+
+$x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999);
+if ($x eq ' hi 123 %foo   456A3.1') {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
diff --git a/gnu/usr.bin/perl/t/op/stat.t b/gnu/usr.bin/perl/t/op/stat.t
new file mode 100644
index 00000000000..0ec31689cd6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/stat.t
@@ -0,0 +1,186 @@
+#!./perl
+
+# $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
+# 950521 DFD    This version hacked to make test 39 succeed on MachTen
+#               though the O.S. wrongly thinks /dev/null is a terminal
+print "1..56\n";
+
+chop($cwd = `pwd`);
+
+$DEV = `ls -l /dev`;
+
+unlink "Op.stat.tmp";
+open(FOO, ">Op.stat.tmp");
+
+$junk = `ls Op.stat.tmp`;	# hack to make Apollo update link count
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat(FOO);
+if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
+
+print FOO "Now is the time for all good men to come to.\n";
+close(FOO);
+
+sleep 2;
+
+`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('Op.stat.tmp');
+
+if ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
+if (($mtime && $mtime != $ctime) || $cwd =~ m#/afs/#) {
+    print "ok 4\n";
+}
+else {
+    print "not ok 4\n";
+    print '#4 If test op/stat.t fails test 4, check if you are on a tmpfs';
+    print '#4 of some sort.  Building in /tmp sometimes has this problem.';
+}
+print "#4	:$mtime: != :$ctime:\n";
+
+`rm -f Op.stat.tmp`;
+`touch Op.stat.tmp`;
+
+if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
+if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
+
+`echo hi >Op.stat.tmp`;
+if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
+if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
+
+unlink 'Op.stat.tmp';
+$olduid = $>;		# can't test -r if uid == 0
+`echo hi >Op.stat.tmp`;
+chmod 0,'Op.stat.tmp';
+eval '$> = 1;';		# so switch uid (may not be implemented)
+if (!$> || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
+if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
+eval '$> = $olduid;';		# switch uid back (may not be implemented)
+print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
+if (! -x 'Op.stat.tmp') {print "ok 11\n";} else {print "not ok 11\n";}
+
+foreach ((12,13,14,15,16,17)) {
+    print "ok $_\n";		#deleted tests
+}
+
+chmod 0700,'Op.stat.tmp';
+if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
+if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
+if (-x 'Op.stat.tmp') {print "ok 20\n";} else {print "not ok 20\n";}
+
+if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
+if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
+if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
+
+if (`ls -l perl` =~ /^l.*->/) {
+    if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
+}
+else {
+    print "ok 25\n";
+}
+
+if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
+
+if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
+`rm -f Op.stat.tmp Op.stat.tmp2`;
+if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
+
+if ($DEV !~ /\nc.* (\S+)\n/)
+    {print "ok 29\n";}
+elsif (-c "/dev/$1")
+    {print "ok 29\n";}
+else
+    {print "not ok 29\n";}
+if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
+
+if ($DEV !~ /\ns.* (\S+)\n/)
+    {print "ok 31\n";}
+elsif (-S "/dev/$1")
+    {print "ok 31\n";}
+else
+    {print "not ok 31\n";}
+if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
+
+if ($DEV !~ /\nb.* (\S+)\n/)
+    {print "ok 33\n";}
+elsif (-b "/dev/$1")
+    {print "ok 33\n";}
+else
+    {print "not ok 33\n";}
+if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
+
+$cnt = $uid = 0;
+
+die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
+print ("not ok 35\n"), goto tty_test unless -d '/usr/bin';
+chdir '/usr/bin' || die "Can't cd to /usr/bin";
+while (defined($_ = <*>)) {
+    $cnt++;
+    $uid++ if -u;
+    last if $uid && $uid < $cnt;
+}
+chdir $cwd || die "Can't cd back to $cwd";
+
+# I suppose this is going to fail somewhere...
+if ($uid > 0 && $uid < $cnt)
+    {print "ok 35\n";}
+else
+    {print "not ok 35 \n# ($uid $cnt)\n";}
+
+tty_test:
+
+unless (open(tty,"/dev/tty")) {
+    print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
+}
+if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
+if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
+close(tty);
+if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
+open(null,"/dev/null");
+if (! -t null || -e '/xenix' || -e '/MachTen')
+	{print "ok 39\n";} else {print "not ok 39\n";}
+close(null);
+if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
+
+# These aren't strictly "stat" calls, but so what?
+
+if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
+if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
+
+if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
+if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
+
+open(FOO,'op/stat.t');
+eval { -T FOO; };
+if ($@ =~ /not implemented/) {
+    print "# $@";
+    for (45 .. 54) {
+	print "ok $_\n";
+    }
+}
+else {
+    if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
+    if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
+    $_ = <FOO>;
+    if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
+    if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
+    if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
+    close(FOO);
+
+    open(FOO,'op/stat.t');
+    $_ = <FOO>;
+    if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
+    if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
+    if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
+    seek(FOO,0,0);
+    if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
+    if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
+}
+close(FOO);
+
+if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
+if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
diff --git a/gnu/usr.bin/perl/t/op/study.t b/gnu/usr.bin/perl/t/op/study.t
new file mode 100644
index 00000000000..ea3b366f0bc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/study.t
@@ -0,0 +1,69 @@
+#!./perl
+
+# $RCSfile: study.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:30 $
+
+print "1..24\n";
+
+$x = "abc\ndef\n";
+study($x);
+
+if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$* = 1;
+if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
+$* = 0;
+
+$_ = '123';
+study;
+if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
+if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+
+if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+
+study($x);
+if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+
+if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+
+$_ = 'aaabbbccc';
+study;
+if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
+	print "ok 13\n";
+} else {
+	print "not ok 13\n";
+}
+if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
+	print "ok 14\n";
+} else {
+	print "not ok 14\n";
+}
+
+if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+
+$_ = 'aaabccc';
+study;
+if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
+if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+
+$_ = 'aaaccc';
+study;
+if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
+if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+
+$_ = 'abcdef';
+study;
+if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
+if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
+
+if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$* = 1;		# test 3 only tested the optimized version--this one is for real
+if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
diff --git a/gnu/usr.bin/perl/t/op/subst.t b/gnu/usr.bin/perl/t/op/subst.t
new file mode 100644
index 00000000000..f80f807948c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/subst.t
@@ -0,0 +1,200 @@
+#!./perl
+
+# $RCSfile: subst.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:23 $
+
+print "1..56\n";
+
+$x = 'foo';
+$_ = "x";
+s/x/\$x/;
+print "#1\t:$_: eq :\$x:\n";
+if ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$_ = "x";
+s/x/$x/;
+print "#2\t:$_: eq :foo:\n";
+if ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = "x";
+s/x/\$x $x/;
+print "#3\t:$_: eq :\$x foo:\n";
+if ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
+
+$b = 'cd';
+($a = 'abcdef') =~ s<(b${b}e)>'\n$1';
+print "#4\t:$1: eq :bcde:\n";
+print "#4\t:$a: eq :a\\n\$1f:\n";
+if ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$a = 'abacada';
+if (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
+    {print "ok 5\n";} else {print "not ok 5\n";}
+
+if (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
+    {print "ok 6\n";} else {print "not ok 6 $a\n";}
+
+if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
+    {print "ok 7\n";} else {print "not ok 7 $a\n";}
+
+$_ = 'ABACADA';
+if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
+
+$_ = '\\' x 4;
+if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
+s/\\/\\\\/g;
+if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
+
+$_ = '\/' x 4;
+if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
+s/\//\/\//g;
+if ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
+if (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
+
+$_ = 'aaaXXXXbbb';
+s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
+
+$_ = 'aaaXXXXbbb';
+s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
+
+$_ = 'aaaXXXXbbb';
+s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
+
+$_ = 'aaaXXXXbbb';
+s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
+
+$_ = 'aaaXXXXbbb';
+s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
+
+$_ = 'aaaXXXXbbb';
+s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
+
+$_ = 'aaaXXXXbbb';
+s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
+
+$_ = 'aaaXXXXbbb';
+s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
+
+$_ = 'aaaXXXXbbb';
+s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
+
+# now for some unoptimized versions of the same.
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
+
+$_ = 'abc123xyz';
+s/\d+/$&*2/e;              # yields 'abc246xyz'
+print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
+s/\d+/sprintf("%5d",$&)/e; # yields 'abc  246xyz'
+print $_ eq 'abc  246xyz' ? "ok 41\n" : "not ok 41\n";
+s/\w/$& x 2/eg;            # yields 'aabbcc  224466xxyyzz'
+print $_ eq 'aabbcc  224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
+
+$_ = "aaaaa";
+print y/a/b/ == 5 ? "ok 43\n" : "not ok 43\n";
+print y/a/b/ == 0 ? "ok 44\n" : "not ok 44\n";
+print y/b// == 5 ? "ok 45\n" : "not ok 45\n";
+print y/b/c/s == 5 ? "ok 46\n" : "not ok 46\n";
+print y/c// == 1 ? "ok 47\n" : "not ok 47\n";
+print y/c//d == 1 ? "ok 48\n" : "not ok 48\n";
+print $_ eq "" ? "ok 49\n" : "not ok 49\n";
+
+$_ = "Now is the %#*! time for all good men...";
+print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n");
+print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n";
+
+$_ = 'abcdefghijklmnopqrstuvwxyz0123456789';
+tr/a-z/A-Z/;
+
+print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
+
+# same as tr/A-Z/a-z/;
+y[\101-\132][\141-\172];
+
+print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
+
+$_ = '+,-';
+tr/+--/a-c/;
+print $_ eq 'abc' ? "ok 54\n" : "not ok 54\n";
+
+$_ = '+,-';
+tr/+\--/a\/c/;
+print $_ eq 'a,/' ? "ok 55\n" : "not ok 55\n";
+
+$_ = '+,-';
+tr/-+,/ab\-/;
+print $_ eq 'b-a' ? "ok 56\n" : "not ok 56\n";
diff --git a/gnu/usr.bin/perl/t/op/substr.t b/gnu/usr.bin/perl/t/op/substr.t
new file mode 100644
index 00000000000..240b51f98ed
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/substr.t
@@ -0,0 +1,47 @@
+#!./perl
+
+# $RCSfile: substr.t,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:23 $
+
+print "1..22\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
+print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
+print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n");
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
+
+$[ = 1;
+
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
+print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
+print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
+
+$[ = 0;
+
+substr($a,3,3) = 'XYZ';
+print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+substr($a,0,2) = '';
+print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+y/a/a/;
+substr($a,0,0) = 'ab';
+print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+substr($a,0,0) = '12345678';
+print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+substr($a,-3,3) = 'def';
+print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+substr($a,-3,3) = '<';
+print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+substr($a,-1,1) = '12345678';
+print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");
+print (substr($a,999) eq '' ? "ok 22\n" : "not ok 22\n");
diff --git a/gnu/usr.bin/perl/t/op/time.t b/gnu/usr.bin/perl/t/op/time.t
new file mode 100644
index 00000000000..1bec442fe2e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/time.t
@@ -0,0 +1,47 @@
+#!./perl
+
+# $RCSfile: time.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:32 $
+
+if ($does_gmtime = gmtime(time)) { print "1..5\n" }
+else { print "1..3\n" }
+
+($beguser,$begsys) = times;
+
+$beg = time;
+
+while (($now = time) == $beg) { sleep 1 }
+
+if ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";}
+
+for ($i = 0; $i < 100000; $i++) {
+    ($nowuser, $nowsys) = times;
+    $i = 200000 if $nowuser > $beguser && ( $nowsys > $begsys || 
+                                            (!$nowsys && !$begsys));
+    last if time - $beg > 20;
+}
+
+if ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";}
+
+($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg);
+($xsec,$foo) = localtime($now);
+$localyday = $yday;
+
+if ($sec != $xsec && $mday && $year)
+    {print "ok 3\n";}
+else
+    {print "not ok 3\n";}
+
+exit 0 unless $does_gmtime;
+
+($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
+($xsec,$foo) = localtime($now);
+
+if ($sec != $xsec && $mday && $year)
+    {print "ok 4\n";}
+else
+    {print "not ok 4\n";}
+
+if (index(" :0:1:-1:364:365:-364:-365:",':' . ($localyday - $yday) . ':') > 0)
+    {print "ok 5\n";}
+else
+    {print "not ok 5\n";}
diff --git a/gnu/usr.bin/perl/t/op/undef.t b/gnu/usr.bin/perl/t/op/undef.t
new file mode 100644
index 00000000000..8ab2ec421f3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/undef.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
+
+print "1..21\n";
+
+print defined($a) ? "not ok 1\n" : "ok 1\n";
+
+$a = 1+1;
+print defined($a) ? "ok 2\n" : "not ok 2\n";
+
+undef $a;
+print defined($a) ? "not ok 3\n" : "ok 3\n";
+
+$a = "hi";
+print defined($a) ? "ok 4\n" : "not ok 4\n";
+
+$a = $b;
+print defined($a) ? "not ok 5\n" : "ok 5\n";
+
+@ary = ("1arg");
+$a = pop(@ary);
+print defined($a) ? "ok 6\n" : "not ok 6\n";
+$a = pop(@ary);
+print defined($a) ? "not ok 7\n" : "ok 7\n";
+
+@ary = ("1arg");
+$a = shift(@ary);
+print defined($a) ? "ok 8\n" : "not ok 8\n";
+$a = shift(@ary);
+print defined($a) ? "not ok 9\n" : "ok 9\n";
+
+$ary{'foo'} = 'hi';
+print defined($ary{'foo'}) ? "ok 10\n" : "not ok 10\n";
+print defined($ary{'bar'}) ? "not ok 11\n" : "ok 11\n";
+undef $ary{'foo'};
+print defined($ary{'foo'}) ? "not ok 12\n" : "ok 12\n";
+
+print defined(@ary) ? "ok 13\n" : "not ok 13\n";
+print defined(%ary) ? "ok 14\n" : "not ok 14\n";
+undef @ary;
+print defined(@ary) ? "not ok 15\n" : "ok 15\n";
+undef %ary;
+print defined(%ary) ? "not ok 16\n" : "ok 16\n";
+@ary = (1);
+print defined @ary ? "ok 17\n" : "not ok 17\n";
+%ary = (1,1);
+print defined %ary ? "ok 18\n" : "not ok 18\n";
+
+sub foo { print "ok 19\n"; }
+
+&foo || print "not ok 19\n";
+
+print defined &foo ? "ok 20\n" : "not ok 20\n";
+undef &foo;
+print defined(&foo) ? "not ok 21\n" : "ok 21\n";
diff --git a/gnu/usr.bin/perl/t/op/unshift.t b/gnu/usr.bin/perl/t/op/unshift.t
new file mode 100644
index 00000000000..68d37756bd6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/unshift.t
@@ -0,0 +1,14 @@
+#!./perl
+
+# $RCSfile: unshift.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:35 $
+
+print "1..2\n";
+
+@a = (1,2,3);
+$cnt1 = unshift(a,0);
+
+if (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";}
+$cnt2 = unshift(a,3,2,1);
+if (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";}
+
+
diff --git a/gnu/usr.bin/perl/t/op/vec.t b/gnu/usr.bin/perl/t/op/vec.t
new file mode 100644
index 00000000000..97b6d60989e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/vec.t
@@ -0,0 +1,24 @@
+#!./perl
+
+# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $
+
+print "1..13\n";
+
+print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
+print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
+vec($foo,0,1) = 1;
+print length($foo) == 1 ? "ok 3\n" : "not ok 3\n";
+print ord($foo) == 1 ? "ok 4\n" : "not ok 4\n";
+print vec($foo,0,1) == 1 ? "ok 5\n" : "not ok 5\n";
+
+print vec($foo,20,1) == 0 ? "ok 6\n" : "not ok 6\n";
+vec($foo,20,1) = 1;
+print vec($foo,20,1) == 1 ? "ok 7\n" : "not ok 7\n";
+print length($foo) == 3 ? "ok 8\n" : "not ok 8\n";
+print vec($foo,1,8) == 0 ? "ok 9\n" : "not ok 9\n";
+vec($foo,1,8) = 0xf1;
+print vec($foo,1,8) == 0xf1 ? "ok 10\n" : "not ok 10\n";
+print ((ord(substr($foo,1,1)) & 255) == 0xf1 ? "ok 11\n" : "not ok 11\n");
+print vec($foo,2,4) == 1 ? "ok 12\n" : "not ok 12\n";
+print vec($foo,3,4) == 15 ? "ok 13\n" : "not ok 13\n";
+
diff --git a/gnu/usr.bin/perl/t/op/write.t b/gnu/usr.bin/perl/t/op/write.t
new file mode 100644
index 00000000000..d14cef3cd64
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/write.t
@@ -0,0 +1,135 @@
+#!./perl
+
+# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
+
+print "1..3\n";
+
+format OUT =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<<
+$foo
+^<<<<<<<<<
+$foo
+^<<<<<<...
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+{
+    'i' . 's', "time\n", $good, 'to'
+}
+.
+
+open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT);
+close OUT;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of huma...
+now is the time for all good men to come to\n";
+
+if (`cat Op_write.tmp` eq $right)
+    { print "ok 1\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 1\n"; }
+
+$fox = 'wolfishness';
+my $fox = 'foxiness';		# Test a lexical variable.
+
+format OUT2 =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+
+open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp";
+
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`cat Op_write.tmp` eq $right)
+    { print "ok 2\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 2\n"; }
+
+eval <<'EOFORMAT';
+format OUT2 =
+the brown quick @<<
+$fox
+jumped
+@*
+$multiline
+and
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+EOFORMAT
+
+open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the brown quick fox
+jumped
+forescore
+and
+seven years
+and
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`cat Op_write.tmp` eq $right)
+    { print "ok 3\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 3\n"; }
+
diff --git a/gnu/usr.bin/perl/t/re_tests b/gnu/usr.bin/perl/t/re_tests
new file mode 100644
index 00000000000..2ac666ab382
--- /dev/null
+++ b/gnu/usr.bin/perl/t/re_tests
@@ -0,0 +1,3 @@
+a.+?c	abcabc	y	$&	abc
+(a+|b)*	ab	y	$&-$1	ab-b
+(a+|b){0,}	ab	y	$&-$1	ab-b
diff --git a/gnu/usr.bin/perl/taint.c b/gnu/usr.bin/perl/taint.c
new file mode 100644
index 00000000000..6c64b39fc77
--- /dev/null
+++ b/gnu/usr.bin/perl/taint.c
@@ -0,0 +1,71 @@
+/*
+ * "...we will have peace, when you and all your works have perished--and
+ * the works of your dark master to whom you would deliver us.  You are a
+ * liar, Saruman, and a corrupter of men's hearts."  --Theoden
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+void
+taint_not(s)
+char *s;
+{
+    if (euid != uid)
+        croak("No %s allowed while running setuid", s);
+    if (egid != gid)
+        croak("No %s allowed while running setgid", s);
+}
+
+void
+taint_proper(f, s)
+char *f;
+char *s;
+{
+    if (tainting) {
+	DEBUG_u(fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid));
+	if (tainted) {
+	    char *ug = 0;
+	    if (euid != uid)
+		ug = " while running setuid";
+	    else if (egid != gid)
+		ug = " while running setgid";
+	    else if (tainting)
+		ug = " while running with -T switch";
+	    if (ug) {
+		if (!unsafe)
+		    croak(f, s, ug);
+		else if (dowarn)
+		    warn(f, s, ug);
+	    }
+	}
+    }
+}
+
+void
+taint_env()
+{
+    SV** svp;
+
+    if (tainting) {
+	MAGIC *mg = 0;
+	svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE);
+	if (!svp || *svp == &sv_undef ||
+	  ((mg = mg_find(*svp, 't')) && mg->mg_len & 1))
+	{
+	    tainted = TRUE;
+	    if (mg && MgTAINTEDDIR(mg))
+		taint_proper("Insecure directory in %s%s", "$ENV{PATH}");
+	    else
+		taint_proper("Insecure %s%s", "$ENV{PATH}");
+	}
+	svp = hv_fetch(GvHVn(envgv),"IFS",3,FALSE);
+	if (svp && *svp != &sv_undef &&
+	  (mg = mg_find(*svp, 't')) && mg->mg_len & 1)
+	{
+	    tainted = TRUE;
+	    taint_proper("Insecure %s%s", "$ENV{IFS}");
+	}
+    }
+}
+
diff --git a/gnu/usr.bin/perl/tmp b/gnu/usr.bin/perl/tmp
new file mode 100644
index 00000000000..5c9b0d57294
--- /dev/null
+++ b/gnu/usr.bin/perl/tmp
@@ -0,0 +1,72 @@
+/*
+ * "The Road goes ever on and on, down from the door where it began."
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#ifdef __cplusplus
+}
+#  define EXTERN_C extern "C"
+#else
+#  define EXTERN_C extern
+#endif
+
+static void xs_init _((void));
+static PerlInterpreter *my_perl;
+
+int
+#ifdef CAN_PROTOTYPE
+main(int argc, char **argv, char **env)
+#else
+main(argc, argv, env)
+int argc;
+char **argv;
+char **env;
+#endif
+{
+    int exitstatus;
+
+    PERL_SYS_INIT(&argc,&argv);
+
+    perl_init_i18nl14n(1);
+
+    if (!do_undump) {
+	my_perl = perl_alloc();
+	if (!my_perl)
+	    exit(1);
+	perl_construct( my_perl );
+    }
+
+    exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
+    if (exitstatus)
+	exit( exitstatus );
+
+    exitstatus = perl_run( my_perl );
+
+    perl_destruct( my_perl );
+    perl_free( my_perl );
+
+    PERL_SYS_TERM();
+
+    exit( exitstatus );
+}
+
+/* Register any extra external extensions */
+
+/* Do not delete this line--writemain depends on it */
+EXTERN_C void boot_DynaLoader _((CV* cv));
+
+static void
+xs_init()
+{
+  dXSUB_SYS;
+    char *file = __FILE__;
+    {
+        newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+    }
+}
diff --git a/gnu/usr.bin/perl/toke.c b/gnu/usr.bin/perl/toke.c
new file mode 100644
index 00000000000..5a43c097b5c
--- /dev/null
+++ b/gnu/usr.bin/perl/toke.c
@@ -0,0 +1,5001 @@
+/*    toke.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ *   "It all comes from here, the stench and the peril."  --Frodo
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+static void check_uni _((void));
+static void  force_next _((I32 type));
+static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
+static SV *q _((SV *sv));
+static char *scan_const _((char *start));
+static char *scan_formline _((char *s));
+static char *scan_heredoc _((char *s));
+static char *scan_ident _((char *s, char *send, char *dest, I32 ck_uni));
+static char *scan_inputsymbol _((char *start));
+static char *scan_pat _((char *start));
+static char *scan_str _((char *start));
+static char *scan_subst _((char *start));
+static char *scan_trans _((char *start));
+static char *scan_word _((char *s, char *dest, int allow_package, STRLEN *slp));
+static char *skipspace _((char *s));
+static void checkcomma _((char *s, char *name, char *what));
+static void force_ident _((char *s, int kind));
+static void incline _((char *s));
+static int intuit_method _((char *s, GV *gv));
+static int intuit_more _((char *s));
+static I32 lop _((I32 f, expectation x, char *s));
+static void missingterm _((char *s));
+static void no_op _((char *what, char *s));
+static void set_csh _((void));
+static I32 sublex_done _((void));
+static I32 sublex_start _((void));
+#ifdef CRIPPLED_CC
+static int uni _((I32 f, char *s));
+#endif
+static char * filter_gets _((SV *sv, FILE *fp));
+static void restore_rsfp _((void *f));
+
+/* The following are arranged oddly so that the guard on the switch statement
+ * can get by with a single comparison (if the compiler is smart enough).
+ */
+
+#define LEX_NORMAL		9
+#define LEX_INTERPNORMAL	8
+#define LEX_INTERPCASEMOD	7
+#define LEX_INTERPSTART		6
+#define LEX_INTERPEND		5
+#define LEX_INTERPENDMAYBE	4
+#define LEX_INTERPCONCAT	3
+#define LEX_INTERPCONST		2
+#define LEX_FORMLINE		1
+#define LEX_KNOWNEXT		0
+
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
+#ifdef ff_next
+#undef ff_next
+#endif
+
+#include "keywords.h"
+
+#ifdef CLINE
+#undef CLINE
+#endif
+#define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
+
+#define TOKEN(retval) return (bufptr = s,(int)retval)
+#define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
+#define AOPERATOR(retval) return ao((expect = XTERM,bufptr = s,(int)retval))
+#define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
+#define PRETERMBLOCK(retval) return (expect = XTERMBLOCK,bufptr = s,(int)retval)
+#define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
+#define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
+#define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX)
+#define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
+#define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
+#define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
+#define BOop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP))
+#define BAop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP))
+#define SHop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP))
+#define PWop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP))
+#define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
+#define Aop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP))
+#define Mop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP))
+#define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
+#define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
+
+/* This bit of chicanery makes a unary function followed by
+ * a parenthesis into a function with one argument, highest precedence.
+ */
+#define UNI(f) return(yylval.ival = f, \
+	expect = XTERM, \
+	bufptr = s, \
+	last_uni = oldbufptr, \
+	last_lop_op = f, \
+	(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+#define UNIBRACK(f) return(yylval.ival = f, \
+	bufptr = s, \
+	last_uni = oldbufptr, \
+	(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+
+/* grandfather return to old style */
+#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
+
+static int
+ao(toketype)
+int toketype;
+{
+    if (*bufptr == '=') {
+	bufptr++;
+	if (toketype == ANDAND)
+	    yylval.ival = OP_ANDASSIGN;
+	else if (toketype == OROR)
+	    yylval.ival = OP_ORASSIGN;
+	toketype = ASSIGNOP;
+    }
+    return toketype;
+}
+
+static void
+no_op(what, s)
+char *what;
+char *s;
+{
+    char tmpbuf[128];
+    char *oldbp = bufptr;
+    bool is_first = (oldbufptr == SvPVX(linestr));
+    bufptr = s;
+    sprintf(tmpbuf, "%s found where operator expected", what);
+    yywarn(tmpbuf);
+    if (is_first)
+	warn("\t(Missing semicolon on previous line?)\n");
+    else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) {
+	char *t;
+	for (t = oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
+	if (t < bufptr && isSPACE(*t))
+	    warn("\t(Do you need to predeclare %.*s?)\n",
+		t - oldoldbufptr, oldoldbufptr);
+
+    }
+    else
+	warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
+    bufptr = oldbp;
+}
+
+static void
+missingterm(s)
+char *s;
+{
+    char tmpbuf[3];
+    char q;
+    if (s) {
+	char *nl = strrchr(s,'\n');
+	if (nl)
+	    *nl = '\0';
+    }
+    else if (multi_close < 32 || multi_close == 127) {
+	*tmpbuf = '^';
+	tmpbuf[1] = multi_close ^ 64;
+	s = "\\n";
+	tmpbuf[2] = '\0';
+	s = tmpbuf;
+    }
+    else {
+	*tmpbuf = multi_close;
+	tmpbuf[1] = '\0';
+	s = tmpbuf;
+    }
+    q = strchr(s,'"') ? '\'' : '"';
+    croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
+}
+
+void
+deprecate(s)
+char *s;
+{
+    if (dowarn)
+	warn("Use of %s is deprecated", s);
+}
+
+static void
+depcom()
+{
+    deprecate("comma-less variable list");
+}
+
+void
+lex_start(line)
+SV *line;
+{
+    char *s;
+    STRLEN len;
+
+    SAVEINT(lex_dojoin);
+    SAVEINT(lex_brackets);
+    SAVEINT(lex_fakebrack);
+    SAVEINT(lex_casemods);
+    SAVEINT(lex_starts);
+    SAVEINT(lex_state);
+    SAVESPTR(lex_inpat);
+    SAVEINT(lex_inwhat);
+    SAVEINT(curcop->cop_line);
+    SAVEPPTR(bufptr);
+    SAVEPPTR(bufend);
+    SAVEPPTR(oldbufptr);
+    SAVEPPTR(oldoldbufptr);
+    SAVESPTR(linestr);
+    SAVEPPTR(lex_brackstack);
+    SAVEPPTR(lex_casestack);
+    SAVEDESTRUCTOR(restore_rsfp, rsfp);
+
+    lex_state = LEX_NORMAL;
+    lex_defer = 0;
+    expect = XSTATE;
+    lex_brackets = 0;
+    lex_fakebrack = 0;
+    New(899, lex_brackstack, 120, char);
+    New(899, lex_casestack, 12, char);
+    SAVEFREEPV(lex_brackstack);
+    SAVEFREEPV(lex_casestack);
+    lex_casemods = 0;
+    *lex_casestack = '\0';
+    lex_dojoin = 0;
+    lex_starts = 0;
+    if (lex_stuff)
+	SvREFCNT_dec(lex_stuff);
+    lex_stuff = Nullsv;
+    if (lex_repl)
+	SvREFCNT_dec(lex_repl);
+    lex_repl = Nullsv;
+    lex_inpat = 0;
+    lex_inwhat = 0;
+    linestr = line;
+    if (SvREADONLY(linestr))
+	linestr = sv_2mortal(newSVsv(linestr));
+    s = SvPV(linestr, len);
+    if (len && s[len-1] != ';') {
+	if (!(SvFLAGS(linestr) & SVs_TEMP))
+	    linestr = sv_2mortal(newSVsv(linestr));
+	sv_catpvn(linestr, "\n;", 2);
+    }
+    SvTEMP_off(linestr);
+    oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+    bufend = bufptr + SvCUR(linestr);
+    SvREFCNT_dec(rs);
+    rs = newSVpv("\n", 1);
+    rsfp = 0;
+}
+
+void
+lex_end()
+{
+}
+
+static void
+restore_rsfp(f)
+void *f;
+{
+    FILE *fp = (FILE*)f;
+
+    if (rsfp == stdin)
+	clearerr(rsfp);
+    else if (rsfp && (rsfp != fp))
+	fclose(rsfp);
+    rsfp = fp;
+}
+
+static void
+incline(s)
+char *s;
+{
+    char *t;
+    char *n;
+    char ch;
+    int sawline = 0;
+
+    curcop->cop_line++;
+    if (*s++ != '#')
+	return;
+    while (*s == ' ' || *s == '\t') s++;
+    if (strnEQ(s, "line ", 5)) {
+	s += 5;
+	sawline = 1;
+    }
+    if (!isDIGIT(*s))
+	return;
+    n = s;
+    while (isDIGIT(*s))
+	s++;
+    while (*s == ' ' || *s == '\t')
+	s++;
+    if (*s == '"' && (t = strchr(s+1, '"')))
+	s++;
+    else {
+	if (!sawline)
+	    return;		/* false alarm */
+	for (t = s; !isSPACE(*t); t++) ;
+    }
+    ch = *t;
+    *t = '\0';
+    if (t - s > 0)
+	curcop->cop_filegv = gv_fetchfile(s);
+    else
+	curcop->cop_filegv = gv_fetchfile(origfilename);
+    *t = ch;
+    curcop->cop_line = atoi(n)-1;
+}
+
+static char *
+skipspace(s)
+register char *s;
+{
+    if (lex_formbrack && lex_brackets <= lex_formbrack) {
+	while (s < bufend && (*s == ' ' || *s == '\t'))
+	    s++;
+	return s;
+    }
+    for (;;) {
+	while (s < bufend && isSPACE(*s))
+	    s++;
+	if (s < bufend && *s == '#') {
+	    while (s < bufend && *s != '\n')
+		s++;
+	    if (s < bufend)
+		s++;
+	}
+	if (s < bufend || !rsfp || lex_state != LEX_NORMAL)
+	    return s;
+	if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+	    if (minus_n || minus_p) {
+		sv_setpv(linestr,minus_p ? ";}continue{print" : "");
+		sv_catpv(linestr,";}");
+		minus_n = minus_p = 0;
+	    }
+	    else
+		sv_setpv(linestr,";");
+	    oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+	    bufend = SvPVX(linestr) + SvCUR(linestr);
+	    if (preprocess && !in_eval)
+		(void)my_pclose(rsfp);
+	    else if ((FILE*)rsfp == stdin)
+		clearerr(stdin);
+	    else
+		(void)fclose(rsfp);
+	    rsfp = Nullfp;
+	    return s;
+	}
+	oldoldbufptr = oldbufptr = bufptr = s;
+	bufend = bufptr + SvCUR(linestr);
+	incline(s);
+	if (perldb && curstash != debstash) {
+	    SV *sv = NEWSV(85,0);
+
+	    sv_upgrade(sv, SVt_PVMG);
+	    sv_setsv(sv,linestr);
+	    av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+	}
+    }
+}
+
+static void
+check_uni() {
+    char *s;
+    char ch;
+    char *t;
+
+    if (oldoldbufptr != last_uni)
+	return;
+    while (isSPACE(*last_uni))
+	last_uni++;
+    for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
+    if ((t = strchr(s, '(')) && t < bufptr)
+	return;
+    ch = *s;
+    *s = '\0';
+    warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
+    *s = ch;
+}
+
+#ifdef CRIPPLED_CC
+
+#undef UNI
+#define UNI(f) return uni(f,s)
+
+static int
+uni(f,s)
+I32 f;
+char *s;
+{
+    yylval.ival = f;
+    expect = XTERM;
+    bufptr = s;
+    last_uni = oldbufptr;
+    last_lop_op = f;
+    if (*s == '(')
+	return FUNC1;
+    s = skipspace(s);
+    if (*s == '(')
+	return FUNC1;
+    else
+	return UNIOP;
+}
+
+#endif /* CRIPPLED_CC */
+
+#define LOP(f,x) return lop(f,x,s)
+
+static I32
+lop(f,x,s)
+I32 f;
+expectation x;
+char *s;
+{
+    yylval.ival = f;
+    CLINE;
+    expect = x;
+    bufptr = s;
+    last_lop = oldbufptr;
+    last_lop_op = f;
+    if (nexttoke)
+	return LSTOP;
+    if (*s == '(')
+	return FUNC;
+    s = skipspace(s);
+    if (*s == '(')
+	return FUNC;
+    else
+	return LSTOP;
+}
+
+static void 
+force_next(type)
+I32 type;
+{
+    nexttype[nexttoke] = type;
+    nexttoke++;
+    if (lex_state != LEX_KNOWNEXT) {
+	lex_defer = lex_state;
+	lex_expect = expect;
+	lex_state = LEX_KNOWNEXT;
+    }
+}
+
+static char *
+force_word(start,token,check_keyword,allow_pack,allow_tick)
+register char *start;
+int token;
+int check_keyword;
+int allow_pack;
+int allow_tick;
+{
+    register char *s;
+    STRLEN len;
+    
+    start = skipspace(start);
+    s = start;
+    if (isIDFIRST(*s) ||
+	(allow_pack && *s == ':') ||
+	(allow_tick && *s == '\'') )
+    {
+	s = scan_word(s, tokenbuf, allow_pack, &len);
+	if (check_keyword && keyword(tokenbuf, len))
+	    return start;
+	if (token == METHOD) {
+	    s = skipspace(s);
+	    if (*s == '(')
+		expect = XTERM;
+	    else {
+		expect = XOPERATOR;
+		force_next(')');
+		force_next('(');
+	    }
+	}
+	nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
+	nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
+	force_next(token);
+    }
+    return s;
+}
+
+static void
+force_ident(s, kind)
+register char *s;
+int kind;
+{
+    if (s && *s) {
+	OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+	nextval[nexttoke].opval = op;
+	force_next(WORD);
+	if (kind) {
+	    op->op_private = OPpCONST_ENTERED;
+	    gv_fetchpv(s, TRUE,
+		kind == '$' ? SVt_PV :
+		kind == '@' ? SVt_PVAV :
+		kind == '%' ? SVt_PVHV :
+			      SVt_PVGV
+		);
+	}
+    }
+}
+
+static SV *
+q(sv)
+SV *sv;
+{
+    register char *s;
+    register char *send;
+    register char *d;
+    STRLEN len;
+
+    if (!SvLEN(sv))
+	return sv;
+
+    s = SvPV_force(sv, len);
+    if (SvIVX(sv) == -1)
+	return sv;
+    send = s + len;
+    while (s < send && *s != '\\')
+	s++;
+    if (s == send)
+	return sv;
+    d = s;
+    while (s < send) {
+	if (*s == '\\') {
+	    if (s + 1 < send && (s[1] == '\\'))
+		s++;		/* all that, just for this */
+	}
+	*d++ = *s++;
+    }
+    *d = '\0';
+    SvCUR_set(sv, d - SvPVX(sv));
+
+    return sv;
+}
+
+static I32
+sublex_start()
+{
+    register I32 op_type = yylval.ival;
+
+    if (op_type == OP_NULL) {
+	yylval.opval = lex_op;
+	lex_op = Nullop;
+	return THING;
+    }
+    if (op_type == OP_CONST || op_type == OP_READLINE) {
+	yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
+	lex_stuff = Nullsv;
+	return THING;
+    }
+
+    push_scope();
+    SAVEINT(lex_dojoin);
+    SAVEINT(lex_brackets);
+    SAVEINT(lex_fakebrack);
+    SAVEINT(lex_casemods);
+    SAVEINT(lex_starts);
+    SAVEINT(lex_state);
+    SAVESPTR(lex_inpat);
+    SAVEINT(lex_inwhat);
+    SAVEINT(curcop->cop_line);
+    SAVEPPTR(bufptr);
+    SAVEPPTR(oldbufptr);
+    SAVEPPTR(oldoldbufptr);
+    SAVESPTR(linestr);
+    SAVEPPTR(lex_brackstack);
+    SAVEPPTR(lex_casestack);
+
+    linestr = lex_stuff;
+    lex_stuff = Nullsv;
+
+    bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+    bufend += SvCUR(linestr);
+    SAVEFREESV(linestr);
+
+    lex_dojoin = FALSE;
+    lex_brackets = 0;
+    lex_fakebrack = 0;
+    New(899, lex_brackstack, 120, char);
+    New(899, lex_casestack, 12, char);
+    SAVEFREEPV(lex_brackstack);
+    SAVEFREEPV(lex_casestack);
+    lex_casemods = 0;
+    *lex_casestack = '\0';
+    lex_starts = 0;
+    lex_state = LEX_INTERPCONCAT;
+    curcop->cop_line = multi_start;
+
+    lex_inwhat = op_type;
+    if (op_type == OP_MATCH || op_type == OP_SUBST)
+	lex_inpat = lex_op;
+    else
+	lex_inpat = 0;
+
+    expect = XTERM;
+    force_next('(');
+    if (lex_op) {
+	yylval.opval = lex_op;
+	lex_op = Nullop;
+	return PMFUNC;
+    }
+    else
+	return FUNC;
+}
+
+static I32
+sublex_done()
+{
+    if (!lex_starts++) {
+	expect = XOPERATOR;
+	yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
+	return THING;
+    }
+
+    if (lex_casemods) {		/* oops, we've got some unbalanced parens */
+	lex_state = LEX_INTERPCASEMOD;
+	return yylex();
+    }
+
+    /* Is there a right-hand side to take care of? */
+    if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
+	linestr = lex_repl;
+	lex_inpat = 0;
+	bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+	bufend += SvCUR(linestr);
+	SAVEFREESV(linestr);
+	lex_dojoin = FALSE;
+	lex_brackets = 0;
+	lex_fakebrack = 0;
+	lex_casemods = 0;
+	*lex_casestack = '\0';
+	lex_starts = 0;
+	if (SvCOMPILED(lex_repl)) {
+	    lex_state = LEX_INTERPNORMAL;
+	    lex_starts++;
+	}
+	else
+	    lex_state = LEX_INTERPCONCAT;
+	lex_repl = Nullsv;
+	return ',';
+    }
+    else {
+	pop_scope();
+	bufend = SvPVX(linestr);
+	bufend += SvCUR(linestr);
+	expect = XOPERATOR;
+	return ')';
+    }
+}
+
+static char *
+scan_const(start)
+char *start;
+{
+    register char *send = bufend;
+    SV *sv = NEWSV(93, send - start);
+    register char *s = start;
+    register char *d = SvPVX(sv);
+    bool dorange = FALSE;
+    I32 len;
+    char *leave =
+	lex_inpat
+	    ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
+	    : (lex_inwhat & OP_TRANS)
+		? ""
+		: "";
+
+    while (s < send || dorange) {
+	if (lex_inwhat == OP_TRANS) {
+	    if (dorange) {
+		I32 i;
+		I32 max;
+		i = d - SvPVX(sv);
+		SvGROW(sv, SvLEN(sv) + 256);
+		d = SvPVX(sv) + i;
+		d -= 2;
+		max = (U8)d[1];
+		for (i = (U8)*d; i <= max; i++)
+		    *d++ = i;
+		dorange = FALSE;
+		continue;
+	    }
+	    else if (*s == '-' && s+1 < send  && s != start) {
+		dorange = TRUE;
+		s++;
+	    }
+	}
+	else if (*s == '(' && lex_inpat && s[1] == '?' && s[2] == '#') {
+	    while (s < send && *s != ')')
+		*d++ = *s++;
+	}
+	else if (*s == '#' && lex_inpat &&
+	  ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) {
+	    while (s+1 < send && *s != '\n')
+		*d++ = *s++;
+	}
+	else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
+	    break;
+	else if (*s == '$') {
+	    if (!lex_inpat)	/* not a regexp, so $ must be var */
+		break;
+	    if (s + 1 < send && !strchr(")| \n\t", s[1]))
+		break;		/* in regexp, $ might be tail anchor */
+	}
+	if (*s == '\\' && s+1 < send) {
+	    s++;
+	    if (*s && strchr(leave, *s)) {
+		*d++ = '\\';
+		*d++ = *s++;
+		continue;
+	    }
+	    if (lex_inwhat == OP_SUBST && !lex_inpat &&
+		isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
+	    {
+		if (dowarn)
+		    warn("\\%c better written as $%c", *s, *s);
+		*--s = '$';
+		break;
+	    }
+	    if (lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
+		--s;
+		break;
+	    }
+	    switch (*s) {
+	    case '-':
+		if (lex_inwhat == OP_TRANS) {
+		    *d++ = *s++;
+		    continue;
+		}
+		/* FALL THROUGH */
+	    default:
+		*d++ = *s++;
+		continue;
+	    case '0': case '1': case '2': case '3':
+	    case '4': case '5': case '6': case '7':
+		*d++ = scan_oct(s, 3, &len);
+		s += len;
+		continue;
+	    case 'x':
+		*d++ = scan_hex(++s, 2, &len);
+		s += len;
+		continue;
+	    case 'c':
+		s++;
+		*d = *s++;
+		if (isLOWER(*d))
+		    *d = toUPPER(*d);
+		*d++ ^= 64;
+		continue;
+	    case 'b':
+		*d++ = '\b';
+		break;
+	    case 'n':
+		*d++ = '\n';
+		break;
+	    case 'r':
+		*d++ = '\r';
+		break;
+	    case 'f':
+		*d++ = '\f';
+		break;
+	    case 't':
+		*d++ = '\t';
+		break;
+	    case 'e':
+		*d++ = '\033';
+		break;
+	    case 'a':
+		*d++ = '\007';
+		break;
+	    }
+	    s++;
+	    continue;
+	}
+	*d++ = *s++;
+    }
+    *d = '\0';
+    SvCUR_set(sv, d - SvPVX(sv));
+    SvPOK_on(sv);
+
+    if (SvCUR(sv) + 5 < SvLEN(sv)) {
+	SvLEN_set(sv, SvCUR(sv) + 1);
+	Renew(SvPVX(sv), SvLEN(sv), char);
+    }
+    if (s > bufptr)
+	yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+    else
+	SvREFCNT_dec(sv);
+    return s;
+}
+
+/* This is the one truly awful dwimmer necessary to conflate C and sed. */
+static int
+intuit_more(s)
+register char *s;
+{
+    if (lex_brackets)
+	return TRUE;
+    if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
+	return TRUE;
+    if (*s != '{' && *s != '[')
+	return FALSE;
+    if (!lex_inpat)
+	return TRUE;
+
+    /* In a pattern, so maybe we have {n,m}. */
+    if (*s == '{') {
+	s++;
+	if (!isDIGIT(*s))
+	    return TRUE;
+	while (isDIGIT(*s))
+	    s++;
+	if (*s == ',')
+	    s++;
+	while (isDIGIT(*s))
+	    s++;
+	if (*s == '}')
+	    return FALSE;
+	return TRUE;
+	
+    }
+
+    /* On the other hand, maybe we have a character class */
+
+    s++;
+    if (*s == ']' || *s == '^')
+	return FALSE;
+    else {
+	int weight = 2;		/* let's weigh the evidence */
+	char seen[256];
+	unsigned char un_char = 0, last_un_char;
+	char *send = strchr(s,']');
+	char tmpbuf[512];
+
+	if (!send)		/* has to be an expression */
+	    return TRUE;
+
+	Zero(seen,256,char);
+	if (*s == '$')
+	    weight -= 3;
+	else if (isDIGIT(*s)) {
+	    if (s[1] != ']') {
+		if (isDIGIT(s[1]) && s[2] == ']')
+		    weight -= 10;
+	    }
+	    else
+		weight -= 100;
+	}
+	for (; s < send; s++) {
+	    last_un_char = un_char;
+	    un_char = (unsigned char)*s;
+	    switch (*s) {
+	    case '@':
+	    case '&':
+	    case '$':
+		weight -= seen[un_char] * 10;
+		if (isALNUM(s[1])) {
+		    scan_ident(s,send,tmpbuf,FALSE);
+		    if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
+			weight -= 100;
+		    else
+			weight -= 10;
+		}
+		else if (*s == '$' && s[1] &&
+		  strchr("[#!%*<>()-=",s[1])) {
+		    if (/*{*/ strchr("])} =",s[2]))
+			weight -= 10;
+		    else
+			weight -= 1;
+		}
+		break;
+	    case '\\':
+		un_char = 254;
+		if (s[1]) {
+		    if (strchr("wds]",s[1]))
+			weight += 100;
+		    else if (seen['\''] || seen['"'])
+			weight += 1;
+		    else if (strchr("rnftbxcav",s[1]))
+			weight += 40;
+		    else if (isDIGIT(s[1])) {
+			weight += 40;
+			while (s[1] && isDIGIT(s[1]))
+			    s++;
+		    }
+		}
+		else
+		    weight += 100;
+		break;
+	    case '-':
+		if (s[1] == '\\')
+		    weight += 50;
+		if (strchr("aA01! ",last_un_char))
+		    weight += 30;
+		if (strchr("zZ79~",s[1]))
+		    weight += 30;
+		break;
+	    default:
+		if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
+			isALPHA(*s) && s[1] && isALPHA(s[1])) {
+		    char *d = tmpbuf;
+		    while (isALPHA(*s))
+			*d++ = *s++;
+		    *d = '\0';
+		    if (keyword(tmpbuf, d - tmpbuf))
+			weight -= 150;
+		}
+		if (un_char == last_un_char + 1)
+		    weight += 5;
+		weight -= seen[un_char];
+		break;
+	    }
+	    seen[un_char]++;
+	}
+	if (weight >= 0)	/* probably a character class */
+	    return FALSE;
+    }
+
+    return TRUE;
+}
+
+static int
+intuit_method(start,gv)
+char *start;
+GV *gv;
+{
+    char *s = start + (*start == '$');
+    char tmpbuf[1024];
+    STRLEN len;
+    GV* indirgv;
+
+    if (gv) {
+	if (GvIO(gv))
+	    return 0;
+	if (!GvCV(gv))
+	    gv = 0;
+    }
+    s = scan_word(s, tmpbuf, TRUE, &len);
+    if (*start == '$') {
+	if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
+	    return 0;
+	s = skipspace(s);
+	bufptr = start;
+	expect = XREF;
+	return *s == '(' ? FUNCMETH : METHOD;
+    }
+    if (!keyword(tmpbuf, len)) {
+	indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
+	if (indirgv && GvCV(indirgv))
+	    return 0;
+	/* filehandle or package name makes it a method */
+	if (!gv || GvIO(indirgv) || gv_stashpv(tmpbuf, FALSE)) {
+	    s = skipspace(s);
+	    nextval[nexttoke].opval =
+		(OP*)newSVOP(OP_CONST, 0,
+			    newSVpv(tmpbuf,0));
+	    nextval[nexttoke].opval->op_private =
+		OPpCONST_BARE;
+	    expect = XTERM;
+	    force_next(WORD);
+	    bufptr = s;
+	    return *s == '(' ? FUNCMETH : METHOD;
+	}
+    }
+    return 0;
+}
+
+static char*
+incl_perldb()
+{
+    if (perldb) {
+	char *pdb = getenv("PERL5DB");
+
+	if (pdb)
+	    return pdb;
+	return "BEGIN { require 'perl5db.pl' }";
+    }
+    return "";
+}
+
+
+/* Encoded script support. filter_add() effectively inserts a
+ * 'pre-processing' function into the current source input stream. 
+ * Note that the filter function only applies to the current source file
+ * (e.g., it will not affect files 'require'd or 'use'd by this one).
+ *
+ * The datasv parameter (which may be NULL) can be used to pass
+ * private data to this instance of the filter. The filter function
+ * can recover the SV using the FILTER_DATA macro and use it to
+ * store private buffers and state information.
+ *
+ * The supplied datasv parameter is upgraded to a PVIO type
+ * and the IoDIRP field is used to store the function pointer.
+ * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
+ * private use must be set using malloc'd pointers.
+ */
+static int filter_debug = 0;
+
+SV *
+filter_add(funcp, datasv)
+    filter_t funcp;
+    SV *datasv;
+{
+    if (!funcp){ /* temporary handy debugging hack to be deleted */
+	filter_debug = atoi((char*)datasv);
+	return NULL;
+    }
+    if (!rsfp_filters)
+	rsfp_filters = newAV();
+    if (!datasv)
+	datasv = newSV(0);
+    if (!SvUPGRADE(datasv, SVt_PVIO))
+        die("Can't upgrade filter_add data to SVt_PVIO");
+    IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+    if (filter_debug)
+	warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na));
+    av_unshift(rsfp_filters, 1);
+    av_store(rsfp_filters, 0, datasv) ;
+    return(datasv);
+}
+ 
+
+/* Delete most recently added instance of this filter function.	*/
+void
+filter_del(funcp)
+    filter_t funcp;
+{
+    if (filter_debug)
+	warn("filter_del func %lx", funcp);
+    if (!rsfp_filters || AvFILL(rsfp_filters)<0)
+	return;
+    /* if filter is on top of stack (usual case) just pop it off */
+    if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
+	/* sv_free(av_pop(rsfp_filters)); */
+	sv_free(av_shift(rsfp_filters));
+
+        return;
+    }
+    /* we need to search for the correct entry and clear it	*/
+    die("filter_del can only delete in reverse order (currently)");
+}
+
+
+/* Invoke the n'th filter function for the current rsfp.	 */
+I32
+filter_read(idx, buf_sv, maxlen)
+    int idx;
+    SV *buf_sv;
+    int maxlen;		/* 0 = read one text line */
+{
+    filter_t funcp;
+    SV *datasv = NULL;
+
+    if (!rsfp_filters)
+	return -1;
+    if (idx > AvFILL(rsfp_filters)){       /* Any more filters?	*/
+	/* Provide a default input filter to make life easy.	*/
+	/* Note that we append to the line. This is handy.	*/
+	if (filter_debug)
+	    warn("filter_read %d: from rsfp\n", idx);
+	if (maxlen) { 
+ 	    /* Want a block */
+	    int len ;
+	    int old_len = SvCUR(buf_sv) ;
+
+	    /* ensure buf_sv is large enough */
+	    SvGROW(buf_sv, old_len + maxlen) ;
+	    if ((len = fread(SvPVX(buf_sv) + old_len, 1, maxlen, rsfp)) <= 0){
+		if (ferror(rsfp))
+	            return -1;		/* error */
+	        else
+		    return 0 ;		/* end of file */
+	    }
+	    SvCUR_set(buf_sv, old_len + len) ;
+	} else {
+	    /* Want a line */
+            if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
+		if (ferror(rsfp))
+	            return -1;		/* error */
+	        else
+		    return 0 ;		/* end of file */
+	    }
+	}
+	return SvCUR(buf_sv);
+    }
+    /* Skip this filter slot if filter has been deleted	*/
+    if ( (datasv = FILTER_DATA(idx)) == &sv_undef){
+	if (filter_debug)
+	    warn("filter_read %d: skipped (filter deleted)\n", idx);
+	return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
+    }
+    /* Get function pointer hidden within datasv	*/
+    funcp = (filter_t)IoDIRP(datasv);
+    if (filter_debug)
+	warn("filter_read %d: via function %lx (%s)\n",
+		idx, funcp, SvPV(datasv,na));
+    /* Call function. The function is expected to 	*/
+    /* call "FILTER_READ(idx+1, buf_sv)" first.		*/
+    /* Return: <0:error, =0:eof, >0:not eof 		*/
+    return (*funcp)(idx, buf_sv, maxlen);
+}
+
+static char *
+filter_gets(sv,fp)
+register SV *sv;
+register FILE *fp;
+{
+    if (rsfp_filters) {
+
+        SvCUR_set(sv, 0);	/* start with empty line	*/
+        if (FILTER_READ(0, sv, 0) > 0)
+            return ( SvPVX(sv) ) ;
+        else
+	    return Nullch ;
+    }
+    else 
+        return (sv_gets(sv, fp, 0)) ;
+    
+}
+
+
+#ifdef DEBUGGING
+    static char* exp_name[] =
+	{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
+#endif
+
+extern int yychar;		/* last token */
+
+int
+yylex()
+{
+    register char *s;
+    register char *d;
+    register I32 tmp;
+    STRLEN len;
+
+    switch (lex_state) {
+#ifdef COMMENTARY
+    case LEX_NORMAL:		/* Some compilers will produce faster */
+    case LEX_INTERPNORMAL:	/* code if we comment these out. */
+	break;
+#endif
+
+    case LEX_KNOWNEXT:
+	nexttoke--;
+	yylval = nextval[nexttoke];
+	if (!nexttoke) {
+	    lex_state = lex_defer;
+	    expect = lex_expect;
+	    lex_defer = LEX_NORMAL;
+	}
+	return(nexttype[nexttoke]);
+
+    case LEX_INTERPCASEMOD:
+#ifdef DEBUGGING
+	if (bufptr != bufend && *bufptr != '\\')
+	    croak("panic: INTERPCASEMOD");
+#endif
+	if (bufptr == bufend || bufptr[1] == 'E') {
+	    char oldmod;
+	    if (lex_casemods) {
+		oldmod = lex_casestack[--lex_casemods];
+		lex_casestack[lex_casemods] = '\0';
+		if (bufptr != bufend && strchr("LUQ", oldmod)) {
+		    bufptr += 2;
+		    lex_state = LEX_INTERPCONCAT;
+		}
+		return ')';
+	    }
+	    if (bufptr != bufend)
+		bufptr += 2;
+	    lex_state = LEX_INTERPCONCAT;
+	    return yylex();
+	}
+	else {
+	    s = bufptr + 1;
+	    if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
+		tmp = *s, *s = s[2], s[2] = tmp;	/* misordered... */
+	    if (strchr("LU", *s) &&
+		(strchr(lex_casestack, 'L') || strchr(lex_casestack, 'U')))
+	    {
+		lex_casestack[--lex_casemods] = '\0';
+		return ')';
+	    }
+	    if (lex_casemods > 10) {
+		char* newlb = (char*)realloc(lex_casestack, lex_casemods + 2);
+		if (newlb != lex_casestack) {
+		    SAVEFREEPV(newlb);
+		    lex_casestack = newlb;
+		}
+	    }
+	    lex_casestack[lex_casemods++] = *s;
+	    lex_casestack[lex_casemods] = '\0';
+	    lex_state = LEX_INTERPCONCAT;
+	    nextval[nexttoke].ival = 0;
+	    force_next('(');
+	    if (*s == 'l')
+		nextval[nexttoke].ival = OP_LCFIRST;
+	    else if (*s == 'u')
+		nextval[nexttoke].ival = OP_UCFIRST;
+	    else if (*s == 'L')
+		nextval[nexttoke].ival = OP_LC;
+	    else if (*s == 'U')
+		nextval[nexttoke].ival = OP_UC;
+	    else if (*s == 'Q')
+		nextval[nexttoke].ival = OP_QUOTEMETA;
+	    else
+		croak("panic: yylex");
+	    bufptr = s + 1;
+	    force_next(FUNC);
+	    if (lex_starts) {
+		s = bufptr;
+		lex_starts = 0;
+		Aop(OP_CONCAT);
+	    }
+	    else
+		return yylex();
+	}
+
+    case LEX_INTERPSTART:
+	if (bufptr == bufend)
+	    return sublex_done();
+	expect = XTERM;
+	lex_dojoin = (*bufptr == '@');
+	lex_state = LEX_INTERPNORMAL;
+	if (lex_dojoin) {
+	    nextval[nexttoke].ival = 0;
+	    force_next(',');
+	    force_ident("\"", '$');
+	    nextval[nexttoke].ival = 0;
+	    force_next('$');
+	    nextval[nexttoke].ival = 0;
+	    force_next('(');
+	    nextval[nexttoke].ival = OP_JOIN;	/* emulate join($", ...) */
+	    force_next(FUNC);
+	}
+	if (lex_starts++) {
+	    s = bufptr;
+	    Aop(OP_CONCAT);
+	}
+	else
+	    return yylex();
+	break;
+
+    case LEX_INTERPENDMAYBE:
+	if (intuit_more(bufptr)) {
+	    lex_state = LEX_INTERPNORMAL;	/* false alarm, more expr */
+	    break;
+	}
+	/* FALL THROUGH */
+
+    case LEX_INTERPEND:
+	if (lex_dojoin) {
+	    lex_dojoin = FALSE;
+	    lex_state = LEX_INTERPCONCAT;
+	    return ')';
+	}
+	/* FALLTHROUGH */
+    case LEX_INTERPCONCAT:
+#ifdef DEBUGGING
+	if (lex_brackets)
+	    croak("panic: INTERPCONCAT");
+#endif
+	if (bufptr == bufend)
+	    return sublex_done();
+
+	if (SvIVX(linestr) == '\'') {
+	    SV *sv = newSVsv(linestr);
+	    if (!lex_inpat)
+		sv = q(sv);
+	    yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
+	    s = bufend;
+	}
+	else {
+	    s = scan_const(bufptr);
+	    if (*s == '\\')
+		lex_state = LEX_INTERPCASEMOD;
+	    else
+		lex_state = LEX_INTERPSTART;
+	}
+
+	if (s != bufptr) {
+	    nextval[nexttoke] = yylval;
+	    expect = XTERM;
+	    force_next(THING);
+	    if (lex_starts++)
+		Aop(OP_CONCAT);
+	    else {
+		bufptr = s;
+		return yylex();
+	    }
+	}
+
+	return yylex();
+    case LEX_FORMLINE:
+	lex_state = LEX_NORMAL;
+	s = scan_formline(bufptr);
+	if (!lex_formbrack)
+	    goto rightbracket;
+	OPERATOR(';');
+    }
+
+    s = bufptr;
+    oldoldbufptr = oldbufptr;
+    oldbufptr = s;
+    DEBUG_p( {
+	fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s);
+    } )
+
+  retry:
+    switch (*s) {
+    default:
+	warn("Unrecognized character \\%03o ignored", *s++ & 255);
+	goto retry;
+    case 4:
+    case 26:
+	goto fake_eof;			/* emulate EOF on ^D or ^Z */
+    case 0:
+	if (!rsfp) {
+	    if (lex_brackets)
+		yyerror("Missing right bracket");
+	    TOKEN(0);
+	}
+	if (s++ < bufend)
+	    goto retry;			/* ignore stray nulls */
+	last_uni = 0;
+	last_lop = 0;
+	if (!in_eval && !preambled) {
+	    preambled = TRUE;
+	    sv_setpv(linestr,incl_perldb());
+	    if (SvCUR(linestr))
+		sv_catpv(linestr,";");
+	    if (preambleav){
+		while(AvFILL(preambleav) >= 0) {
+		    SV *tmpsv = av_shift(preambleav);
+		    sv_catsv(linestr, tmpsv);
+		    sv_catpv(linestr, ";");
+		    sv_free(tmpsv);
+		}
+		sv_free((SV*)preambleav);
+		preambleav = NULL;
+	    }
+	    if (minus_n || minus_p) {
+		sv_catpv(linestr, "LINE: while (<>) {");
+		if (minus_l)
+		    sv_catpv(linestr,"chomp;");
+		if (minus_a){
+		    if (minus_F){
+		      char tmpbuf1[50];
+		      if ( splitstr[0] == '/' || 
+		           splitstr[0] == '\'' || 
+		           splitstr[0] == '"' )
+			    sprintf( tmpbuf1, "@F=split(%s);", splitstr );
+		        else
+			    sprintf( tmpbuf1, "@F=split('%s');", splitstr );
+		        sv_catpv(linestr,tmpbuf1);
+		    }
+		    else
+		        sv_catpv(linestr,"@F=split(' ');");
+		}
+	    }
+	    sv_catpv(linestr, "\n");
+	    oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+	    bufend = SvPVX(linestr) + SvCUR(linestr);
+	    if (perldb && curstash != debstash) {
+		SV *sv = NEWSV(85,0);
+
+		sv_upgrade(sv, SVt_PVMG);
+		sv_setsv(sv,linestr);
+		av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+	    }
+	    goto retry;
+	}
+	do {
+	    if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+	      fake_eof:
+		if (rsfp) {
+		    if (preprocess && !in_eval)
+			(void)my_pclose(rsfp);
+		    else if ((FILE*)rsfp == stdin)
+			clearerr(stdin);
+		    else
+			(void)fclose(rsfp);
+		    rsfp = Nullfp;
+		}
+		if (!in_eval && (minus_n || minus_p)) {
+		    sv_setpv(linestr,minus_p ? ";}continue{print" : "");
+		    sv_catpv(linestr,";}");
+		    oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+		    bufend = SvPVX(linestr) + SvCUR(linestr);
+		    minus_n = minus_p = 0;
+		    goto retry;
+		}
+		oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+		sv_setpv(linestr,"");
+		TOKEN(';');	/* not infinite loop because rsfp is NULL now */
+	    }
+	    if (doextract) {
+		if (*s == '#' && s[1] == '!' && instr(s,"perl"))
+		    doextract = FALSE;
+
+		/* Incest with pod. */
+		if (*s == '=' && strnEQ(s, "=cut", 4)) {
+		    sv_setpv(linestr, "");
+		    oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+		    bufend = SvPVX(linestr) + SvCUR(linestr);
+		    doextract = FALSE;
+		}
+	    }
+	    incline(s);
+	} while (doextract);
+	oldoldbufptr = oldbufptr = bufptr = s;
+	if (perldb && curstash != debstash) {
+	    SV *sv = NEWSV(85,0);
+
+	    sv_upgrade(sv, SVt_PVMG);
+	    sv_setsv(sv,linestr);
+	    av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
+	}
+	bufend = SvPVX(linestr) + SvCUR(linestr);
+	if (curcop->cop_line == 1) {
+	    while (s < bufend && isSPACE(*s))
+		s++;
+	    if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
+		s++;
+	    if (!in_eval && *s == '#' && s[1] == '!') {
+		d = instr(s,"perl -");
+		if (!d)
+		    d = instr(s,"perl");
+		if (!d &&
+		    !minus_c &&
+		    !instr(s,"indir") &&
+		    instr(origargv[0],"perl"))
+		{
+		    char **newargv;
+		    char *cmd;
+
+		    s += 2;
+		    if (*s == ' ')
+			s++;
+		    cmd = s;
+		    while (s < bufend && !isSPACE(*s))
+			s++;
+		    *s++ = '\0';
+		    while (s < bufend && isSPACE(*s))
+			s++;
+		    if (s < bufend) {
+			Newz(899,newargv,origargc+3,char*);
+			newargv[1] = s;
+			while (s < bufend && !isSPACE(*s))
+			    s++;
+			*s = '\0';
+			Copy(origargv+1, newargv+2, origargc+1, char*);
+		    }
+		    else
+			newargv = origargv;
+		    newargv[0] = cmd;
+		    execv(cmd,newargv);
+		    croak("Can't exec %s", cmd);
+		}
+		if (d) {
+		    int oldpdb = perldb;
+		    int oldn = minus_n;
+		    int oldp = minus_p;
+
+		    while (*d && !isSPACE(*d)) d++;
+		    while (*d == ' ') d++;
+
+		    if (*d++ == '-') {
+			while (d = moreswitches(d)) ;
+			if (perldb && !oldpdb ||
+			    ( minus_n || minus_p ) && !(oldn || oldp) )
+			      /* if we have already added "LINE: while (<>) {",
+			         we must not do it again */
+			{
+			    sv_setpv(linestr, "");
+			    oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+			    bufend = SvPVX(linestr) + SvCUR(linestr);
+			    preambled = FALSE;
+			    if (perldb)
+				(void)gv_fetchfile(origfilename);
+			    goto retry;
+			}
+		    }
+		}
+	    }
+	}
+	if (lex_formbrack && lex_brackets <= lex_formbrack) {
+	    bufptr = s;
+	    lex_state = LEX_FORMLINE;
+	    return yylex();
+	}
+	goto retry;
+    case ' ': case '\t': case '\f': case '\r': case 013:
+	s++;
+	goto retry;
+    case '#':
+    case '\n':
+	if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
+	    d = bufend;
+	    while (s < d && *s != '\n')
+		s++;
+	    if (s < d)
+		s++;
+	    incline(s);
+	    if (lex_formbrack && lex_brackets <= lex_formbrack) {
+		bufptr = s;
+		lex_state = LEX_FORMLINE;
+		return yylex();
+	    }
+	}
+	else {
+	    *s = '\0';
+	    bufend = s;
+	}
+	goto retry;
+    case '-':
+	if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
+	    s++;
+	    bufptr = s;
+	    tmp = *s++;
+
+	    while (s < bufend && (*s == ' ' || *s == '\t'))
+		s++;
+
+	    if (strnEQ(s,"=>",2)) {
+		if (dowarn)
+		    warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
+			tmp, tmp);
+		s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
+		OPERATOR('-');		/* unary minus */
+	    }
+	    last_uni = oldbufptr;
+	    last_lop_op = OP_FTEREAD;	/* good enough */
+	    switch (tmp) {
+	    case 'r': FTST(OP_FTEREAD);
+	    case 'w': FTST(OP_FTEWRITE);
+	    case 'x': FTST(OP_FTEEXEC);
+	    case 'o': FTST(OP_FTEOWNED);
+	    case 'R': FTST(OP_FTRREAD);
+	    case 'W': FTST(OP_FTRWRITE);
+	    case 'X': FTST(OP_FTREXEC);
+	    case 'O': FTST(OP_FTROWNED);
+	    case 'e': FTST(OP_FTIS);
+	    case 'z': FTST(OP_FTZERO);
+	    case 's': FTST(OP_FTSIZE);
+	    case 'f': FTST(OP_FTFILE);
+	    case 'd': FTST(OP_FTDIR);
+	    case 'l': FTST(OP_FTLINK);
+	    case 'p': FTST(OP_FTPIPE);
+	    case 'S': FTST(OP_FTSOCK);
+	    case 'u': FTST(OP_FTSUID);
+	    case 'g': FTST(OP_FTSGID);
+	    case 'k': FTST(OP_FTSVTX);
+	    case 'b': FTST(OP_FTBLK);
+	    case 'c': FTST(OP_FTCHR);
+	    case 't': FTST(OP_FTTTY);
+	    case 'T': FTST(OP_FTTEXT);
+	    case 'B': FTST(OP_FTBINARY);
+	    case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
+	    case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
+	    case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
+	    default:
+		croak("Unrecognized file test: -%c", tmp);
+		break;
+	    }
+	}
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    if (expect == XOPERATOR)
+		TERM(POSTDEC);
+	    else
+		OPERATOR(PREDEC);
+	}
+	else if (*s == '>') {
+	    s++;
+	    s = skipspace(s);
+	    if (isIDFIRST(*s)) {
+		s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+		TOKEN(ARROW);
+	    }
+	    else if (*s == '$')
+		OPERATOR(ARROW);
+	    else
+		TERM(ARROW);
+	}
+	if (expect == XOPERATOR)
+	    Aop(OP_SUBTRACT);
+	else {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('-');		/* unary minus */
+	}
+
+    case '+':
+	tmp = *s++;
+	if (*s == tmp) {
+	    s++;
+	    if (expect == XOPERATOR)
+		TERM(POSTINC);
+	    else
+		OPERATOR(PREINC);
+	}
+	if (expect == XOPERATOR)
+	    Aop(OP_ADD);
+	else {
+	    if (isSPACE(*s) || !isSPACE(*bufptr))
+		check_uni();
+	    OPERATOR('+');
+	}
+
+    case '*':
+	if (expect != XOPERATOR) {
+	    s = scan_ident(s, bufend, tokenbuf, TRUE);
+	    expect = XOPERATOR;
+	    force_ident(tokenbuf, '*');
+	    if (!*tokenbuf)
+		PREREF('*');
+	    TERM('*');
+	}
+	s++;
+	if (*s == '*') {
+	    s++;
+	    PWop(OP_POW);
+	}
+	Mop(OP_MULTIPLY);
+
+    case '%':
+	if (expect != XOPERATOR) {
+	    s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
+	    if (tokenbuf[1]) {
+		expect = XOPERATOR;
+		tokenbuf[0] = '%';
+		if (in_my) {
+		    if (strchr(tokenbuf,':'))
+			croak(no_myglob,tokenbuf);
+		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		    nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+		    force_next(PRIVATEREF);
+		    TERM('%');
+		}
+		if (!strchr(tokenbuf,':')) {
+		    if (tmp = pad_findmy(tokenbuf)) {
+			nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+			nextval[nexttoke].opval->op_targ = tmp;
+			force_next(PRIVATEREF);
+			TERM('%');
+		    }
+		}
+		force_ident(tokenbuf + 1, *tokenbuf);
+	    }
+	    else
+		PREREF('%');
+	    TERM('%');
+	}
+	++s;
+	Mop(OP_MODULO);
+
+    case '^':
+	s++;
+	BOop(OP_BIT_XOR);
+    case '[':
+	lex_brackets++;
+	/* FALL THROUGH */
+    case '~':
+    case ',':
+	tmp = *s++;
+	OPERATOR(tmp);
+    case ':':
+	if (s[1] == ':') {
+	    len = 0;
+	    goto just_a_word;
+	}
+	s++;
+	OPERATOR(':');
+    case '(':
+	s++;
+	if (last_lop == oldoldbufptr || last_uni == oldoldbufptr)
+	    oldbufptr = oldoldbufptr;		/* allow print(STDOUT 123) */
+	else
+	    expect = XTERM;
+	TOKEN('(');
+    case ';':
+	if (curcop->cop_line < copline)
+	    copline = curcop->cop_line;
+	tmp = *s++;
+	OPERATOR(tmp);
+    case ')':
+	tmp = *s++;
+	s = skipspace(s);
+	if (*s == '{')
+	    PREBLOCK(tmp);
+	TERM(tmp);
+    case ']':
+	s++;
+	if (lex_brackets <= 0)
+	    yyerror("Unmatched right bracket");
+	else
+	    --lex_brackets;
+	if (lex_state == LEX_INTERPNORMAL) {
+	    if (lex_brackets == 0) {
+		if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+		    lex_state = LEX_INTERPEND;
+	    }
+	}
+	TERM(']');
+    case '{':
+      leftbracket:
+	s++;
+	if (lex_brackets > 100) {
+	    char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
+	    if (newlb != lex_brackstack) {
+		SAVEFREEPV(newlb);
+		lex_brackstack = newlb;
+	    }
+	}
+	switch (expect) {
+	case XTERM:
+	    if (lex_formbrack) {
+		s--;
+		PRETERMBLOCK(DO);
+	    }
+	    if (oldoldbufptr == last_lop)
+		lex_brackstack[lex_brackets++] = XTERM;
+	    else
+		lex_brackstack[lex_brackets++] = XOPERATOR;
+	    OPERATOR(HASHBRACK);
+	    break;
+	case XOPERATOR:
+	    while (s < bufend && (*s == ' ' || *s == '\t'))
+		s++;
+	    if (s < bufend && isALPHA(*s)) {
+		d = scan_word(s, tokenbuf, FALSE, &len);
+		while (d < bufend && (*d == ' ' || *d == '\t'))
+		    d++;
+		if (*d == '}') {
+		    if (dowarn &&
+		      (keyword(tokenbuf, len) ||
+		       perl_get_cv(tokenbuf, FALSE) ))
+			warn("Ambiguous use of {%s} resolved to {\"%s\"}",
+			    tokenbuf, tokenbuf);
+		    s = force_word(s,WORD,FALSE,TRUE,FALSE);
+		}
+	    }
+	    /* FALL THROUGH */
+	case XBLOCK:
+	    lex_brackstack[lex_brackets++] = XSTATE;
+	    expect = XSTATE;
+	    break;
+	case XTERMBLOCK:
+	    lex_brackstack[lex_brackets++] = XOPERATOR;
+	    expect = XSTATE;
+	    break;
+	default: {
+		char *t;
+		if (oldoldbufptr == last_lop)
+		    lex_brackstack[lex_brackets++] = XTERM;
+		else
+		    lex_brackstack[lex_brackets++] = XOPERATOR;
+		s = skipspace(s);
+		if (*s == '}')
+		    OPERATOR(HASHBRACK);
+		if (isALPHA(*s)) {
+		    for (t = s; t < bufend && isALNUM(*t); t++) ;
+		}
+		else if (*s == '\'' || *s == '"') {
+		    t = strchr(s+1,*s);
+		    if (!t++)
+			t = s;
+		}
+		else
+		    t = s;
+		while (t < bufend && isSPACE(*t))
+		    t++;
+		if ((*t == ',' && !isLOWER(*s)) || (*t == '=' && t[1] == '>'))
+		    OPERATOR(HASHBRACK);
+		if (expect == XREF)
+		    expect = XTERM;
+		else {
+		    lex_brackstack[lex_brackets-1] = XSTATE;
+		    expect = XSTATE;
+		}
+	    }
+	    break;
+	}
+	yylval.ival = curcop->cop_line;
+	if (isSPACE(*s) || *s == '#')
+	    copline = NOLINE;   /* invalidate current command line number */
+	TOKEN('{');
+    case '}':
+      rightbracket:
+	s++;
+	if (lex_brackets <= 0)
+	    yyerror("Unmatched right bracket");
+	else
+	    expect = (expectation)lex_brackstack[--lex_brackets];
+	if (lex_brackets < lex_formbrack)
+	    lex_formbrack = 0;
+	if (lex_state == LEX_INTERPNORMAL) {
+	    if (lex_brackets == 0) {
+		if (lex_fakebrack) {
+		    lex_state = LEX_INTERPEND;
+		    bufptr = s;
+		    return yylex();		/* ignore fake brackets */
+		}
+		if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+		    lex_state = LEX_INTERPEND;
+	    }
+	}
+	if (lex_brackets < lex_fakebrack) {
+	    bufptr = s;
+	    lex_fakebrack = 0;
+	    return yylex();		/* ignore fake brackets */
+	}
+	force_next('}');
+	TOKEN(';');
+    case '&':
+	s++;
+	tmp = *s++;
+	if (tmp == '&')
+	    AOPERATOR(ANDAND);
+	s--;
+	if (expect == XOPERATOR) {
+	    if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
+		curcop->cop_line--;
+		warn(warn_nosemi);
+		curcop->cop_line++;
+	    }
+	    BAop(OP_BIT_AND);
+	}
+
+	s = scan_ident(s-1, bufend, tokenbuf, TRUE);
+	if (*tokenbuf) {
+	    expect = XOPERATOR;
+	    force_ident(tokenbuf, '&');
+	}
+	else
+	    PREREF('&');
+	yylval.ival = (OPpENTERSUB_AMPER<<8);
+	TERM('&');
+
+    case '|':
+	s++;
+	tmp = *s++;
+	if (tmp == '|')
+	    AOPERATOR(OROR);
+	s--;
+	BOop(OP_BIT_OR);
+    case '=':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    Eop(OP_EQ);
+	if (tmp == '>')
+	    OPERATOR(',');
+	if (tmp == '~')
+	    PMop(OP_MATCH);
+	if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
+	    warn("Reversed %c= operator",tmp);
+	s--;
+	if (expect == XSTATE && isALPHA(tmp) &&
+		(s == SvPVX(linestr)+1 || s[-2] == '\n') )
+	{
+	    if (in_eval && !rsfp) {
+		d = bufend;
+		while (s < d) {
+		    if (*s++ == '\n') {
+			incline(s);
+			if (strnEQ(s,"=cut",4)) {
+			    s = strchr(s,'\n');
+			    if (s)
+				s++;
+			    else
+				s = d;
+			    incline(s);
+			    goto retry;
+			}
+		    }
+		}
+		goto retry;
+	    }
+	    s = bufend;
+	    doextract = TRUE;
+	    goto retry;
+	}
+	if (lex_brackets < lex_formbrack) {
+	    char *t;
+	    for (t = s; *t == ' ' || *t == '\t'; t++) ;
+	    if (*t == '\n' || *t == '#') {
+		s--;
+		expect = XBLOCK;
+		goto leftbracket;
+	    }
+	}
+	yylval.ival = 0;
+	OPERATOR(ASSIGNOP);
+    case '!':
+	s++;
+	tmp = *s++;
+	if (tmp == '=')
+	    Eop(OP_NE);
+	if (tmp == '~')
+	    PMop(OP_NOT);
+	s--;
+	OPERATOR('!');
+    case '<':
+	if (expect != XOPERATOR) {
+	    if (s[1] != '<' && !strchr(s,'>'))
+		check_uni();
+	    if (s[1] == '<')
+		s = scan_heredoc(s);
+	    else
+		s = scan_inputsymbol(s);
+	    TERM(sublex_start());
+	}
+	s++;
+	tmp = *s++;
+	if (tmp == '<')
+	    SHop(OP_LEFT_SHIFT);
+	if (tmp == '=') {
+	    tmp = *s++;
+	    if (tmp == '>')
+		Eop(OP_NCMP);
+	    s--;
+	    Rop(OP_LE);
+	}
+	s--;
+	Rop(OP_LT);
+    case '>':
+	s++;
+	tmp = *s++;
+	if (tmp == '>')
+	    SHop(OP_RIGHT_SHIFT);
+	if (tmp == '=')
+	    Rop(OP_GE);
+	s--;
+	Rop(OP_GT);
+
+    case '$':
+	if (s[1] == '#'  && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
+	    s = scan_ident(s+1, bufend, tokenbuf+1, FALSE);
+	    if (expect == XOPERATOR) {
+		if (lex_formbrack && lex_brackets == lex_formbrack) {
+		    expect = XTERM;
+		    depcom();
+		    return ','; /* grandfather non-comma-format format */
+		}
+		else
+		    no_op("Array length",s);
+	    }
+	    else if (!tokenbuf[1])
+		PREREF(DOLSHARP);
+	    if (!strchr(tokenbuf+1,':')) {
+		tokenbuf[0] = '@';
+		if (tmp = pad_findmy(tokenbuf)) {
+		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		    nextval[nexttoke].opval->op_targ = tmp;
+		    expect = XOPERATOR;
+		    force_next(PRIVATEREF);
+		    TOKEN(DOLSHARP);
+		}
+	    }
+	    expect = XOPERATOR;
+	    force_ident(tokenbuf+1, *tokenbuf);
+	    TOKEN(DOLSHARP);
+	}
+	s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+	if (expect == XOPERATOR) {
+	    if (lex_formbrack && lex_brackets == lex_formbrack) {
+		expect = XTERM;
+		depcom();
+		return ',';	/* grandfather non-comma-format format */
+	    }
+	    else
+		no_op("Scalar",s);
+	}
+	if (tokenbuf[1]) {
+	    expectation oldexpect = expect;
+
+	    /* This kludge not intended to be bulletproof. */
+	    if (tokenbuf[1] == '[' && !tokenbuf[2]) {
+		yylval.opval = newSVOP(OP_CONST, 0,
+					newSViv((IV)compiling.cop_arybase));
+		yylval.opval->op_private = OPpCONST_ARYBASE;
+		TERM(THING);
+	    }
+	    tokenbuf[0] = '$';
+	    if (dowarn) {
+		char *t;
+		if (*s == '[' && oldexpect != XREF) {
+		    for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
+		    if (*t++ == ',') {
+			bufptr = skipspace(bufptr);
+			while (t < bufend && *t != ']') t++;
+			warn("Multidimensional syntax %.*s not supported",
+			    t-bufptr+1, bufptr);
+		    }
+		}
+		if (*s == '{' && strEQ(tokenbuf, "$SIG") &&
+		  (t = strchr(s,'}')) && (t = strchr(t,'='))) {
+		    char tmpbuf[1024];
+		    STRLEN len;
+		    for (t++; isSPACE(*t); t++) ;
+		    if (isIDFIRST(*t)) {
+			t = scan_word(t, tmpbuf, TRUE, &len);
+			if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
+			    warn("You need to quote \"%s\"", tmpbuf);
+		    }
+		}
+	    }
+	    expect = XOPERATOR;
+	    if (lex_state == LEX_NORMAL && isSPACE(*s)) {
+		bool islop = (last_lop == oldoldbufptr);
+		s = skipspace(s);
+		if (!islop || last_lop_op == OP_GREPSTART)
+		    expect = XOPERATOR;
+		else if (strchr("$@\"'`q", *s))
+		    expect = XTERM;		/* e.g. print $fh "foo" */
+		else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
+		    expect = XTERM;		/* e.g. print $fh &sub */
+		else if (isDIGIT(*s))
+		    expect = XTERM;		/* e.g. print $fh 3 */
+		else if (*s == '.' && isDIGIT(s[1]))
+		    expect = XTERM;		/* e.g. print $fh .3 */
+		else if (strchr("/?-+", *s) && !isSPACE(s[1]))
+		    expect = XTERM;		/* e.g. print $fh -1 */
+		else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
+		    expect = XTERM;		/* print $fh <<"EOF" */
+	    }
+	    if (in_my) {
+		if (strchr(tokenbuf,':'))
+		    croak(no_myglob,tokenbuf);
+		nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+		force_next(PRIVATEREF);
+	    }
+	    else if (!strchr(tokenbuf,':')) {
+		if (oldexpect != XREF || oldoldbufptr == last_lop) {
+		    if (intuit_more(s)) {
+			if (*s == '[')
+			    tokenbuf[0] = '@';
+			else if (*s == '{')
+			    tokenbuf[0] = '%';
+		    }
+		}
+		if (tmp = pad_findmy(tokenbuf)) {
+		    if (!tokenbuf[2] && *tokenbuf =='$' &&
+			tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a')
+		    {
+			for (d = in_eval ? oldoldbufptr : SvPVX(linestr);
+			    d < bufend && *d != '\n';
+			    d++)
+			{
+			    if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+			        croak("Can't use \"my %s\" in sort comparison",
+				    tokenbuf);
+			    }
+			}
+		    }
+		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		    nextval[nexttoke].opval->op_targ = tmp;
+		    force_next(PRIVATEREF);
+		}
+		else
+		    force_ident(tokenbuf+1, *tokenbuf);
+	    }
+	    else
+		force_ident(tokenbuf+1, *tokenbuf);
+	}
+	else {
+	    if (s == bufend)
+		yyerror("Final $ should be \\$ or $name");
+	    PREREF('$');
+	}
+	TOKEN('$');
+
+    case '@':
+	s = scan_ident(s, bufend, tokenbuf+1, FALSE);
+	if (expect == XOPERATOR)
+	    no_op("Array",s);
+	if (tokenbuf[1]) {
+	    GV* gv;
+
+	    tokenbuf[0] = '@';
+	    expect = XOPERATOR;
+	    if (in_my) {
+		if (strchr(tokenbuf,':'))
+		    croak(no_myglob,tokenbuf);
+		nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
+		force_next(PRIVATEREF);
+		TERM('@');
+	    }
+	    else if (!strchr(tokenbuf,':')) {
+		if (intuit_more(s)) {
+		    if (*s == '{')
+			tokenbuf[0] = '%';
+		}
+		if (tmp = pad_findmy(tokenbuf)) {
+		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
+		    nextval[nexttoke].opval->op_targ = tmp;
+		    force_next(PRIVATEREF);
+		    TERM('@');
+		}
+	    }
+
+	    /* Force them to make up their mind on "@foo". */
+	    if (lex_state != LEX_NORMAL && !lex_brackets &&
+		    ( !(gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV)) ||
+		      (*tokenbuf == '@'
+			? !GvAV(gv)
+			: !GvHV(gv) )))
+	    {
+		char tmpbuf[1024];
+		sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1);
+		yyerror(tmpbuf);
+	    }
+
+	    /* Warn about @ where they meant $. */
+	    if (dowarn) {
+		if (*s == '[' || *s == '{') {
+		    char *t = s + 1;
+		    while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
+			t++;
+		    if (*t == '}' || *t == ']') {
+			t++;
+			bufptr = skipspace(bufptr);
+			warn("Scalar value %.*s better written as $%.*s",
+			    t-bufptr, bufptr, t-bufptr-1, bufptr+1);
+		    }
+		}
+	    }
+	    force_ident(tokenbuf+1, *tokenbuf);
+	}
+	else {
+	    if (s == bufend)
+		yyerror("Final @ should be \\@ or @name");
+	    PREREF('@');
+	}
+	TERM('@');
+
+    case '/':			/* may either be division or pattern */
+    case '?':			/* may either be conditional or pattern */
+	if (expect != XOPERATOR) {
+	    check_uni();
+	    s = scan_pat(s);
+	    TERM(sublex_start());
+	}
+	tmp = *s++;
+	if (tmp == '/')
+	    Mop(OP_DIVIDE);
+	OPERATOR(tmp);
+
+    case '.':
+	if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
+		(s == SvPVX(linestr) || s[-1] == '\n') ) {
+	    lex_formbrack = 0;
+	    expect = XSTATE;
+	    goto rightbracket;
+	}
+	if (expect == XOPERATOR || !isDIGIT(s[1])) {
+	    tmp = *s++;
+	    if (*s == tmp) {
+		s++;
+		if (*s == tmp) {
+		    s++;
+		    yylval.ival = OPf_SPECIAL;
+		}
+		else
+		    yylval.ival = 0;
+		OPERATOR(DOTDOT);
+	    }
+	    if (expect != XOPERATOR)
+		check_uni();
+	    Aop(OP_CONCAT);
+	}
+	/* FALL THROUGH */
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+	s = scan_num(s);
+	if (expect == XOPERATOR)
+	    no_op("Number",s);
+	TERM(THING);
+
+    case '\'':
+	s = scan_str(s);
+	if (expect == XOPERATOR) {
+	    if (lex_formbrack && lex_brackets == lex_formbrack) {
+		expect = XTERM;
+		depcom();
+		return ',';	/* grandfather non-comma-format format */
+	    }
+	    else
+		no_op("String",s);
+	}
+	if (!s)
+	    missingterm((char*)0);
+	yylval.ival = OP_CONST;
+	TERM(sublex_start());
+
+    case '"':
+	s = scan_str(s);
+	if (expect == XOPERATOR) {
+	    if (lex_formbrack && lex_brackets == lex_formbrack) {
+		expect = XTERM;
+		depcom();
+		return ',';	/* grandfather non-comma-format format */
+	    }
+	    else
+		no_op("String",s);
+	}
+	if (!s)
+	    missingterm((char*)0);
+	yylval.ival = OP_CONST;
+	for (d = SvPV(lex_stuff, len); len; len--, d++) {
+	    if (*d == '$' || *d == '@' || *d == '\\') {
+		yylval.ival = OP_STRINGIFY;
+		break;
+	    }
+	}
+	TERM(sublex_start());
+
+    case '`':
+	s = scan_str(s);
+	if (expect == XOPERATOR)
+	    no_op("Backticks",s);
+	if (!s)
+	    missingterm((char*)0);
+	yylval.ival = OP_BACKTICK;
+	set_csh();
+	TERM(sublex_start());
+
+    case '\\':
+	s++;
+	if (dowarn && lex_inwhat && isDIGIT(*s))
+	    warn("Can't use \\%c to mean $%c in expression", *s, *s);
+	if (expect == XOPERATOR)
+	    no_op("Backslash",s);
+	OPERATOR(REFGEN);
+
+    case 'x':
+	if (isDIGIT(s[1]) && expect == XOPERATOR) {
+	    s++;
+	    Mop(OP_REPEAT);
+	}
+	goto keylookup;
+
+    case '_':
+    case 'a': case 'A':
+    case 'b': case 'B':
+    case 'c': case 'C':
+    case 'd': case 'D':
+    case 'e': case 'E':
+    case 'f': case 'F':
+    case 'g': case 'G':
+    case 'h': case 'H':
+    case 'i': case 'I':
+    case 'j': case 'J':
+    case 'k': case 'K':
+    case 'l': case 'L':
+    case 'm': case 'M':
+    case 'n': case 'N':
+    case 'o': case 'O':
+    case 'p': case 'P':
+    case 'q': case 'Q':
+    case 'r': case 'R':
+    case 's': case 'S':
+    case 't': case 'T':
+    case 'u': case 'U':
+    case 'v': case 'V':
+    case 'w': case 'W':
+	      case 'X':
+    case 'y': case 'Y':
+    case 'z': case 'Z':
+
+      keylookup:
+	bufptr = s;
+	s = scan_word(s, tokenbuf, FALSE, &len);
+	
+	if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
+	    goto just_a_word;
+
+	tmp = keyword(tokenbuf, len);
+
+	/* Is this a word before a => operator? */
+	d = s;
+	while (d < bufend && (*d == ' ' || *d == '\t'))
+		d++;	/* no comments skipped here, or s### is misparsed */
+	if (strnEQ(d,"=>",2)) {
+	    CLINE;
+	    if (dowarn && (tmp || perl_get_cv(tokenbuf, FALSE)))
+		warn("Ambiguous use of %s => resolved to \"%s\" =>",
+			tokenbuf, tokenbuf);
+	    yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+	    yylval.opval->op_private = OPpCONST_BARE;
+	    TERM(WORD);
+	}
+
+	if (tmp < 0) {			/* second-class keyword? */
+	    GV* gv;
+	    if (expect != XOPERATOR &&
+		(*s != ':' || s[1] != ':') &&
+		(gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
+		GvIMPORTED_CV(gv))
+	    {
+		tmp = 0;
+	    }
+	    else
+		tmp = -tmp;
+	}
+
+      reserved_word:
+	switch (tmp) {
+
+	default:			/* not a keyword */
+	  just_a_word: {
+		GV *gv;
+		char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
+
+		/* Get the rest if it looks like a package qualifier */
+
+		if (*s == '\'' || *s == ':' && s[1] == ':') {
+		    s = scan_word(s, tokenbuf + len, TRUE, &len);
+		    if (!len)
+			croak("Bad name after %s::", tokenbuf);
+		}
+
+		/* Do special processing at start of statement. */
+
+		if (expect == XSTATE) {
+		    while (isSPACE(*s)) s++;
+		    if (*s == ':') {	/* It's a label. */
+			yylval.pval = savepv(tokenbuf);
+			s++;
+			CLINE;
+			TOKEN(LABEL);
+		    }
+		}
+		else if (expect == XOPERATOR) {
+		    if (bufptr == SvPVX(linestr)) {
+			curcop->cop_line--;
+			warn(warn_nosemi);
+			curcop->cop_line++;
+		    }
+		    else
+			no_op("Bare word",s);
+		}
+
+		/* Look for a subroutine with this name in current package. */
+
+		gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
+
+		/* Presume this is going to be a bareword of some sort. */
+
+		CLINE;
+		yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+		yylval.opval->op_private = OPpCONST_BARE;
+
+		/* See if it's the indirect object for a list operator. */
+
+		if (oldoldbufptr &&
+		    oldoldbufptr < bufptr &&
+		    (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
+		    /* NO SKIPSPACE BEFORE HERE! */
+		    (expect == XREF ||
+		     (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+		{
+		    bool immediate_paren = *s == '(';
+
+		    /* (Now we can afford to cross potential line boundary.) */
+		    s = skipspace(s);
+
+		    /* Two barewords in a row may indicate method call. */
+
+		    if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
+			return tmp;
+
+		    /* If not a declared subroutine, it's an indirect object. */
+		    /* (But it's an indir obj regardless for sort.) */
+
+		    if ((last_lop_op == OP_SORT ||
+                         (!immediate_paren && (!gv || !GvCV(gv))) ) &&
+                        (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
+			expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
+			goto bareword;
+		    }
+		}
+
+		/* If followed by a paren, it's certainly a subroutine. */
+
+		expect = XOPERATOR;
+		s = skipspace(s);
+		if (*s == '(') {
+		    CLINE;
+		    nextval[nexttoke].opval = yylval.opval;
+		    expect = XOPERATOR;
+		    force_next(WORD);
+		    yylval.ival = 0;
+		    TOKEN('&');
+		}
+
+		/* If followed by var or block, call it a method (unless sub) */
+
+		if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
+		    last_lop = oldbufptr;
+		    last_lop_op = OP_METHOD;
+		    PREBLOCK(METHOD);
+		}
+
+		/* If followed by a bareword, see if it looks like indir obj. */
+
+		if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
+		    return tmp;
+
+		/* Not a method, so call it a subroutine (if defined) */
+
+		if (gv && GvCV(gv)) {
+		    CV* cv = GvCV(gv);
+		    if (*s == '(') {
+			nextval[nexttoke].opval = yylval.opval;
+			expect = XTERM;
+			force_next(WORD);
+			yylval.ival = 0;
+			TOKEN('&');
+		    }
+		    if (lastchar == '-')
+			warn("Ambiguous use of -%s resolved as -&%s()",
+				tokenbuf, tokenbuf);
+		    last_lop = oldbufptr;
+		    last_lop_op = OP_ENTERSUB;
+		    /* Resolve to GV now. */
+		    op_free(yylval.opval);
+		    yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+		    /* Is there a prototype? */
+		    if (SvPOK(cv)) {
+			STRLEN len;
+			char *proto = SvPV((SV*)cv, len);
+			if (!len)
+			    TERM(FUNC0SUB);
+			if (strEQ(proto, "$"))
+			    OPERATOR(UNIOPSUB);
+			if (*proto == '&' && *s == '{') {
+			    sv_setpv(subname,"__ANON__");
+			    PREBLOCK(LSTOPSUB);
+			}
+		    }
+		    nextval[nexttoke].opval = yylval.opval;
+		    expect = XTERM;
+		    force_next(WORD);
+		    TOKEN(NOAMP);
+		}
+
+		if (hints & HINT_STRICT_SUBS &&
+		    lastchar != '-' &&
+		    strnNE(s,"->",2) &&
+		    last_lop_op != OP_ACCEPT &&
+		    last_lop_op != OP_PIPE_OP &&
+		    last_lop_op != OP_SOCKPAIR)
+		{
+		    warn(
+		     "Bareword \"%s\" not allowed while \"strict subs\" in use",
+			tokenbuf);
+		    ++error_count;
+		}
+
+		/* Call it a bare word */
+
+	    bareword:
+		if (dowarn) {
+		    if (lastchar != '-') {
+			for (d = tokenbuf; *d && isLOWER(*d); d++) ;
+			if (!*d)
+			    warn(warn_reserved, tokenbuf);
+		    }
+		}
+		if (lastchar && strchr("*%&", lastchar)) {
+		    warn("Operator or semicolon missing before %c%s",
+			lastchar, tokenbuf);
+		    warn("Ambiguous use of %c resolved as operator %c",
+			lastchar, lastchar);
+		}
+		TOKEN(WORD);
+	    }
+
+	case KEY___LINE__:
+	case KEY___FILE__: {
+	    if (tokenbuf[2] == 'L')
+		(void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
+	    else
+		strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
+	    yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+	    TERM(THING);
+	}
+
+	case KEY___DATA__:
+	case KEY___END__: {
+	    GV *gv;
+
+	    /*SUPPRESS 560*/
+	    if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
+		char dname[256];
+		char *pname = "main";
+		if (tokenbuf[2] == 'D')
+		    pname = HvNAME(curstash ? curstash : defstash);
+		sprintf(dname,"%s::DATA", pname);
+		gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
+		GvMULTI_on(gv);
+		if (!GvIO(gv))
+		    GvIOp(gv) = newIO();
+		IoIFP(GvIOp(gv)) = rsfp;
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+		{
+		    int fd = fileno(rsfp);
+		    fcntl(fd,F_SETFD,fd >= 3);
+		}
+#endif
+		if (preprocess)
+		    IoTYPE(GvIOp(gv)) = '|';
+		else if ((FILE*)rsfp == stdin)
+		    IoTYPE(GvIOp(gv)) = '-';
+		else
+		    IoTYPE(GvIOp(gv)) = '<';
+		rsfp = Nullfp;
+	    }
+	    goto fake_eof;
+	}
+
+	case KEY_AUTOLOAD:
+	case KEY_DESTROY:
+	case KEY_BEGIN:
+	case KEY_END:
+	    if (expect == XSTATE) {
+		s = bufptr;
+		goto really_sub;
+	    }
+	    goto just_a_word;
+
+	case KEY_CORE:
+	    if (*s == ':' && s[1] == ':') {
+		s += 2;
+		d = s;
+		s = scan_word(s, tokenbuf, FALSE, &len);
+		tmp = keyword(tokenbuf, len);
+		if (tmp < 0)
+		    tmp = -tmp;
+		goto reserved_word;
+	    }
+	    goto just_a_word;
+
+	case KEY_abs:
+	    UNI(OP_ABS);
+
+	case KEY_alarm:
+	    UNI(OP_ALARM);
+
+	case KEY_accept:
+	    LOP(OP_ACCEPT,XTERM);
+
+	case KEY_and:
+	    OPERATOR(ANDOP);
+
+	case KEY_atan2:
+	    LOP(OP_ATAN2,XTERM);
+
+	case KEY_bind:
+	    LOP(OP_BIND,XTERM);
+
+	case KEY_binmode:
+	    UNI(OP_BINMODE);
+
+	case KEY_bless:
+	    LOP(OP_BLESS,XTERM);
+
+	case KEY_chop:
+	    UNI(OP_CHOP);
+
+	case KEY_continue:
+	    PREBLOCK(CONTINUE);
+
+	case KEY_chdir:
+	    (void)gv_fetchpv("ENV",TRUE, SVt_PVHV);	/* may use HOME */
+	    UNI(OP_CHDIR);
+
+	case KEY_close:
+	    UNI(OP_CLOSE);
+
+	case KEY_closedir:
+	    UNI(OP_CLOSEDIR);
+
+	case KEY_cmp:
+	    Eop(OP_SCMP);
+
+	case KEY_caller:
+	    UNI(OP_CALLER);
+
+	case KEY_crypt:
+#ifdef FCRYPT
+	    if (!cryptseen++)
+		init_des();
+#endif
+	    LOP(OP_CRYPT,XTERM);
+
+	case KEY_chmod:
+	    if (dowarn) {
+		for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+		if (*d != '0' && isDIGIT(*d))
+		    yywarn("chmod: mode argument is missing initial 0");
+	    }
+	    LOP(OP_CHMOD,XTERM);
+
+	case KEY_chown:
+	    LOP(OP_CHOWN,XTERM);
+
+	case KEY_connect:
+	    LOP(OP_CONNECT,XTERM);
+
+	case KEY_chr:
+	    UNI(OP_CHR);
+
+	case KEY_cos:
+	    UNI(OP_COS);
+
+	case KEY_chroot:
+	    UNI(OP_CHROOT);
+
+	case KEY_do:
+	    s = skipspace(s);
+	    if (*s == '{')
+		PRETERMBLOCK(DO);
+	    if (*s != '\'')
+		s = force_word(s,WORD,FALSE,TRUE,FALSE);
+	    OPERATOR(DO);
+
+	case KEY_die:
+	    hints |= HINT_BLOCK_SCOPE;
+	    LOP(OP_DIE,XTERM);
+
+	case KEY_defined:
+	    UNI(OP_DEFINED);
+
+	case KEY_delete:
+	    UNI(OP_DELETE);
+
+	case KEY_dbmopen:
+	    gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
+	    LOP(OP_DBMOPEN,XTERM);
+
+	case KEY_dbmclose:
+	    UNI(OP_DBMCLOSE);
+
+	case KEY_dump:
+	    s = force_word(s,WORD,TRUE,FALSE,FALSE);
+	    LOOPX(OP_DUMP);
+
+	case KEY_else:
+	    PREBLOCK(ELSE);
+
+	case KEY_elsif:
+	    yylval.ival = curcop->cop_line;
+	    OPERATOR(ELSIF);
+
+	case KEY_eq:
+	    Eop(OP_SEQ);
+
+	case KEY_exists:
+	    UNI(OP_EXISTS);
+	    
+	case KEY_exit:
+	    UNI(OP_EXIT);
+
+	case KEY_eval:
+	    s = skipspace(s);
+	    expect = (*s == '{') ? XTERMBLOCK : XTERM;
+	    UNIBRACK(OP_ENTEREVAL);
+
+	case KEY_eof:
+	    UNI(OP_EOF);
+
+	case KEY_exp:
+	    UNI(OP_EXP);
+
+	case KEY_each:
+	    UNI(OP_EACH);
+
+	case KEY_exec:
+	    set_csh();
+	    LOP(OP_EXEC,XREF);
+
+	case KEY_endhostent:
+	    FUN0(OP_EHOSTENT);
+
+	case KEY_endnetent:
+	    FUN0(OP_ENETENT);
+
+	case KEY_endservent:
+	    FUN0(OP_ESERVENT);
+
+	case KEY_endprotoent:
+	    FUN0(OP_EPROTOENT);
+
+	case KEY_endpwent:
+	    FUN0(OP_EPWENT);
+
+	case KEY_endgrent:
+	    FUN0(OP_EGRENT);
+
+	case KEY_for:
+	case KEY_foreach:
+	    yylval.ival = curcop->cop_line;
+	    while (s < bufend && isSPACE(*s))
+		s++;
+	    if (isIDFIRST(*s))
+		croak("Missing $ on loop variable");
+	    OPERATOR(FOR);
+
+	case KEY_formline:
+	    LOP(OP_FORMLINE,XTERM);
+
+	case KEY_fork:
+	    FUN0(OP_FORK);
+
+	case KEY_fcntl:
+	    LOP(OP_FCNTL,XTERM);
+
+	case KEY_fileno:
+	    UNI(OP_FILENO);
+
+	case KEY_flock:
+	    LOP(OP_FLOCK,XTERM);
+
+	case KEY_gt:
+	    Rop(OP_SGT);
+
+	case KEY_ge:
+	    Rop(OP_SGE);
+
+	case KEY_grep:
+	    LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
+
+	case KEY_goto:
+	    s = force_word(s,WORD,TRUE,FALSE,FALSE);
+	    LOOPX(OP_GOTO);
+
+	case KEY_gmtime:
+	    UNI(OP_GMTIME);
+
+	case KEY_getc:
+	    UNI(OP_GETC);
+
+	case KEY_getppid:
+	    FUN0(OP_GETPPID);
+
+	case KEY_getpgrp:
+	    UNI(OP_GETPGRP);
+
+	case KEY_getpriority:
+	    LOP(OP_GETPRIORITY,XTERM);
+
+	case KEY_getprotobyname:
+	    UNI(OP_GPBYNAME);
+
+	case KEY_getprotobynumber:
+	    LOP(OP_GPBYNUMBER,XTERM);
+
+	case KEY_getprotoent:
+	    FUN0(OP_GPROTOENT);
+
+	case KEY_getpwent:
+	    FUN0(OP_GPWENT);
+
+	case KEY_getpwnam:
+	    FUN1(OP_GPWNAM);
+
+	case KEY_getpwuid:
+	    FUN1(OP_GPWUID);
+
+	case KEY_getpeername:
+	    UNI(OP_GETPEERNAME);
+
+	case KEY_gethostbyname:
+	    UNI(OP_GHBYNAME);
+
+	case KEY_gethostbyaddr:
+	    LOP(OP_GHBYADDR,XTERM);
+
+	case KEY_gethostent:
+	    FUN0(OP_GHOSTENT);
+
+	case KEY_getnetbyname:
+	    UNI(OP_GNBYNAME);
+
+	case KEY_getnetbyaddr:
+	    LOP(OP_GNBYADDR,XTERM);
+
+	case KEY_getnetent:
+	    FUN0(OP_GNETENT);
+
+	case KEY_getservbyname:
+	    LOP(OP_GSBYNAME,XTERM);
+
+	case KEY_getservbyport:
+	    LOP(OP_GSBYPORT,XTERM);
+
+	case KEY_getservent:
+	    FUN0(OP_GSERVENT);
+
+	case KEY_getsockname:
+	    UNI(OP_GETSOCKNAME);
+
+	case KEY_getsockopt:
+	    LOP(OP_GSOCKOPT,XTERM);
+
+	case KEY_getgrent:
+	    FUN0(OP_GGRENT);
+
+	case KEY_getgrnam:
+	    FUN1(OP_GGRNAM);
+
+	case KEY_getgrgid:
+	    FUN1(OP_GGRGID);
+
+	case KEY_getlogin:
+	    FUN0(OP_GETLOGIN);
+
+	case KEY_glob:
+	    set_csh();
+	    LOP(OP_GLOB,XTERM);
+
+	case KEY_hex:
+	    UNI(OP_HEX);
+
+	case KEY_if:
+	    yylval.ival = curcop->cop_line;
+	    OPERATOR(IF);
+
+	case KEY_index:
+	    LOP(OP_INDEX,XTERM);
+
+	case KEY_int:
+	    UNI(OP_INT);
+
+	case KEY_ioctl:
+	    LOP(OP_IOCTL,XTERM);
+
+	case KEY_join:
+	    LOP(OP_JOIN,XTERM);
+
+	case KEY_keys:
+	    UNI(OP_KEYS);
+
+	case KEY_kill:
+	    LOP(OP_KILL,XTERM);
+
+	case KEY_last:
+	    s = force_word(s,WORD,TRUE,FALSE,FALSE);
+	    LOOPX(OP_LAST);
+	    
+	case KEY_lc:
+	    UNI(OP_LC);
+
+	case KEY_lcfirst:
+	    UNI(OP_LCFIRST);
+
+	case KEY_local:
+	    yylval.ival = 0;
+	    OPERATOR(LOCAL);
+
+	case KEY_length:
+	    UNI(OP_LENGTH);
+
+	case KEY_lt:
+	    Rop(OP_SLT);
+
+	case KEY_le:
+	    Rop(OP_SLE);
+
+	case KEY_localtime:
+	    UNI(OP_LOCALTIME);
+
+	case KEY_log:
+	    UNI(OP_LOG);
+
+	case KEY_link:
+	    LOP(OP_LINK,XTERM);
+
+	case KEY_listen:
+	    LOP(OP_LISTEN,XTERM);
+
+	case KEY_lstat:
+	    UNI(OP_LSTAT);
+
+	case KEY_m:
+	    s = scan_pat(s);
+	    TERM(sublex_start());
+
+	case KEY_map:
+	    LOP(OP_MAPSTART,XREF);
+	    
+	case KEY_mkdir:
+	    LOP(OP_MKDIR,XTERM);
+
+	case KEY_msgctl:
+	    LOP(OP_MSGCTL,XTERM);
+
+	case KEY_msgget:
+	    LOP(OP_MSGGET,XTERM);
+
+	case KEY_msgrcv:
+	    LOP(OP_MSGRCV,XTERM);
+
+	case KEY_msgsnd:
+	    LOP(OP_MSGSND,XTERM);
+
+	case KEY_my:
+	    in_my = TRUE;
+	    yylval.ival = 1;
+	    OPERATOR(LOCAL);
+
+	case KEY_next:
+	    s = force_word(s,WORD,TRUE,FALSE,FALSE);
+	    LOOPX(OP_NEXT);
+
+	case KEY_ne:
+	    Eop(OP_SNE);
+
+	case KEY_no:
+	    if (expect != XSTATE)
+		yyerror("\"no\" not allowed in expression");
+	    s = force_word(s,WORD,FALSE,TRUE,FALSE);
+	    yylval.ival = 0;
+	    OPERATOR(USE);
+
+	case KEY_not:
+	    OPERATOR(NOTOP);
+
+	case KEY_open:
+	    s = skipspace(s);
+	    if (isIDFIRST(*s)) {
+		char *t;
+		for (d = s; isALNUM(*d); d++) ;
+		t = skipspace(d);
+		if (strchr("|&*+-=!?:.", *t))
+		    warn("Precedence problem: open %.*s should be open(%.*s)",
+			d-s,s, d-s,s);
+	    }
+	    LOP(OP_OPEN,XTERM);
+
+	case KEY_or:
+	    yylval.ival = OP_OR;
+	    OPERATOR(OROP);
+
+	case KEY_ord:
+	    UNI(OP_ORD);
+
+	case KEY_oct:
+	    UNI(OP_OCT);
+
+	case KEY_opendir:
+	    LOP(OP_OPEN_DIR,XTERM);
+
+	case KEY_print:
+	    checkcomma(s,tokenbuf,"filehandle");
+	    LOP(OP_PRINT,XREF);
+
+	case KEY_printf:
+	    checkcomma(s,tokenbuf,"filehandle");
+	    LOP(OP_PRTF,XREF);
+
+	case KEY_prototype:
+	    UNI(OP_PROTOTYPE);
+
+	case KEY_push:
+	    LOP(OP_PUSH,XTERM);
+
+	case KEY_pop:
+	    UNI(OP_POP);
+
+	case KEY_pos:
+	    UNI(OP_POS);
+	    
+	case KEY_pack:
+	    LOP(OP_PACK,XTERM);
+
+	case KEY_package:
+	    s = force_word(s,WORD,FALSE,TRUE,FALSE);
+	    OPERATOR(PACKAGE);
+
+	case KEY_pipe:
+	    LOP(OP_PIPE_OP,XTERM);
+
+	case KEY_q:
+	    s = scan_str(s);
+	    if (!s)
+		missingterm((char*)0);
+	    yylval.ival = OP_CONST;
+	    TERM(sublex_start());
+
+	case KEY_quotemeta:
+	    UNI(OP_QUOTEMETA);
+
+	case KEY_qw:
+	    s = scan_str(s);
+	    if (!s)
+		missingterm((char*)0);
+	    force_next(')');
+	    nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
+	    lex_stuff = Nullsv;
+	    force_next(THING);
+	    force_next(',');
+	    nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
+	    force_next(THING);
+	    force_next('(');
+	    yylval.ival = OP_SPLIT;
+	    CLINE;
+	    expect = XTERM;
+	    bufptr = s;
+	    last_lop = oldbufptr;
+	    last_lop_op = OP_SPLIT;
+	    return FUNC;
+
+	case KEY_qq:
+	    s = scan_str(s);
+	    if (!s)
+		missingterm((char*)0);
+	    yylval.ival = OP_STRINGIFY;
+	    if (SvIVX(lex_stuff) == '\'')
+		SvIVX(lex_stuff) = 0;	/* qq'$foo' should intepolate */
+	    TERM(sublex_start());
+
+	case KEY_qx:
+	    s = scan_str(s);
+	    if (!s)
+		missingterm((char*)0);
+	    yylval.ival = OP_BACKTICK;
+	    set_csh();
+	    TERM(sublex_start());
+
+	case KEY_return:
+	    OLDLOP(OP_RETURN);
+
+	case KEY_require:
+	    *tokenbuf = '\0';
+	    s = force_word(s,WORD,TRUE,TRUE,FALSE);
+	    if (isIDFIRST(*tokenbuf))
+		gv_stashpv(tokenbuf, TRUE);
+	    else if (*s == '<')
+		yyerror("<> should be quotes");
+	    UNI(OP_REQUIRE);
+
+	case KEY_reset:
+	    UNI(OP_RESET);
+
+	case KEY_redo:
+	    s = force_word(s,WORD,TRUE,FALSE,FALSE);
+	    LOOPX(OP_REDO);
+
+	case KEY_rename:
+	    LOP(OP_RENAME,XTERM);
+
+	case KEY_rand:
+	    UNI(OP_RAND);
+
+	case KEY_rmdir:
+	    UNI(OP_RMDIR);
+
+	case KEY_rindex:
+	    LOP(OP_RINDEX,XTERM);
+
+	case KEY_read:
+	    LOP(OP_READ,XTERM);
+
+	case KEY_readdir:
+	    UNI(OP_READDIR);
+
+	case KEY_readline:
+	    set_csh();
+	    UNI(OP_READLINE);
+
+	case KEY_readpipe:
+	    set_csh();
+	    UNI(OP_BACKTICK);
+
+	case KEY_rewinddir:
+	    UNI(OP_REWINDDIR);
+
+	case KEY_recv:
+	    LOP(OP_RECV,XTERM);
+
+	case KEY_reverse:
+	    LOP(OP_REVERSE,XTERM);
+
+	case KEY_readlink:
+	    UNI(OP_READLINK);
+
+	case KEY_ref:
+	    UNI(OP_REF);
+
+	case KEY_s:
+	    s = scan_subst(s);
+	    if (yylval.opval)
+		TERM(sublex_start());
+	    else
+		TOKEN(1);	/* force error */
+
+	case KEY_chomp:
+	    UNI(OP_CHOMP);
+	    
+	case KEY_scalar:
+	    UNI(OP_SCALAR);
+
+	case KEY_select:
+	    LOP(OP_SELECT,XTERM);
+
+	case KEY_seek:
+	    LOP(OP_SEEK,XTERM);
+
+	case KEY_semctl:
+	    LOP(OP_SEMCTL,XTERM);
+
+	case KEY_semget:
+	    LOP(OP_SEMGET,XTERM);
+
+	case KEY_semop:
+	    LOP(OP_SEMOP,XTERM);
+
+	case KEY_send:
+	    LOP(OP_SEND,XTERM);
+
+	case KEY_setpgrp:
+	    LOP(OP_SETPGRP,XTERM);
+
+	case KEY_setpriority:
+	    LOP(OP_SETPRIORITY,XTERM);
+
+	case KEY_sethostent:
+	    FUN1(OP_SHOSTENT);
+
+	case KEY_setnetent:
+	    FUN1(OP_SNETENT);
+
+	case KEY_setservent:
+	    FUN1(OP_SSERVENT);
+
+	case KEY_setprotoent:
+	    FUN1(OP_SPROTOENT);
+
+	case KEY_setpwent:
+	    FUN0(OP_SPWENT);
+
+	case KEY_setgrent:
+	    FUN0(OP_SGRENT);
+
+	case KEY_seekdir:
+	    LOP(OP_SEEKDIR,XTERM);
+
+	case KEY_setsockopt:
+	    LOP(OP_SSOCKOPT,XTERM);
+
+	case KEY_shift:
+	    UNI(OP_SHIFT);
+
+	case KEY_shmctl:
+	    LOP(OP_SHMCTL,XTERM);
+
+	case KEY_shmget:
+	    LOP(OP_SHMGET,XTERM);
+
+	case KEY_shmread:
+	    LOP(OP_SHMREAD,XTERM);
+
+	case KEY_shmwrite:
+	    LOP(OP_SHMWRITE,XTERM);
+
+	case KEY_shutdown:
+	    LOP(OP_SHUTDOWN,XTERM);
+
+	case KEY_sin:
+	    UNI(OP_SIN);
+
+	case KEY_sleep:
+	    UNI(OP_SLEEP);
+
+	case KEY_socket:
+	    LOP(OP_SOCKET,XTERM);
+
+	case KEY_socketpair:
+	    LOP(OP_SOCKPAIR,XTERM);
+
+	case KEY_sort:
+	    checkcomma(s,tokenbuf,"subroutine name");
+	    s = skipspace(s);
+	    if (*s == ';' || *s == ')')		/* probably a close */
+		croak("sort is now a reserved word");
+	    expect = XTERM;
+	    s = force_word(s,WORD,TRUE,TRUE,TRUE);
+	    LOP(OP_SORT,XREF);
+
+	case KEY_split:
+	    LOP(OP_SPLIT,XTERM);
+
+	case KEY_sprintf:
+	    LOP(OP_SPRINTF,XTERM);
+
+	case KEY_splice:
+	    LOP(OP_SPLICE,XTERM);
+
+	case KEY_sqrt:
+	    UNI(OP_SQRT);
+
+	case KEY_srand:
+	    UNI(OP_SRAND);
+
+	case KEY_stat:
+	    UNI(OP_STAT);
+
+	case KEY_study:
+	    sawstudy++;
+	    UNI(OP_STUDY);
+
+	case KEY_substr:
+	    LOP(OP_SUBSTR,XTERM);
+
+	case KEY_format:
+	case KEY_sub:
+	  really_sub:
+	    s = skipspace(s);
+
+	    if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
+		char tmpbuf[128];
+		expect = XBLOCK;
+		d = scan_word(s, tmpbuf, TRUE, &len);
+		if (strchr(tmpbuf, ':'))
+		    sv_setpv(subname, tmpbuf);
+		else {
+		    sv_setsv(subname,curstname);
+		    sv_catpvn(subname,"::",2);
+		    sv_catpvn(subname,tmpbuf,len);
+		}
+		s = force_word(s,WORD,FALSE,TRUE,TRUE);
+		s = skipspace(s);
+	    }
+	    else {
+		expect = XTERMBLOCK;
+		sv_setpv(subname,"?");
+	    }
+
+	    if (tmp == KEY_format) {
+		s = skipspace(s);
+		if (*s == '=')
+		    lex_formbrack = lex_brackets + 1;
+		OPERATOR(FORMAT);
+	    }
+
+	    /* Look for a prototype */
+	    if (*s == '(') {
+		s = scan_str(s);
+		if (!s) {
+		    if (lex_stuff)
+			SvREFCNT_dec(lex_stuff);
+		    lex_stuff = Nullsv;
+		    croak("Prototype not terminated");
+		}
+		nexttoke++;
+		nextval[1] = nextval[0];
+		nexttype[1] = nexttype[0];
+		nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
+		nexttype[0] = THING;
+		if (nexttoke == 1) {
+		    lex_defer = lex_state;
+		    lex_expect = expect;
+		    lex_state = LEX_KNOWNEXT;
+		}
+		lex_stuff = Nullsv;
+	    }
+
+	    if (*SvPV(subname,na) == '?') {
+		sv_setpv(subname,"__ANON__");
+		TOKEN(ANONSUB);
+	    }
+	    PREBLOCK(SUB);
+
+	case KEY_system:
+	    set_csh();
+	    LOP(OP_SYSTEM,XREF);
+
+	case KEY_symlink:
+	    LOP(OP_SYMLINK,XTERM);
+
+	case KEY_syscall:
+	    LOP(OP_SYSCALL,XTERM);
+
+	case KEY_sysopen:
+	    LOP(OP_SYSOPEN,XTERM);
+
+	case KEY_sysread:
+	    LOP(OP_SYSREAD,XTERM);
+
+	case KEY_syswrite:
+	    LOP(OP_SYSWRITE,XTERM);
+
+	case KEY_tr:
+	    s = scan_trans(s);
+	    TERM(sublex_start());
+
+	case KEY_tell:
+	    UNI(OP_TELL);
+
+	case KEY_telldir:
+	    UNI(OP_TELLDIR);
+
+	case KEY_tie:
+	    LOP(OP_TIE,XTERM);
+
+	case KEY_tied:
+	    UNI(OP_TIED);
+
+	case KEY_time:
+	    FUN0(OP_TIME);
+
+	case KEY_times:
+	    FUN0(OP_TMS);
+
+	case KEY_truncate:
+	    LOP(OP_TRUNCATE,XTERM);
+
+	case KEY_uc:
+	    UNI(OP_UC);
+
+	case KEY_ucfirst:
+	    UNI(OP_UCFIRST);
+
+	case KEY_untie:
+	    UNI(OP_UNTIE);
+
+	case KEY_until:
+	    yylval.ival = curcop->cop_line;
+	    OPERATOR(UNTIL);
+
+	case KEY_unless:
+	    yylval.ival = curcop->cop_line;
+	    OPERATOR(UNLESS);
+
+	case KEY_unlink:
+	    LOP(OP_UNLINK,XTERM);
+
+	case KEY_undef:
+	    UNI(OP_UNDEF);
+
+	case KEY_unpack:
+	    LOP(OP_UNPACK,XTERM);
+
+	case KEY_utime:
+	    LOP(OP_UTIME,XTERM);
+
+	case KEY_umask:
+	    if (dowarn) {
+		for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
+		if (*d != '0' && isDIGIT(*d))
+		    yywarn("umask: argument is missing initial 0");
+	    }
+	    UNI(OP_UMASK);
+
+	case KEY_unshift:
+	    LOP(OP_UNSHIFT,XTERM);
+
+	case KEY_use:
+	    if (expect != XSTATE)
+		yyerror("\"use\" not allowed in expression");
+	    s = force_word(s,WORD,FALSE,TRUE,FALSE);
+	    yylval.ival = 1;
+	    OPERATOR(USE);
+
+	case KEY_values:
+	    UNI(OP_VALUES);
+
+	case KEY_vec:
+	    sawvec = TRUE;
+	    LOP(OP_VEC,XTERM);
+
+	case KEY_while:
+	    yylval.ival = curcop->cop_line;
+	    OPERATOR(WHILE);
+
+	case KEY_warn:
+	    hints |= HINT_BLOCK_SCOPE;
+	    LOP(OP_WARN,XTERM);
+
+	case KEY_wait:
+	    FUN0(OP_WAIT);
+
+	case KEY_waitpid:
+	    LOP(OP_WAITPID,XTERM);
+
+	case KEY_wantarray:
+	    FUN0(OP_WANTARRAY);
+
+	case KEY_write:
+	    gv_fetchpv("\f",TRUE, SVt_PV);	/* Make sure $^L is defined */
+	    UNI(OP_ENTERWRITE);
+
+	case KEY_x:
+	    if (expect == XOPERATOR)
+		Mop(OP_REPEAT);
+	    check_uni();
+	    goto just_a_word;
+
+	case KEY_xor:
+	    yylval.ival = OP_XOR;
+	    OPERATOR(OROP);
+
+	case KEY_y:
+	    s = scan_trans(s);
+	    TERM(sublex_start());
+	}
+    }
+}
+
+I32
+keyword(d, len)
+register char *d;
+I32 len;
+{
+    switch (*d) {
+    case '_':
+	if (d[1] == '_') {
+	    if (strEQ(d,"__LINE__"))		return -KEY___LINE__;
+	    if (strEQ(d,"__FILE__"))		return -KEY___FILE__;
+	    if (strEQ(d,"__DATA__"))		return KEY___DATA__;
+	    if (strEQ(d,"__END__"))		return KEY___END__;
+	}
+	break;
+    case 'A':
+	if (strEQ(d,"AUTOLOAD"))		return KEY_AUTOLOAD;
+	break;
+    case 'a':
+	switch (len) {
+	case 3:
+	    if (strEQ(d,"and"))			return -KEY_and;
+	    if (strEQ(d,"abs"))			return -KEY_abs;
+	    break;
+	case 5:
+	    if (strEQ(d,"alarm"))		return -KEY_alarm;
+	    if (strEQ(d,"atan2"))		return -KEY_atan2;
+	    break;
+	case 6:
+	    if (strEQ(d,"accept"))		return -KEY_accept;
+	    break;
+	}
+	break;
+    case 'B':
+	if (strEQ(d,"BEGIN"))			return KEY_BEGIN;
+	break;
+    case 'b':
+	if (strEQ(d,"bless"))			return -KEY_bless;
+	if (strEQ(d,"bind"))			return -KEY_bind;
+	if (strEQ(d,"binmode"))			return -KEY_binmode;
+	break;
+    case 'C':
+	if (strEQ(d,"CORE"))			return -KEY_CORE;
+	break;
+    case 'c':
+	switch (len) {
+	case 3:
+	    if (strEQ(d,"cmp"))			return -KEY_cmp;
+	    if (strEQ(d,"chr"))			return -KEY_chr;
+	    if (strEQ(d,"cos"))			return -KEY_cos;
+	    break;
+	case 4:
+	    if (strEQ(d,"chop"))		return KEY_chop;
+	    break;
+	case 5:
+	    if (strEQ(d,"close"))		return -KEY_close;
+	    if (strEQ(d,"chdir"))		return -KEY_chdir;
+	    if (strEQ(d,"chomp"))		return KEY_chomp;
+	    if (strEQ(d,"chmod"))		return -KEY_chmod;
+	    if (strEQ(d,"chown"))		return -KEY_chown;
+	    if (strEQ(d,"crypt"))		return -KEY_crypt;
+	    break;
+	case 6:
+	    if (strEQ(d,"chroot"))		return -KEY_chroot;
+	    if (strEQ(d,"caller"))		return -KEY_caller;
+	    break;
+	case 7:
+	    if (strEQ(d,"connect"))		return -KEY_connect;
+	    break;
+	case 8:
+	    if (strEQ(d,"closedir"))		return -KEY_closedir;
+	    if (strEQ(d,"continue"))		return -KEY_continue;
+	    break;
+	}
+	break;
+    case 'D':
+	if (strEQ(d,"DESTROY"))			return KEY_DESTROY;
+	break;
+    case 'd':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"do"))			return KEY_do;
+	    break;
+	case 3:
+	    if (strEQ(d,"die"))			return -KEY_die;
+	    break;
+	case 4:
+	    if (strEQ(d,"dump"))		return -KEY_dump;
+	    break;
+	case 6:
+	    if (strEQ(d,"delete"))		return KEY_delete;
+	    break;
+	case 7:
+	    if (strEQ(d,"defined"))		return KEY_defined;
+	    if (strEQ(d,"dbmopen"))		return -KEY_dbmopen;
+	    break;
+	case 8:
+	    if (strEQ(d,"dbmclose"))		return -KEY_dbmclose;
+	    break;
+	}
+	break;
+    case 'E':
+	if (strEQ(d,"EQ")) { deprecate(d);	return -KEY_eq;}
+	if (strEQ(d,"END"))			return KEY_END;
+	break;
+    case 'e':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"eq"))			return -KEY_eq;
+	    break;
+	case 3:
+	    if (strEQ(d,"eof"))			return -KEY_eof;
+	    if (strEQ(d,"exp"))			return -KEY_exp;
+	    break;
+	case 4:
+	    if (strEQ(d,"else"))		return KEY_else;
+	    if (strEQ(d,"exit"))		return -KEY_exit;
+	    if (strEQ(d,"eval"))		return KEY_eval;
+	    if (strEQ(d,"exec"))		return -KEY_exec;
+	    if (strEQ(d,"each"))		return KEY_each;
+	    break;
+	case 5:
+	    if (strEQ(d,"elsif"))		return KEY_elsif;
+	    break;
+	case 6:
+	    if (strEQ(d,"exists"))		return KEY_exists;
+	    if (strEQ(d,"elseif")) warn("elseif should be elsif");
+	    break;
+	case 8:
+	    if (strEQ(d,"endgrent"))		return -KEY_endgrent;
+	    if (strEQ(d,"endpwent"))		return -KEY_endpwent;
+	    break;
+	case 9:
+	    if (strEQ(d,"endnetent"))		return -KEY_endnetent;
+	    break;
+	case 10:
+	    if (strEQ(d,"endhostent"))		return -KEY_endhostent;
+	    if (strEQ(d,"endservent"))		return -KEY_endservent;
+	    break;
+	case 11:
+	    if (strEQ(d,"endprotoent"))		return -KEY_endprotoent;
+	    break;
+	}
+	break;
+    case 'f':
+	switch (len) {
+	case 3:
+	    if (strEQ(d,"for"))			return KEY_for;
+	    break;
+	case 4:
+	    if (strEQ(d,"fork"))		return -KEY_fork;
+	    break;
+	case 5:
+	    if (strEQ(d,"fcntl"))		return -KEY_fcntl;
+	    if (strEQ(d,"flock"))		return -KEY_flock;
+	    break;
+	case 6:
+	    if (strEQ(d,"format"))		return KEY_format;
+	    if (strEQ(d,"fileno"))		return -KEY_fileno;
+	    break;
+	case 7:
+	    if (strEQ(d,"foreach"))		return KEY_foreach;
+	    break;
+	case 8:
+	    if (strEQ(d,"formline"))		return -KEY_formline;
+	    break;
+	}
+	break;
+    case 'G':
+	if (len == 2) {
+	    if (strEQ(d,"GT")) { deprecate(d);	return -KEY_gt;}
+	    if (strEQ(d,"GE")) { deprecate(d);	return -KEY_ge;}
+	}
+	break;
+    case 'g':
+	if (strnEQ(d,"get",3)) {
+	    d += 3;
+	    if (*d == 'p') {
+		switch (len) {
+		case 7:
+		    if (strEQ(d,"ppid"))	return -KEY_getppid;
+		    if (strEQ(d,"pgrp"))	return -KEY_getpgrp;
+		    break;
+		case 8:
+		    if (strEQ(d,"pwent"))	return -KEY_getpwent;
+		    if (strEQ(d,"pwnam"))	return -KEY_getpwnam;
+		    if (strEQ(d,"pwuid"))	return -KEY_getpwuid;
+		    break;
+		case 11:
+		    if (strEQ(d,"peername"))	return -KEY_getpeername;
+		    if (strEQ(d,"protoent"))	return -KEY_getprotoent;
+		    if (strEQ(d,"priority"))	return -KEY_getpriority;
+		    break;
+		case 14:
+		    if (strEQ(d,"protobyname"))	return -KEY_getprotobyname;
+		    break;
+		case 16:
+		    if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
+		    break;
+		}
+	    }
+	    else if (*d == 'h') {
+		if (strEQ(d,"hostbyname"))	return -KEY_gethostbyname;
+		if (strEQ(d,"hostbyaddr"))	return -KEY_gethostbyaddr;
+		if (strEQ(d,"hostent"))		return -KEY_gethostent;
+	    }
+	    else if (*d == 'n') {
+		if (strEQ(d,"netbyname"))	return -KEY_getnetbyname;
+		if (strEQ(d,"netbyaddr"))	return -KEY_getnetbyaddr;
+		if (strEQ(d,"netent"))		return -KEY_getnetent;
+	    }
+	    else if (*d == 's') {
+		if (strEQ(d,"servbyname"))	return -KEY_getservbyname;
+		if (strEQ(d,"servbyport"))	return -KEY_getservbyport;
+		if (strEQ(d,"servent"))		return -KEY_getservent;
+		if (strEQ(d,"sockname"))	return -KEY_getsockname;
+		if (strEQ(d,"sockopt"))		return -KEY_getsockopt;
+	    }
+	    else if (*d == 'g') {
+		if (strEQ(d,"grent"))		return -KEY_getgrent;
+		if (strEQ(d,"grnam"))		return -KEY_getgrnam;
+		if (strEQ(d,"grgid"))		return -KEY_getgrgid;
+	    }
+	    else if (*d == 'l') {
+		if (strEQ(d,"login"))		return -KEY_getlogin;
+	    }
+	    else if (strEQ(d,"c"))		return -KEY_getc;
+	    break;
+	}
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"gt"))			return -KEY_gt;
+	    if (strEQ(d,"ge"))			return -KEY_ge;
+	    break;
+	case 4:
+	    if (strEQ(d,"grep"))		return KEY_grep;
+	    if (strEQ(d,"goto"))		return KEY_goto;
+	    if (strEQ(d,"glob"))		return -KEY_glob;
+	    break;
+	case 6:
+	    if (strEQ(d,"gmtime"))		return -KEY_gmtime;
+	    break;
+	}
+	break;
+    case 'h':
+	if (strEQ(d,"hex"))			return -KEY_hex;
+	break;
+    case 'i':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"if"))			return KEY_if;
+	    break;
+	case 3:
+	    if (strEQ(d,"int"))			return -KEY_int;
+	    break;
+	case 5:
+	    if (strEQ(d,"index"))		return -KEY_index;
+	    if (strEQ(d,"ioctl"))		return -KEY_ioctl;
+	    break;
+	}
+	break;
+    case 'j':
+	if (strEQ(d,"join"))			return -KEY_join;
+	break;
+    case 'k':
+	if (len == 4) {
+	    if (strEQ(d,"keys"))		return KEY_keys;
+	    if (strEQ(d,"kill"))		return -KEY_kill;
+	}
+	break;
+    case 'L':
+	if (len == 2) {
+	    if (strEQ(d,"LT")) { deprecate(d);	return -KEY_lt;}
+	    if (strEQ(d,"LE")) { deprecate(d);	return -KEY_le;}
+	}
+	break;
+    case 'l':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"lt"))			return -KEY_lt;
+	    if (strEQ(d,"le"))			return -KEY_le;
+	    if (strEQ(d,"lc"))			return -KEY_lc;
+	    break;
+	case 3:
+	    if (strEQ(d,"log"))			return -KEY_log;
+	    break;
+	case 4:
+	    if (strEQ(d,"last"))		return KEY_last;
+	    if (strEQ(d,"link"))		return -KEY_link;
+	    break;
+	case 5:
+	    if (strEQ(d,"local"))		return KEY_local;
+	    if (strEQ(d,"lstat"))		return -KEY_lstat;
+	    break;
+	case 6:
+	    if (strEQ(d,"length"))		return -KEY_length;
+	    if (strEQ(d,"listen"))		return -KEY_listen;
+	    break;
+	case 7:
+	    if (strEQ(d,"lcfirst"))		return -KEY_lcfirst;
+	    break;
+	case 9:
+	    if (strEQ(d,"localtime"))		return -KEY_localtime;
+	    break;
+	}
+	break;
+    case 'm':
+	switch (len) {
+	case 1:					return KEY_m;
+	case 2:
+	    if (strEQ(d,"my"))			return KEY_my;
+	    break;
+	case 3:
+	    if (strEQ(d,"map"))			return KEY_map;
+	    break;
+	case 5:
+	    if (strEQ(d,"mkdir"))		return -KEY_mkdir;
+	    break;
+	case 6:
+	    if (strEQ(d,"msgctl"))		return -KEY_msgctl;
+	    if (strEQ(d,"msgget"))		return -KEY_msgget;
+	    if (strEQ(d,"msgrcv"))		return -KEY_msgrcv;
+	    if (strEQ(d,"msgsnd"))		return -KEY_msgsnd;
+	    break;
+	}
+	break;
+    case 'N':
+	if (strEQ(d,"NE")) { deprecate(d);	return -KEY_ne;}
+	break;
+    case 'n':
+	if (strEQ(d,"next"))			return KEY_next;
+	if (strEQ(d,"ne"))			return -KEY_ne;
+	if (strEQ(d,"not"))			return -KEY_not;
+	if (strEQ(d,"no"))			return KEY_no;
+	break;
+    case 'o':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"or"))			return -KEY_or;
+	    break;
+	case 3:
+	    if (strEQ(d,"ord"))			return -KEY_ord;
+	    if (strEQ(d,"oct"))			return -KEY_oct;
+	    break;
+	case 4:
+	    if (strEQ(d,"open"))		return -KEY_open;
+	    break;
+	case 7:
+	    if (strEQ(d,"opendir"))		return -KEY_opendir;
+	    break;
+	}
+	break;
+    case 'p':
+	switch (len) {
+	case 3:
+	    if (strEQ(d,"pop"))			return KEY_pop;
+	    if (strEQ(d,"pos"))			return KEY_pos;
+	    break;
+	case 4:
+	    if (strEQ(d,"push"))		return KEY_push;
+	    if (strEQ(d,"pack"))		return -KEY_pack;
+	    if (strEQ(d,"pipe"))		return -KEY_pipe;
+	    break;
+	case 5:
+	    if (strEQ(d,"print"))		return KEY_print;
+	    break;
+	case 6:
+	    if (strEQ(d,"printf"))		return KEY_printf;
+	    break;
+	case 7:
+	    if (strEQ(d,"package"))		return KEY_package;
+	    break;
+	case 9:
+	    if (strEQ(d,"prototype"))		return KEY_prototype;
+	}
+	break;
+    case 'q':
+	if (len <= 2) {
+	    if (strEQ(d,"q"))			return KEY_q;
+	    if (strEQ(d,"qq"))			return KEY_qq;
+	    if (strEQ(d,"qw"))			return KEY_qw;
+	    if (strEQ(d,"qx"))			return KEY_qx;
+	}
+	else if (strEQ(d,"quotemeta"))		return -KEY_quotemeta;
+	break;
+    case 'r':
+	switch (len) {
+	case 3:
+	    if (strEQ(d,"ref"))			return -KEY_ref;
+	    break;
+	case 4:
+	    if (strEQ(d,"read"))		return -KEY_read;
+	    if (strEQ(d,"rand"))		return -KEY_rand;
+	    if (strEQ(d,"recv"))		return -KEY_recv;
+	    if (strEQ(d,"redo"))		return KEY_redo;
+	    break;
+	case 5:
+	    if (strEQ(d,"rmdir"))		return -KEY_rmdir;
+	    if (strEQ(d,"reset"))		return -KEY_reset;
+	    break;
+	case 6:
+	    if (strEQ(d,"return"))		return KEY_return;
+	    if (strEQ(d,"rename"))		return -KEY_rename;
+	    if (strEQ(d,"rindex"))		return -KEY_rindex;
+	    break;
+	case 7:
+	    if (strEQ(d,"require"))		return -KEY_require;
+	    if (strEQ(d,"reverse"))		return -KEY_reverse;
+	    if (strEQ(d,"readdir"))		return -KEY_readdir;
+	    break;
+	case 8:
+	    if (strEQ(d,"readlink"))		return -KEY_readlink;
+	    if (strEQ(d,"readline"))		return -KEY_readline;
+	    if (strEQ(d,"readpipe"))		return -KEY_readpipe;
+	    break;
+	case 9:
+	    if (strEQ(d,"rewinddir"))		return -KEY_rewinddir;
+	    break;
+	}
+	break;
+    case 's':
+	switch (d[1]) {
+	case 0:					return KEY_s;
+	case 'c':
+	    if (strEQ(d,"scalar"))		return KEY_scalar;
+	    break;
+	case 'e':
+	    switch (len) {
+	    case 4:
+		if (strEQ(d,"seek"))		return -KEY_seek;
+		if (strEQ(d,"send"))		return -KEY_send;
+		break;
+	    case 5:
+		if (strEQ(d,"semop"))		return -KEY_semop;
+		break;
+	    case 6:
+		if (strEQ(d,"select"))		return -KEY_select;
+		if (strEQ(d,"semctl"))		return -KEY_semctl;
+		if (strEQ(d,"semget"))		return -KEY_semget;
+		break;
+	    case 7:
+		if (strEQ(d,"setpgrp"))		return -KEY_setpgrp;
+		if (strEQ(d,"seekdir"))		return -KEY_seekdir;
+		break;
+	    case 8:
+		if (strEQ(d,"setpwent"))	return -KEY_setpwent;
+		if (strEQ(d,"setgrent"))	return -KEY_setgrent;
+		break;
+	    case 9:
+		if (strEQ(d,"setnetent"))	return -KEY_setnetent;
+		break;
+	    case 10:
+		if (strEQ(d,"setsockopt"))	return -KEY_setsockopt;
+		if (strEQ(d,"sethostent"))	return -KEY_sethostent;
+		if (strEQ(d,"setservent"))	return -KEY_setservent;
+		break;
+	    case 11:
+		if (strEQ(d,"setpriority"))	return -KEY_setpriority;
+		if (strEQ(d,"setprotoent"))	return -KEY_setprotoent;
+		break;
+	    }
+	    break;
+	case 'h':
+	    switch (len) {
+	    case 5:
+		if (strEQ(d,"shift"))		return KEY_shift;
+		break;
+	    case 6:
+		if (strEQ(d,"shmctl"))		return -KEY_shmctl;
+		if (strEQ(d,"shmget"))		return -KEY_shmget;
+		break;
+	    case 7:
+		if (strEQ(d,"shmread"))		return -KEY_shmread;
+		break;
+	    case 8:
+		if (strEQ(d,"shmwrite"))	return -KEY_shmwrite;
+		if (strEQ(d,"shutdown"))	return -KEY_shutdown;
+		break;
+	    }
+	    break;
+	case 'i':
+	    if (strEQ(d,"sin"))			return -KEY_sin;
+	    break;
+	case 'l':
+	    if (strEQ(d,"sleep"))		return -KEY_sleep;
+	    break;
+	case 'o':
+	    if (strEQ(d,"sort"))		return KEY_sort;
+	    if (strEQ(d,"socket"))		return -KEY_socket;
+	    if (strEQ(d,"socketpair"))		return -KEY_socketpair;
+	    break;
+	case 'p':
+	    if (strEQ(d,"split"))		return KEY_split;
+	    if (strEQ(d,"sprintf"))		return -KEY_sprintf;
+	    if (strEQ(d,"splice"))		return KEY_splice;
+	    break;
+	case 'q':
+	    if (strEQ(d,"sqrt"))		return -KEY_sqrt;
+	    break;
+	case 'r':
+	    if (strEQ(d,"srand"))		return -KEY_srand;
+	    break;
+	case 't':
+	    if (strEQ(d,"stat"))		return -KEY_stat;
+	    if (strEQ(d,"study"))		return KEY_study;
+	    break;
+	case 'u':
+	    if (strEQ(d,"substr"))		return -KEY_substr;
+	    if (strEQ(d,"sub"))			return KEY_sub;
+	    break;
+	case 'y':
+	    switch (len) {
+	    case 6:
+		if (strEQ(d,"system"))		return -KEY_system;
+		break;
+	    case 7:
+		if (strEQ(d,"sysopen"))		return -KEY_sysopen;
+		if (strEQ(d,"sysread"))		return -KEY_sysread;
+		if (strEQ(d,"symlink"))		return -KEY_symlink;
+		if (strEQ(d,"syscall"))		return -KEY_syscall;
+		break;
+	    case 8:
+		if (strEQ(d,"syswrite"))	return -KEY_syswrite;
+		break;
+	    }
+	    break;
+	}
+	break;
+    case 't':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"tr"))			return KEY_tr;
+	    break;
+	case 3:
+	    if (strEQ(d,"tie"))			return KEY_tie;
+	    break;
+	case 4:
+	    if (strEQ(d,"tell"))		return -KEY_tell;
+	    if (strEQ(d,"tied"))		return KEY_tied;
+	    if (strEQ(d,"time"))		return -KEY_time;
+	    break;
+	case 5:
+	    if (strEQ(d,"times"))		return -KEY_times;
+	    break;
+	case 7:
+	    if (strEQ(d,"telldir"))		return -KEY_telldir;
+	    break;
+	case 8:
+	    if (strEQ(d,"truncate"))		return -KEY_truncate;
+	    break;
+	}
+	break;
+    case 'u':
+	switch (len) {
+	case 2:
+	    if (strEQ(d,"uc"))			return -KEY_uc;
+	    break;
+	case 3:
+	    if (strEQ(d,"use"))			return KEY_use;
+	    break;
+	case 5:
+	    if (strEQ(d,"undef"))		return KEY_undef;
+	    if (strEQ(d,"until"))		return KEY_until;
+	    if (strEQ(d,"untie"))		return KEY_untie;
+	    if (strEQ(d,"utime"))		return -KEY_utime;
+	    if (strEQ(d,"umask"))		return -KEY_umask;
+	    break;
+	case 6:
+	    if (strEQ(d,"unless"))		return KEY_unless;
+	    if (strEQ(d,"unpack"))		return -KEY_unpack;
+	    if (strEQ(d,"unlink"))		return -KEY_unlink;
+	    break;
+	case 7:
+	    if (strEQ(d,"unshift"))		return KEY_unshift;
+	    if (strEQ(d,"ucfirst"))		return -KEY_ucfirst;
+	    break;
+	}
+	break;
+    case 'v':
+	if (strEQ(d,"values"))			return -KEY_values;
+	if (strEQ(d,"vec"))			return -KEY_vec;
+	break;
+    case 'w':
+	switch (len) {
+	case 4:
+	    if (strEQ(d,"warn"))		return -KEY_warn;
+	    if (strEQ(d,"wait"))		return -KEY_wait;
+	    break;
+	case 5:
+	    if (strEQ(d,"while"))		return KEY_while;
+	    if (strEQ(d,"write"))		return -KEY_write;
+	    break;
+	case 7:
+	    if (strEQ(d,"waitpid"))		return -KEY_waitpid;
+	    break;
+	case 9:
+	    if (strEQ(d,"wantarray"))		return -KEY_wantarray;
+	    break;
+	}
+	break;
+    case 'x':
+	if (len == 1)				return -KEY_x;
+	if (strEQ(d,"xor"))			return -KEY_xor;
+	break;
+    case 'y':
+	if (len == 1)				return KEY_y;
+	break;
+    case 'z':
+	break;
+    }
+    return 0;
+}
+
+static void
+checkcomma(s,name,what)
+register char *s;
+char *name;
+char *what;
+{
+    char *w;
+
+    if (dowarn && *s == ' ' && s[1] == '(') {	/* XXX gotta be a better way */
+	int level = 1;
+	for (w = s+2; *w && level; w++) {
+	    if (*w == '(')
+		++level;
+	    else if (*w == ')')
+		--level;
+	}
+	if (*w)
+	    for (; *w && isSPACE(*w); w++) ;
+	if (!*w || !strchr(";|})]oa!=", *w))	/* an advisory hack only... */
+	    warn("%s (...) interpreted as function",name);
+    }
+    while (s < bufend && isSPACE(*s))
+	s++;
+    if (*s == '(')
+	s++;
+    while (s < bufend && isSPACE(*s))
+	s++;
+    if (isIDFIRST(*s)) {
+	w = s++;
+	while (isALNUM(*s))
+	    s++;
+	while (s < bufend && isSPACE(*s))
+	    s++;
+	if (*s == ',') {
+	    int kw;
+	    *s = '\0';
+	    kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
+	    *s = ',';
+	    if (kw)
+		return;
+	    croak("No comma allowed after %s", what);
+	}
+    }
+}
+
+static char *
+scan_word(s, dest, allow_package, slp)
+register char *s;
+char *dest;
+int allow_package;
+STRLEN *slp;
+{
+    register char *d = dest;
+    for (;;) {
+	if (isALNUM(*s))
+	    *d++ = *s++;
+	else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
+	    *d++ = ':';
+	    *d++ = ':';
+	    s++;
+	}
+	else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
+	    *d++ = *s++;
+	    *d++ = *s++;
+	}
+	else {
+	    *d = '\0';
+	    *slp = d - dest;
+	    return s;
+	}
+    }
+}
+
+static char *
+scan_ident(s,send,dest,ck_uni)
+register char *s;
+register char *send;
+char *dest;
+I32 ck_uni;
+{
+    register char *d;
+    char *bracket = 0;
+    char funny = *s++;
+
+    if (lex_brackets == 0)
+	lex_fakebrack = 0;
+    if (isSPACE(*s))
+	s = skipspace(s);
+    d = dest;
+    if (isDIGIT(*s)) {
+	while (isDIGIT(*s))
+	    *d++ = *s++;
+    }
+    else {
+	for (;;) {
+	    if (isALNUM(*s))
+		*d++ = *s++;
+	    else if (*s == '\'' && isIDFIRST(s[1])) {
+		*d++ = ':';
+		*d++ = ':';
+		s++;
+	    }
+	    else if (*s == ':' && s[1] == ':') {
+		*d++ = *s++;
+		*d++ = *s++;
+	    }
+	    else
+		break;
+	}
+    }
+    *d = '\0';
+    d = dest;
+    if (*d) {
+	if (lex_state != LEX_NORMAL)
+	    lex_state = LEX_INTERPENDMAYBE;
+	return s;
+    }
+    if (*s == '$' && s[1] &&
+      (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
+	return s;
+    if (*s == '{') {
+	bracket = s;
+	s++;
+    }
+    else if (ck_uni)
+	check_uni();
+    if (s < send)
+	*d = *s++;
+    d[1] = '\0';
+    if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
+	*d = *s++ ^ 64;
+    }
+    if (bracket) {
+	if (isSPACE(s[-1])) {
+	    while (s < send && (*s == ' ' || *s == '\t')) s++;
+	    *d = *s;
+	}
+	if (isALPHA(*d) || *d == '_') {
+	    d++;
+	    while (isALNUM(*s) || *s == ':')
+		*d++ = *s++;
+	    *d = '\0';
+	    while (s < send && (*s == ' ' || *s == '\t')) s++;
+	    if ((*s == '[' || *s == '{')) {
+		if (dowarn && keyword(dest, d - dest)) {
+		    char *brack = *s == '[' ? "[...]" : "{...}";
+		    warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
+			funny, dest, brack, funny, dest, brack);
+		}
+		lex_fakebrack = lex_brackets+1;
+		bracket++;
+		lex_brackstack[lex_brackets++] = XOPERATOR;
+		return s;
+	    }
+	}
+	if (*s == '}') {
+	    s++;
+	    if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
+		lex_state = LEX_INTERPEND;
+	    if (funny == '#')
+		funny = '@';
+	    if (dowarn &&
+	      (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
+		warn("Ambiguous use of %c{%s} resolved to %c%s",
+		    funny, dest, funny, dest);
+	}
+	else {
+	    s = bracket;		/* let the parser handle it */
+	    *dest = '\0';
+	}
+    }
+    else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
+	lex_state = LEX_INTERPEND;
+    return s;
+}
+
+void pmflag(pmfl,ch)
+U16* pmfl;
+int ch;
+{
+    if (ch == 'i') {
+	sawi = TRUE;
+	*pmfl |= PMf_FOLD;
+    }
+    else if (ch == 'g')
+	*pmfl |= PMf_GLOBAL;
+    else if (ch == 'o')
+	*pmfl |= PMf_KEEP;
+    else if (ch == 'm')
+	*pmfl |= PMf_MULTILINE;
+    else if (ch == 's')
+	*pmfl |= PMf_SINGLELINE;
+    else if (ch == 'x')
+	*pmfl |= PMf_EXTENDED;
+}
+
+static char *
+scan_pat(start)
+char *start;
+{
+    PMOP *pm;
+    char *s;
+
+    s = scan_str(start);
+    if (!s) {
+	if (lex_stuff)
+	    SvREFCNT_dec(lex_stuff);
+	lex_stuff = Nullsv;
+	croak("Search pattern not terminated");
+    }
+    pm = (PMOP*)newPMOP(OP_MATCH, 0);
+    if (multi_open == '?')
+	pm->op_pmflags |= PMf_ONCE;
+
+    while (*s && strchr("iogmsx", *s))
+	pmflag(&pm->op_pmflags,*s++);
+
+    pm->op_pmpermflags = pm->op_pmflags;
+    lex_op = (OP*)pm;
+    yylval.ival = OP_MATCH;
+    return s;
+}
+
+static char *
+scan_subst(start)
+char *start;
+{
+    register char *s;
+    register PMOP *pm;
+    I32 es = 0;
+
+    yylval.ival = OP_NULL;
+
+    s = scan_str(start);
+
+    if (!s) {
+	if (lex_stuff)
+	    SvREFCNT_dec(lex_stuff);
+	lex_stuff = Nullsv;
+	croak("Substitution pattern not terminated");
+    }
+
+    if (s[-1] == multi_open)
+	s--;
+
+    s = scan_str(s);
+    if (!s) {
+	if (lex_stuff)
+	    SvREFCNT_dec(lex_stuff);
+	lex_stuff = Nullsv;
+	if (lex_repl)
+	    SvREFCNT_dec(lex_repl);
+	lex_repl = Nullsv;
+	croak("Substitution replacement not terminated");
+    }
+
+    pm = (PMOP*)newPMOP(OP_SUBST, 0);
+    while (*s && strchr("iogmsex", *s)) {
+	if (*s == 'e') {
+	    s++;
+	    es++;
+	}
+	else
+	    pmflag(&pm->op_pmflags,*s++);
+    }
+
+    if (es) {
+	SV *repl;
+	pm->op_pmflags |= PMf_EVAL;
+	repl = newSVpv("",0);
+	while (es-- > 0)
+	    sv_catpv(repl, es ? "eval " : "do ");
+	sv_catpvn(repl, "{ ", 2);
+	sv_catsv(repl, lex_repl);
+	sv_catpvn(repl, " };", 2);
+	SvCOMPILED_on(repl);
+	SvREFCNT_dec(lex_repl);
+	lex_repl = repl;
+    }
+
+    pm->op_pmpermflags = pm->op_pmflags;
+    lex_op = (OP*)pm;
+    yylval.ival = OP_SUBST;
+    return s;
+}
+
+void
+hoistmust(pm)
+register PMOP *pm;
+{
+    if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
+	(!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
+       ) {
+	if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
+	    pm->op_pmflags |= PMf_SCANFIRST;
+	else if (pm->op_pmflags & PMf_FOLD)
+	    return;
+	pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
+	pm->op_pmslen = SvCUR(pm->op_pmshort);
+    }
+    else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
+	if (pm->op_pmshort &&
+	  sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
+	{
+	    if (pm->op_pmflags & PMf_SCANFIRST) {
+		SvREFCNT_dec(pm->op_pmshort);
+		pm->op_pmshort = Nullsv;
+	    }
+	    else {
+		SvREFCNT_dec(pm->op_pmregexp->regmust);
+		pm->op_pmregexp->regmust = Nullsv;
+		return;
+	    }
+	}
+	if (!pm->op_pmshort ||	/* promote the better string */
+	  ((pm->op_pmflags & PMf_SCANFIRST) &&
+	   (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
+	    SvREFCNT_dec(pm->op_pmshort);		/* ok if null */
+	    pm->op_pmshort = pm->op_pmregexp->regmust;
+	    pm->op_pmslen = SvCUR(pm->op_pmshort);
+	    pm->op_pmregexp->regmust = Nullsv;
+	    pm->op_pmflags |= PMf_SCANFIRST;
+	}
+    }
+}
+
+static char *
+scan_trans(start)
+char *start;
+{
+    register char* s;
+    OP *op;
+    short *tbl;
+    I32 squash;
+    I32 delete;
+    I32 complement;
+
+    yylval.ival = OP_NULL;
+
+    s = scan_str(start);
+    if (!s) {
+	if (lex_stuff)
+	    SvREFCNT_dec(lex_stuff);
+	lex_stuff = Nullsv;
+	croak("Translation pattern not terminated");
+    }
+    if (s[-1] == multi_open)
+	s--;
+
+    s = scan_str(s);
+    if (!s) {
+	if (lex_stuff)
+	    SvREFCNT_dec(lex_stuff);
+	lex_stuff = Nullsv;
+	if (lex_repl)
+	    SvREFCNT_dec(lex_repl);
+	lex_repl = Nullsv;
+	croak("Translation replacement not terminated");
+    }
+
+    New(803,tbl,256,short);
+    op = newPVOP(OP_TRANS, 0, (char*)tbl);
+
+    complement = delete = squash = 0;
+    while (*s == 'c' || *s == 'd' || *s == 's') {
+	if (*s == 'c')
+	    complement = OPpTRANS_COMPLEMENT;
+	else if (*s == 'd')
+	    delete = OPpTRANS_DELETE;
+	else
+	    squash = OPpTRANS_SQUASH;
+	s++;
+    }
+    op->op_private = delete|squash|complement;
+
+    lex_op = op;
+    yylval.ival = OP_TRANS;
+    return s;
+}
+
+static char *
+scan_heredoc(s)
+register char *s;
+{
+    SV *herewas;
+    I32 op_type = OP_SCALAR;
+    I32 len;
+    SV *tmpstr;
+    char term;
+    register char *d;
+    char *peek;
+
+    s += 2;
+    d = tokenbuf;
+    if (!rsfp)
+	*d++ = '\n';
+    for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
+    if (*peek && strchr("`'\"",*peek)) {
+	s = peek;
+	term = *s++;
+	s = cpytill(d,s,bufend,term,&len);
+	if (s < bufend)
+	    s++;
+	d += len;
+    }
+    else {
+	if (*s == '\\')
+	    s++, term = '\'';
+	else
+	    term = '"';
+	if (!isALNUM(*s))
+	    deprecate("bare << to mean <<\"\"");
+	while (isALNUM(*s))
+	    *d++ = *s++;
+    }				/* assuming tokenbuf won't clobber */
+    *d++ = '\n';
+    *d = '\0';
+    len = d - tokenbuf;
+    d = "\n";
+    if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
+	herewas = newSVpv(s,bufend-s);
+    else
+	s--, herewas = newSVpv(s,d-s);
+    s += SvCUR(herewas);
+
+    tmpstr = NEWSV(87,80);
+    sv_upgrade(tmpstr, SVt_PVIV);
+    if (term == '\'') {
+	op_type = OP_CONST;
+	SvIVX(tmpstr) = -1;
+    }
+    else if (term == '`') {
+	op_type = OP_BACKTICK;
+	SvIVX(tmpstr) = '\\';
+    }
+
+    CLINE;
+    multi_start = curcop->cop_line;
+    multi_open = multi_close = '<';
+    term = *tokenbuf;
+    if (!rsfp) {
+	d = s;
+	while (s < bufend &&
+	  (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+	    if (*s++ == '\n')
+		curcop->cop_line++;
+	}
+	if (s >= bufend) {
+	    curcop->cop_line = multi_start;
+	    missingterm(tokenbuf);
+	}
+	sv_setpvn(tmpstr,d+1,s-d);
+	s += len - 1;
+	sv_catpvn(herewas,s,bufend-s);
+	sv_setsv(linestr,herewas);
+	oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+	bufend = SvPVX(linestr) + SvCUR(linestr);
+    }
+    else
+	sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
+    while (s >= bufend) {	/* multiple line string? */
+	if (!rsfp ||
+	 !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+	    curcop->cop_line = multi_start;
+	    missingterm(tokenbuf);
+	}
+	curcop->cop_line++;
+	if (perldb && curstash != debstash) {
+	    SV *sv = NEWSV(88,0);
+
+	    sv_upgrade(sv, SVt_PVMG);
+	    sv_setsv(sv,linestr);
+	    av_store(GvAV(curcop->cop_filegv),
+	      (I32)curcop->cop_line,sv);
+	}
+	bufend = SvPVX(linestr) + SvCUR(linestr);
+	if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+	    s = bufend - 1;
+	    *s = ' ';
+	    sv_catsv(linestr,herewas);
+	    bufend = SvPVX(linestr) + SvCUR(linestr);
+	}
+	else {
+	    s = bufend;
+	    sv_catsv(tmpstr,linestr);
+	}
+    }
+    multi_end = curcop->cop_line;
+    s++;
+    if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
+	SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
+	Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
+    }
+    SvREFCNT_dec(herewas);
+    lex_stuff = tmpstr;
+    yylval.ival = op_type;
+    return s;
+}
+
+static char *
+scan_inputsymbol(start)
+char *start;
+{
+    register char *s = start;
+    register char *d;
+    I32 len;
+
+    d = tokenbuf;
+    s = cpytill(d, s+1, bufend, '>', &len);
+    if (s < bufend)
+	s++;
+    else
+	croak("Unterminated <> operator");
+
+    if (*d == '$' && d[1]) d++;
+    while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
+	d++;
+    if (d - tokenbuf != len) {
+	yylval.ival = OP_GLOB;
+	set_csh();
+	s = scan_str(start);
+	if (!s)
+	    croak("Glob not terminated");
+	return s;
+    }
+    else {
+	d = tokenbuf;
+	if (!len)
+	    (void)strcpy(d,"ARGV");
+	if (*d == '$') {
+	    I32 tmp;
+	    if (tmp = pad_findmy(d)) {
+		OP *op = newOP(OP_PADSV, 0);
+		op->op_targ = tmp;
+		lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
+	    }
+	    else {
+		GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
+		lex_op = (OP*)newUNOP(OP_READLINE, 0,
+					newUNOP(OP_RV2GV, 0,
+					    newUNOP(OP_RV2SV, 0,
+						newGVOP(OP_GV, 0, gv))));
+	    }
+	    yylval.ival = OP_NULL;
+	}
+	else {
+	    GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
+	    lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
+	    yylval.ival = OP_NULL;
+	}
+    }
+    return s;
+}
+
+static char *
+scan_str(start)
+char *start;
+{
+    SV *sv;
+    char *tmps;
+    register char *s = start;
+    register char term;
+    register char *to;
+    I32 brackets = 1;
+
+    if (isSPACE(*s))
+	s = skipspace(s);
+    CLINE;
+    term = *s;
+    multi_start = curcop->cop_line;
+    multi_open = term;
+    if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+	term = tmps[5];
+    multi_close = term;
+
+    sv = NEWSV(87,80);
+    sv_upgrade(sv, SVt_PVIV);
+    SvIVX(sv) = term;
+    (void)SvPOK_only(sv);		/* validate pointer */
+    s++;
+    for (;;) {
+	SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
+	to = SvPVX(sv)+SvCUR(sv);
+	if (multi_open == multi_close) {
+	    for (; s < bufend; s++,to++) {
+		if (*s == '\n' && !rsfp)
+		    curcop->cop_line++;
+		if (*s == '\\' && s+1 < bufend && term != '\\') {
+		    if (s[1] == term)
+			s++;
+		    else
+			*to++ = *s++;
+		}
+		else if (*s == term)
+		    break;
+		*to = *s;
+	    }
+	}
+	else {
+	    for (; s < bufend; s++,to++) {
+		if (*s == '\n' && !rsfp)
+		    curcop->cop_line++;
+		if (*s == '\\' && s+1 < bufend && term != '\\') {
+		    if (s[1] == term)
+			s++;
+		    else
+			*to++ = *s++;
+		}
+		else if (*s == term && --brackets <= 0)
+		    break;
+		else if (*s == multi_open)
+		    brackets++;
+		*to = *s;
+	    }
+	}
+	*to = '\0';
+	SvCUR_set(sv, to - SvPVX(sv));
+
+    if (s < bufend) break;	/* string ends on this line? */
+
+	if (!rsfp ||
+	 !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+	    sv_free(sv);
+	    curcop->cop_line = multi_start;
+	    return Nullch;
+	}
+	curcop->cop_line++;
+	if (perldb && curstash != debstash) {
+	    SV *sv = NEWSV(88,0);
+
+	    sv_upgrade(sv, SVt_PVMG);
+	    sv_setsv(sv,linestr);
+	    av_store(GvAV(curcop->cop_filegv),
+	      (I32)curcop->cop_line, sv);
+	}
+	bufend = SvPVX(linestr) + SvCUR(linestr);
+    }
+    multi_end = curcop->cop_line;
+    s++;
+    if (SvCUR(sv) + 5 < SvLEN(sv)) {
+	SvLEN_set(sv, SvCUR(sv) + 1);
+	Renew(SvPVX(sv), SvLEN(sv), char);
+    }
+    if (lex_stuff)
+	lex_repl = sv;
+    else
+	lex_stuff = sv;
+    return s;
+}
+
+char *
+scan_num(start)
+char *start;
+{
+    register char *s = start;
+    register char *d;
+    I32 tryi32;
+    double value;
+    SV *sv;
+    I32 floatit;
+    char *lastub = 0;
+
+    switch (*s) {
+    default:
+	croak("panic: scan_num");
+    case '0':
+	{
+	    U32 i;
+	    I32 shift;
+
+	    if (s[1] == 'x') {
+		shift = 4;
+		s += 2;
+	    }
+	    else if (s[1] == '.')
+		goto decimal;
+	    else
+		shift = 3;
+	    i = 0;
+	    for (;;) {
+		switch (*s) {
+		default:
+		    goto out;
+		case '_':
+		    s++;
+		    break;
+		case '8': case '9':
+		    if (shift != 4)
+			yyerror("Illegal octal digit");
+		    /* FALL THROUGH */
+		case '0': case '1': case '2': case '3': case '4':
+		case '5': case '6': case '7':
+		    i <<= shift;
+		    i += *s++ & 15;
+		    break;
+		case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+		case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
+		    if (shift != 4)
+			goto out;
+		    i <<= 4;
+		    i += (*s++ & 7) + 9;
+		    break;
+		}
+	    }
+	  out:
+	    sv = NEWSV(92,0);
+	    tryi32 = i;
+	    if (tryi32 == i && tryi32 >= 0)
+		sv_setiv(sv,tryi32);
+	    else
+		sv_setnv(sv,(double)i);
+	}
+	break;
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9': case '.':
+      decimal:
+	d = tokenbuf;
+	floatit = FALSE;
+	while (isDIGIT(*s) || *s == '_') {
+	    if (*s == '_') {
+		if (dowarn && lastub && s - lastub != 3)
+		    warn("Misplaced _ in number");
+		lastub = ++s;
+	    }
+	    else
+		*d++ = *s++;
+	}
+	if (dowarn && lastub && s - lastub != 3)
+	    warn("Misplaced _ in number");
+	if (*s == '.' && s[1] != '.') {
+	    floatit = TRUE;
+	    *d++ = *s++;
+	    while (isDIGIT(*s) || *s == '_') {
+		if (*s == '_')
+		    s++;
+		else
+		    *d++ = *s++;
+	    }
+	}
+	if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
+	    floatit = TRUE;
+	    s++;
+	    *d++ = 'e';		/* At least some Mach atof()s don't grok 'E' */
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isDIGIT(*s))
+		*d++ = *s++;
+	}
+	*d = '\0';
+	sv = NEWSV(92,0);
+	value = atof(tokenbuf);
+	tryi32 = I_32(value);
+	if (!floatit && (double)tryi32 == value)
+	    sv_setiv(sv,tryi32);
+	else
+	    sv_setnv(sv,value);
+	break;
+    }
+
+    yylval.opval = newSVOP(OP_CONST, 0, sv);
+
+    return s;
+}
+
+static char *
+scan_formline(s)
+register char *s;
+{
+    register char *eol;
+    register char *t;
+    SV *stuff = newSVpv("",0);
+    bool needargs = FALSE;
+
+    while (!needargs) {
+	if (*s == '.' || *s == '}') {
+	    /*SUPPRESS 530*/
+	    for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
+	    if (*t == '\n')
+		break;
+	}
+	if (in_eval && !rsfp) {
+	    eol = strchr(s,'\n');
+	    if (!eol++)
+		eol = bufend;
+	}
+	else
+	    eol = bufend = SvPVX(linestr) + SvCUR(linestr);
+	if (*s != '#') {
+	    for (t = s; t < eol; t++) {
+		if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
+		    needargs = FALSE;
+		    goto enough;	/* ~~ must be first line in formline */
+		}
+		if (*t == '@' || *t == '^')
+		    needargs = TRUE;
+	    }
+	    sv_catpvn(stuff, s, eol-s);
+	}
+	s = eol;
+	if (rsfp) {
+	    s = filter_gets(linestr, rsfp);
+	    oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+	    bufend = bufptr + SvCUR(linestr);
+	    if (!s) {
+		s = bufptr;
+		yyerror("Format not terminated");
+		break;
+	    }
+	}
+	incline(s);
+    }
+  enough:
+    if (SvCUR(stuff)) {
+	expect = XTERM;
+	if (needargs) {
+	    lex_state = LEX_NORMAL;
+	    nextval[nexttoke].ival = 0;
+	    force_next(',');
+	}
+	else
+	    lex_state = LEX_FORMLINE;
+	nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
+	force_next(THING);
+	nextval[nexttoke].ival = OP_FORMLINE;
+	force_next(LSTOP);
+    }
+    else {
+	SvREFCNT_dec(stuff);
+	lex_formbrack = 0;
+	bufptr = s;
+    }
+    return s;
+}
+
+static void
+set_csh()
+{
+#ifdef CSH
+    if (!cshlen)
+	cshlen = strlen(cshname);
+#endif
+}
+
+int
+start_subparse()
+{
+    int oldsavestack_ix = savestack_ix;
+    CV* outsidecv = compcv;
+    AV* comppadlist;
+
+    if (compcv) {
+	assert(SvTYPE(compcv) == SVt_PVCV);
+    }
+    save_I32(&subline);
+    save_item(subname);
+    SAVEINT(padix);
+    SAVESPTR(curpad);
+    SAVESPTR(comppad);
+    SAVESPTR(comppad_name);
+    SAVESPTR(compcv);
+    SAVEINT(comppad_name_fill);
+    SAVEINT(min_intro_pending);
+    SAVEINT(max_intro_pending);
+    SAVEINT(pad_reset_pending);
+
+    compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)compcv, SVt_PVCV);
+
+    comppad = newAV();
+    comppad_name = newAV();
+    comppad_name_fill = 0;
+    min_intro_pending = 0;
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
+    padix = 0;
+    subline = curcop->cop_line;
+
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, (SV*)comppad_name);
+    av_store(comppadlist, 1, (SV*)comppad);
+
+    CvPADLIST(compcv) = comppadlist;
+    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+
+    return oldsavestack_ix;
+}
+
+int
+yywarn(s)
+char *s;
+{
+    --error_count;
+    in_eval |= 2;
+    yyerror(s);
+    in_eval &= ~2;
+    return 0;
+}
+
+int
+yyerror(s)
+char *s;
+{
+    char tmpbuf[258];
+    char *tname = tmpbuf;
+
+    if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+      oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
+	while (isSPACE(*oldoldbufptr))
+	    oldoldbufptr++;
+	sprintf(tname,"near \"%.*s\"",bufptr - oldoldbufptr, oldoldbufptr);
+    }
+    else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
+      oldbufptr != bufptr) {
+	while (isSPACE(*oldbufptr))
+	    oldbufptr++;
+	sprintf(tname,"near \"%.*s\"",bufptr - oldbufptr, oldbufptr);
+    }
+    else if (yychar > 255)
+	tname = "next token ???";
+    else if (!yychar || (yychar == ';' && !rsfp))
+	(void)strcpy(tname,"at EOF");
+    else if ((yychar & 127) == 127) {
+	if (lex_state == LEX_NORMAL ||
+	   (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
+	    (void)strcpy(tname,"at end of line");
+	else if (lex_inpat)
+	    (void)strcpy(tname,"within pattern");
+	else
+	    (void)strcpy(tname,"within string");
+    }
+    else if (yychar < 32)
+	(void)sprintf(tname,"next char ^%c",yychar+64);
+    else
+	(void)sprintf(tname,"next char %c",yychar);
+    (void)sprintf(buf, "%s at %s line %d, %s\n",
+      s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
+    if (curcop->cop_line == multi_end && multi_start < multi_end) {
+	sprintf(buf+strlen(buf),
+	  "  (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+	  multi_open,multi_close,(long)multi_start);
+        multi_end = 0;
+    }
+    if (in_eval & 2)
+	warn("%s",buf);
+    else if (in_eval)
+	sv_catpv(GvSV(errgv),buf);
+    else
+	fputs(buf,stderr);
+    if (++error_count >= 10)
+	croak("%s has too many errors.\n",
+	SvPVX(GvSV(curcop->cop_filegv)));
+    in_my = 0;
+    return 0;
+}
diff --git a/gnu/usr.bin/perl/unixish.h b/gnu/usr.bin/perl/unixish.h
new file mode 100644
index 00000000000..2f5f44bfacf
--- /dev/null
+++ b/gnu/usr.bin/perl/unixish.h
@@ -0,0 +1,81 @@
+/*
+ * The following symbols are defined if your operating system supports
+ * functions by that name.  All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+
+/* HAS_IOCTL:
+ *	This symbol, if defined, indicates that the ioctl() routine is
+ *	available to set I/O characteristics
+ */
+#define	HAS_IOCTL		/**/
+ 
+/* HAS_UTIME:
+ *	This symbol, if defined, indicates that the routine utime() is
+ *	available to update the access and modification times of files.
+ */
+#define HAS_UTIME		/**/
+
+/* HAS_GROUP
+ *	This symbol, if defined, indicates that the getgrnam(),
+ *	getgrgid(), and getgrent() routines are available to 
+ *	get group entries.
+ */
+#define HAS_GROUP		/**/
+
+/* HAS_PASSWD
+ *	This symbol, if defined, indicates that the getpwnam(),
+ *	getpwuid(), and getpwent() routines are available to 
+ *	get password entries.
+ */
+#define HAS_PASSWD		/**/
+
+#define HAS_KILL
+#define HAS_WAIT
+  
+/* UNLINK_ALL_VERSIONS:
+ *	This symbol, if defined, indicates that the program should arrange
+ *	to remove all versions of a file if unlink() is called.  This is
+ *	probably only relevant for VMS.
+ */
+/* #define UNLINK_ALL_VERSIONS		/**/
+
+/* VMS:
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It is currently automatically set by cpps running under VMS,
+ *	and is included here for completeness only.
+ */
+/* #define VMS		/**/
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+# include <signal.h>
+#endif
+
+#ifndef SIGABRT
+#    define SIGABRT SIGILL
+#endif
+#ifndef SIGILL
+#    define SIGILL 6         /* blech */
+#endif
+#define ABORT() kill(getpid(),SIGABRT);
+
+#define BIT_BUCKET "/dev/null"
+#define PERL_SYS_INIT(c,v)
+#define PERL_SYS_TERM()
+#define dXSUB_SYS int dummy
+
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 fwrite
+
+#define Stat(fname,bufptr) stat((fname),(bufptr))
+#define Fstat(fd,bufptr)   fstat((fd),(bufptr))
+#define Fflush(fp)         fflush(fp)
+
+#define my_getenv(var) getenv(var)
+
diff --git a/gnu/usr.bin/perl/util.c b/gnu/usr.bin/perl/util.c
new file mode 100644
index 00000000000..a11d98fe612
--- /dev/null
+++ b/gnu/usr.bin/perl/util.c
@@ -0,0 +1,1812 @@
+/*    util.c
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+/*
+ * "Very useful, no doubt, that was to Saruman; yet it seems that he was
+ * not content."  --Gandalf
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#include <signal.h>
+#endif
+
+/* Omit this -- it causes too much grief on mixed systems.
+#ifdef I_UNISTD
+#  include <unistd.h>
+#endif
+*/
+
+#ifdef I_VFORK
+#  include <vfork.h>
+#endif
+
+#ifdef I_LIMITS  /* Needed for cast_xxx() functions below. */
+#  include <limits.h>
+#endif
+
+/* Put this after #includes because fork and vfork prototypes may
+   conflict.
+*/
+#ifndef HAS_VFORK
+#   define vfork fork
+#endif
+
+#ifdef I_FCNTL
+#  include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#  include <sys/file.h>
+#endif
+
+#define FLUSH
+
+#ifdef LEAKTEST
+static void xstat _((void));
+#endif
+
+#ifndef safemalloc
+
+/* paranoid version of malloc */
+
+/* NOTE:  Do not call the next three routines directly.  Use the macros
+ * in handy.h, so that we can easily redefine everything to do tracking of
+ * allocated hunks back to the original New to track down any memory leaks.
+ */
+
+char *
+safemalloc(size)
+#ifdef MSDOS
+unsigned long size;
+#else
+MEM_SIZE size;
+#endif /* MSDOS */
+{
+    char  *ptr;
+#ifdef MSDOS
+	if (size > 0xffff) {
+		fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
+		my_exit(1);
+	}
+#endif /* MSDOS */
+#ifdef DEBUGGING
+    if ((long)size < 0)
+	croak("panic: malloc");
+#endif
+    ptr = malloc(size?size:1);	/* malloc(0) is NASTY on our system */
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+#else
+    DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+#endif
+    if (ptr != Nullch)
+	return ptr;
+    else if (nomemok)
+	return Nullch;
+    else {
+	fputs(no_mem,stderr) FLUSH;
+	my_exit(1);
+    }
+    /*NOTREACHED*/
+}
+
+/* paranoid version of realloc */
+
+char *
+saferealloc(where,size)
+char *where;
+#ifndef MSDOS
+MEM_SIZE size;
+#else
+unsigned long size;
+#endif /* MSDOS */
+{
+    char *ptr;
+#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
+    char *realloc();
+#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
+
+#ifdef MSDOS
+	if (size > 0xffff) {
+		fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
+		my_exit(1);
+	}
+#endif /* MSDOS */
+    if (!where)
+	croak("Null realloc");
+#ifdef DEBUGGING
+    if ((long)size < 0)
+	croak("panic: realloc");
+#endif
+    ptr = realloc(where,size?size:1);	/* realloc(0) is NASTY on our system */
+
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m( {
+	fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
+	fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    } )
+#else
+    DEBUG_m( {
+	fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
+	fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    } )
+#endif
+
+    if (ptr != Nullch)
+	return ptr;
+    else if (nomemok)
+	return Nullch;
+    else {
+	fputs(no_mem,stderr) FLUSH;
+	my_exit(1);
+    }
+    /*NOTREACHED*/
+}
+
+/* safe version of free */
+
+void
+safefree(where)
+char *where;
+{
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m( fprintf(stderr,"0x%x: (%05d) free\n",where,an++));
+#else
+    DEBUG_m( fprintf(stderr,"0x%lx: (%05d) free\n",where,an++));
+#endif
+    if (where) {
+	/*SUPPRESS 701*/
+	free(where);
+    }
+}
+
+#endif /* !safemalloc */
+
+#ifdef LEAKTEST
+
+#define ALIGN sizeof(long)
+
+char *
+safexmalloc(x,size)
+I32 x;
+MEM_SIZE size;
+{
+    register char *where;
+
+    where = safemalloc(size + ALIGN);
+    xcount[x]++;
+    where[0] = x % 100;
+    where[1] = x / 100;
+    return where + ALIGN;
+}
+
+char *
+safexrealloc(where,size)
+char *where;
+MEM_SIZE size;
+{
+    register char *new = saferealloc(where - ALIGN, size + ALIGN);
+    return new + ALIGN;
+}
+
+void
+safexfree(where)
+char *where;
+{
+    I32 x;
+
+    if (!where)
+	return;
+    where -= ALIGN;
+    x = where[0] + 100 * where[1];
+    xcount[x]--;
+    safefree(where);
+}
+
+static void
+xstat()
+{
+    register I32 i;
+
+    for (i = 0; i < MAXXCOUNT; i++) {
+	if (xcount[i] > lastxcount[i]) {
+	    fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
+	    lastxcount[i] = xcount[i];
+	}
+    }
+}
+
+#endif /* LEAKTEST */
+
+/* copy a string up to some (non-backslashed) delimiter, if any */
+
+char *
+cpytill(to,from,fromend,delim,retlen)
+register char *to;
+register char *from;
+register char *fromend;
+register int delim;
+I32 *retlen;
+{
+    char *origto = to;
+
+    for (; from < fromend; from++,to++) {
+	if (*from == '\\') {
+	    if (from[1] == delim)
+		from++;
+	    else if (from[1] == '\\')
+		*to++ = *from++;
+	}
+	else if (*from == delim)
+	    break;
+	*to = *from;
+    }
+    *to = '\0';
+    *retlen = to - origto;
+    return from;
+}
+
+/* return ptr to little string in big string, NULL if not found */
+/* This routine was donated by Corey Satten. */
+
+char *
+instr(big, little)
+register char *big;
+register char *little;
+{
+    register char *s, *x;
+    register I32 first;
+
+    if (!little)
+	return big;
+    first = *little++;
+    if (!first)
+	return big;
+    while (*big) {
+	if (*big++ != first)
+	    continue;
+	for (x=big,s=little; *s; /**/ ) {
+	    if (!*x)
+		return Nullch;
+	    if (*s++ != *x++) {
+		s--;
+		break;
+	    }
+	}
+	if (!*s)
+	    return big-1;
+    }
+    return Nullch;
+}
+
+/* same as instr but allow embedded nulls */
+
+char *
+ninstr(big, bigend, little, lend)
+register char *big;
+register char *bigend;
+char *little;
+char *lend;
+{
+    register char *s, *x;
+    register I32 first = *little;
+    register char *littleend = lend;
+
+    if (!first && little >= littleend)
+	return big;
+    if (bigend - big < littleend - little)
+	return Nullch;
+    bigend -= littleend - little++;
+    while (big <= bigend) {
+	if (*big++ != first)
+	    continue;
+	for (x=big,s=little; s < littleend; /**/ ) {
+	    if (*s++ != *x++) {
+		s--;
+		break;
+	    }
+	}
+	if (s >= littleend)
+	    return big-1;
+    }
+    return Nullch;
+}
+
+/* reverse of the above--find last substring */
+
+char *
+rninstr(big, bigend, little, lend)
+register char *big;
+char *bigend;
+char *little;
+char *lend;
+{
+    register char *bigbeg;
+    register char *s, *x;
+    register I32 first = *little;
+    register char *littleend = lend;
+
+    if (!first && little >= littleend)
+	return bigend;
+    bigbeg = big;
+    big = bigend - (littleend - little++);
+    while (big >= bigbeg) {
+	if (*big-- != first)
+	    continue;
+	for (x=big+2,s=little; s < littleend; /**/ ) {
+	    if (*s++ != *x++) {
+		s--;
+		break;
+	    }
+	}
+	if (s >= littleend)
+	    return big+1;
+    }
+    return Nullch;
+}
+
+/* Initialize locale (and the fold[] array).*/
+int
+perl_init_i18nl14n(printwarn)	
+    int printwarn;
+{
+    int ok = 1;
+    /* returns
+     *    1 = set ok or not applicable,
+     *    0 = fallback to C locale,
+     *   -1 = fallback to C locale failed
+     */
+#if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
+    char * lang     = getenv("LANG");
+    char * lc_all   = getenv("LC_ALL");
+    char * lc_ctype = getenv("LC_CTYPE");
+    int i;
+
+    if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
+	if (printwarn) {
+	    fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
+	    fprintf(stderr,
+	      "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
+	      lc_all   ? lc_all   : "(null)",
+	      lc_ctype ? lc_ctype : "(null)",
+	      lang     ? lang     : "(null)"
+	      );
+	    fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
+	}
+	ok = 0;
+	if (setlocale(LC_CTYPE, "C") == NULL)
+	    ok = -1;
+    }
+
+    for (i = 0; i < 256; i++) {
+	if (isUPPER(i)) fold[i] = toLOWER(i);
+	else if (isLOWER(i)) fold[i] = toUPPER(i);
+	else fold[i] = i;
+    }
+#endif
+    return ok;
+}
+
+void
+fbm_compile(sv, iflag)
+SV *sv;
+I32 iflag;
+{
+    register unsigned char *s;
+    register unsigned char *table;
+    register U32 i;
+    register U32 len = SvCUR(sv);
+    I32 rarest = 0;
+    U32 frequency = 256;
+
+    if (len > 255)
+	return;			/* can't have offsets that big */
+    Sv_Grow(sv,len+258);
+    table = (unsigned char*)(SvPVX(sv) + len + 1);
+    s = table - 2;
+    for (i = 0; i < 256; i++) {
+	table[i] = len;
+    }
+    i = 0;
+    while (s >= (unsigned char*)(SvPVX(sv)))
+    {
+	if (table[*s] == len) {
+#ifndef pdp11
+	    if (iflag)
+		table[*s] = table[fold[*s]] = i;
+#else
+	    if (iflag) {
+		I32 j;
+		j = fold[*s];
+		table[j] = i;
+		table[*s] = i;
+	    }
+#endif /* pdp11 */
+	    else
+		table[*s] = i;
+	}
+	s--,i++;
+    }
+    sv_upgrade(sv, SVt_PVBM);
+    sv_magic(sv, Nullsv, 'B', Nullch, 0);			/* deep magic */
+    SvVALID_on(sv);
+
+    s = (unsigned char*)(SvPVX(sv));		/* deeper magic */
+    if (iflag) {
+	register U32 tmp, foldtmp;
+	SvCASEFOLD_on(sv);
+	for (i = 0; i < len; i++) {
+	    tmp=freq[s[i]];
+	    foldtmp=freq[fold[s[i]]];
+	    if (tmp < frequency && foldtmp < frequency) {
+		rarest = i;
+		/* choose most frequent among the two */
+		frequency = (tmp > foldtmp) ? tmp : foldtmp;
+	    }
+	}
+    }
+    else {
+	for (i = 0; i < len; i++) {
+	    if (freq[s[i]] < frequency) {
+		rarest = i;
+		frequency = freq[s[i]];
+	    }
+	}
+    }
+    BmRARE(sv) = s[rarest];
+    BmPREVIOUS(sv) = rarest;
+    DEBUG_r(fprintf(stderr,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
+}
+
+char *
+fbm_instr(big, bigend, littlestr)
+unsigned char *big;
+register unsigned char *bigend;
+SV *littlestr;
+{
+    register unsigned char *s;
+    register I32 tmp;
+    register I32 littlelen;
+    register unsigned char *little;
+    register unsigned char *table;
+    register unsigned char *olds;
+    register unsigned char *oldlittle;
+
+    if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
+	STRLEN len;
+	char *l = SvPV(littlestr,len);
+	if (!len)
+	    return (char*)big;
+	return ninstr((char*)big,(char*)bigend, l, l + len);
+    }
+
+    littlelen = SvCUR(littlestr);
+    if (SvTAIL(littlestr) && !multiline) {	/* tail anchored? */
+	if (littlelen > bigend - big)
+	    return Nullch;
+	little = (unsigned char*)SvPVX(littlestr);
+	if (SvCASEFOLD(littlestr)) {	/* oops, fake it */
+	    big = bigend - littlelen;		/* just start near end */
+	    if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
+		big--;
+	}
+	else {
+	    s = bigend - littlelen;
+	    if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
+		return (char*)s;		/* how sweet it is */
+	    else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
+	      && s > big) {
+		    s--;
+		if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
+		    return (char*)s;
+	    }
+	    return Nullch;
+	}
+    }
+    table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
+    if (--littlelen >= bigend - big)
+	return Nullch;
+    s = big + littlelen;
+    oldlittle = little = table - 2;
+    if (SvCASEFOLD(littlestr)) {	/* case insensitive? */
+	if (s < bigend) {
+	  top1:
+	    /*SUPPRESS 560*/
+	    if (tmp = table[*s]) {
+#ifdef POINTERRIGOR
+		if (bigend - s > tmp) {
+		    s += tmp;
+		    goto top1;
+		}
+#else
+		if ((s += tmp) < bigend)
+		    goto top1;
+#endif
+		return Nullch;
+	    }
+	    else {
+		tmp = littlelen;	/* less expensive than calling strncmp() */
+		olds = s;
+		while (tmp--) {
+		    if (*--s == *--little || fold[*s] == *little)
+			continue;
+		    s = olds + 1;	/* here we pay the price for failure */
+		    little = oldlittle;
+		    if (s < bigend)	/* fake up continue to outer loop */
+			goto top1;
+		    return Nullch;
+		}
+		return (char *)s;
+	    }
+	}
+    }
+    else {
+	if (s < bigend) {
+	  top2:
+	    /*SUPPRESS 560*/
+	    if (tmp = table[*s]) {
+#ifdef POINTERRIGOR
+		if (bigend - s > tmp) {
+		    s += tmp;
+		    goto top2;
+		}
+#else
+		if ((s += tmp) < bigend)
+		    goto top2;
+#endif
+		return Nullch;
+	    }
+	    else {
+		tmp = littlelen;	/* less expensive than calling strncmp() */
+		olds = s;
+		while (tmp--) {
+		    if (*--s == *--little)
+			continue;
+		    s = olds + 1;	/* here we pay the price for failure */
+		    little = oldlittle;
+		    if (s < bigend)	/* fake up continue to outer loop */
+			goto top2;
+		    return Nullch;
+		}
+		return (char *)s;
+	    }
+	}
+    }
+    return Nullch;
+}
+
+char *
+screaminstr(bigstr, littlestr)
+SV *bigstr;
+SV *littlestr;
+{
+    register unsigned char *s, *x;
+    register unsigned char *big;
+    register I32 pos;
+    register I32 previous;
+    register I32 first;
+    register unsigned char *little;
+    register unsigned char *bigend;
+    register unsigned char *littleend;
+
+    if ((pos = screamfirst[BmRARE(littlestr)]) < 0) 
+	return Nullch;
+    little = (unsigned char *)(SvPVX(littlestr));
+    littleend = little + SvCUR(littlestr);
+    first = *little++;
+    previous = BmPREVIOUS(littlestr);
+    big = (unsigned char *)(SvPVX(bigstr));
+    bigend = big + SvCUR(bigstr);
+    while (pos < previous) {
+	if (!(pos += screamnext[pos]))
+	    return Nullch;
+    }
+#ifdef POINTERRIGOR
+    if (SvCASEFOLD(littlestr)) {	/* case insignificant? */
+	do {
+	    if (big[pos-previous] != first && big[pos-previous] != fold[first])
+		continue;
+	    for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+		return (char *)(big+pos-previous);
+	} while (
+		pos += screamnext[pos]	/* does this goof up anywhere? */
+	    );
+    }
+    else {
+	do {
+	    if (big[pos-previous] != first)
+		continue;
+	    for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+		return (char *)(big+pos-previous);
+	} while ( pos += screamnext[pos] );
+    }
+#else /* !POINTERRIGOR */
+    big -= previous;
+    if (SvCASEFOLD(littlestr)) {	/* case insignificant? */
+	do {
+	    if (big[pos] != first && big[pos] != fold[first])
+		continue;
+	    for (x=big+pos+1,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+		return (char *)(big+pos);
+	} while (
+		pos += screamnext[pos]	/* does this goof up anywhere? */
+	    );
+    }
+    else {
+	do {
+	    if (big[pos] != first)
+		continue;
+	    for (x=big+pos+1,s=little; s < littleend; /**/ ) {
+		if (x >= bigend)
+		    return Nullch;
+		if (*s++ != *x++) {
+		    s--;
+		    break;
+		}
+	    }
+	    if (s == littleend)
+		return (char *)(big+pos);
+	} while (
+		pos += screamnext[pos]
+	    );
+    }
+#endif /* POINTERRIGOR */
+    return Nullch;
+}
+
+I32
+ibcmp(a,b,len)
+register U8 *a;
+register U8 *b;
+register I32 len;
+{
+    while (len--) {
+	if (*a == *b) {
+	    a++,b++;
+	    continue;
+	}
+	if (fold[*a++] == *b++)
+	    continue;
+	return 1;
+    }
+    return 0;
+}
+
+/* copy a string to a safe spot */
+
+char *
+savepv(sv)
+char *sv;
+{
+    register char *newaddr;
+
+    New(902,newaddr,strlen(sv)+1,char);
+    (void)strcpy(newaddr,sv);
+    return newaddr;
+}
+
+/* same thing but with a known length */
+
+char *
+savepvn(sv, len)
+char *sv;
+register I32 len;
+{
+    register char *newaddr;
+
+    New(903,newaddr,len+1,char);
+    Copy(sv,newaddr,len,char);		/* might not be null terminated */
+    newaddr[len] = '\0';		/* is now */
+    return newaddr;
+}
+
+#if !defined(I_STDARG) && !defined(I_VARARGS)
+
+/*
+ * Fallback on the old hackers way of doing varargs
+ */
+
+/*VARARGS1*/
+char *
+mess(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    char *s;
+    char *s_start;
+    I32 usermess = strEQ(pat,"%s");
+    SV *tmpstr;
+
+    s = s_start = buf;
+    if (usermess) {
+	tmpstr = sv_newmortal();
+	sv_setpv(tmpstr, (char*)a1);
+	*s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+    }
+    else {
+	(void)sprintf(s,pat,a1,a2,a3,a4);
+	s += strlen(s);
+    }
+
+    if (s[-1] != '\n') {
+	if (dirty)
+	    strcpy(s, " during global destruction.\n");
+	else {
+	    if (curcop->cop_line) {
+		(void)sprintf(s," at %s line %ld",
+		  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
+		s += strlen(s);
+	    }
+	    if (GvIO(last_in_gv) &&
+		IoLINES(GvIOp(last_in_gv)) ) {
+		(void)sprintf(s,", <%s> %s %ld",
+		  last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
+		  strEQ(rs,"\n") ? "line" : "chunk", 
+		  (long)IoLINES(GvIOp(last_in_gv)));
+		s += strlen(s);
+	    }
+	    (void)strcpy(s,".\n");
+	    s += 2;
+	}
+	if (usermess)
+	    sv_catpv(tmpstr,buf+1);
+    }
+
+    if (s - s_start >= sizeof(buf)) {	/* Ooops! */
+	if (usermess)
+	    fputs(SvPVX(tmpstr), stderr);
+	else
+	    fputs(buf, stderr);
+	fputs("panic: message overflow - memory corrupted!\n",stderr);
+	my_exit(1);
+    }
+    if (usermess)
+	return SvPVX(tmpstr);
+    else
+	return buf;
+}
+
+/*VARARGS1*/
+void croak(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    char *tmps;
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+    message = mess(pat,a1,a2,a3,a4);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    if (in_eval) {
+	restartop = die_where(message);
+	Siglongjmp(top_env, 3);
+    }
+    fputs(message,stderr);
+    (void)Fflush(stderr);
+    if (e_tmpname) {
+	if (e_fp) {
+	    fclose(e_fp);
+	    e_fp = Nullfp;
+	}
+	(void)UNLINK(e_tmpname);
+	Safefree(e_tmpname);
+	e_tmpname = Nullch;
+    }
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
+    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
+}
+
+/*VARARGS1*/
+void warn(pat,a1,a2,a3,a4)
+char *pat;
+long a1, a2, a3, a4;
+{
+    char *message;
+    SV *sv;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+    message = mess(pat,a1,a2,a3,a4);
+    if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    else {
+	fputs(message,stderr);
+#ifdef LEAKTEST
+	DEBUG_L(xstat());
+#endif
+	(void)Fflush(stderr);
+    }
+}
+
+#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
+
+#ifdef I_STDARG
+char *
+mess(char *pat, va_list *args)
+#else
+/*VARARGS0*/
+char *
+mess(pat, args)
+    char *pat;
+    va_list *args;
+#endif
+{
+    char *s;
+    char *s_start;
+    SV *tmpstr;
+    I32 usermess;
+#ifndef HAS_VPRINTF
+#ifdef USE_CHAR_VSPRINTF
+    char *vsprintf();
+#else
+    I32 vsprintf();
+#endif
+#endif
+
+    s = s_start = buf;
+    usermess = strEQ(pat, "%s");
+    if (usermess) {
+	tmpstr = sv_newmortal();
+	sv_setpv(tmpstr, va_arg(*args, char *));
+	*s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+    }
+    else {
+	(void) vsprintf(s,pat,*args);
+	s += strlen(s);
+    }
+    va_end(*args);
+
+    if (s[-1] != '\n') {
+	if (dirty)
+	    strcpy(s, " during global destruction.\n");
+	else {
+	    if (curcop->cop_line) {
+		(void)sprintf(s," at %s line %ld",
+		  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
+		s += strlen(s);
+	    }
+	    if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
+		bool line_mode = (RsSIMPLE(rs) &&
+				  SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
+		(void)sprintf(s,", <%s> %s %ld",
+		  last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
+		  line_mode ? "line" : "chunk", 
+		  (long)IoLINES(GvIOp(last_in_gv)));
+		s += strlen(s);
+	    }
+	    (void)strcpy(s,".\n");
+	    s += 2;
+	}
+	if (usermess)
+	    sv_catpv(tmpstr,buf+1);
+    }
+
+    if (s - s_start >= sizeof(buf)) {	/* Ooops! */
+	if (usermess)
+	    fputs(SvPVX(tmpstr), stderr);
+	else
+	    fputs(buf, stderr);
+	fputs("panic: message overflow - memory corrupted!\n",stderr);
+	my_exit(1);
+    }
+    if (usermess)
+	return SvPVX(tmpstr);
+    else
+	return buf;
+}
+
+#ifdef I_STDARG
+void
+croak(char* pat, ...)
+#else
+/*VARARGS0*/
+void
+croak(pat, va_alist)
+    char *pat;
+    va_dcl
+#endif
+{
+    va_list args;
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+#ifdef I_STDARG
+    va_start(args, pat);
+#else
+    va_start(args);
+#endif
+    message = mess(pat, &args);
+    va_end(args);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    if (in_eval) {
+	restartop = die_where(message);
+	Siglongjmp(top_env, 3);
+    }
+    fputs(message,stderr);
+    (void)Fflush(stderr);
+    if (e_tmpname) {
+	if (e_fp) {
+	    fclose(e_fp);
+	    e_fp = Nullfp;
+	}
+	(void)UNLINK(e_tmpname);
+	Safefree(e_tmpname);
+	e_tmpname = Nullch;
+    }
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
+#else
+    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
+}
+
+void
+#ifdef I_STDARG
+warn(char* pat,...)
+#else
+/*VARARGS0*/
+warn(pat,va_alist)
+    char *pat;
+    va_dcl
+#endif
+{
+    va_list args;
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+#ifdef I_STDARG
+    va_start(args, pat);
+#else
+    va_start(args);
+#endif
+    message = mess(pat, &args);
+    va_end(args);
+
+    if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    else {
+	fputs(message,stderr);
+#ifdef LEAKTEST
+	DEBUG_L(xstat());
+#endif
+	(void)Fflush(stderr);
+    }
+}
+#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
+
+#ifndef VMS  /* VMS' my_setenv() is in VMS.c */
+void
+my_setenv(nam,val)
+char *nam, *val;
+{
+    register I32 i=setenv_getix(nam);		/* where does it go? */
+
+    if (environ == origenviron) {	/* need we copy environment? */
+	I32 j;
+	I32 max;
+	char **tmpenv;
+
+	/*SUPPRESS 530*/
+	for (max = i; environ[max]; max++) ;
+	New(901,tmpenv, max+2, char*);
+	for (j=0; j<max; j++)		/* copy environment */
+	    tmpenv[j] = savepv(environ[j]);
+	tmpenv[max] = Nullch;
+	environ = tmpenv;		/* tell exec where it is now */
+    }
+    if (!val) {
+	while (environ[i]) {
+	    environ[i] = environ[i+1];
+	    i++;
+	}
+	return;
+    }
+    if (!environ[i]) {			/* does not exist yet */
+	Renew(environ, i+2, char*);	/* just expand it a bit */
+	environ[i+1] = Nullch;	/* make sure it's null terminated */
+    }
+    else
+	Safefree(environ[i]);
+    New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
+#ifndef MSDOS
+    (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
+#else
+    /* MS-DOS requires environment variable names to be in uppercase */
+    /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
+     * some utilities and applications may break because they only look
+     * for upper case strings. (Fixed strupr() bug here.)]
+     */
+    strcpy(environ[i],nam); strupr(environ[i]);
+    (void)sprintf(environ[i] + strlen(nam),"=%s",val);
+#endif /* MSDOS */
+}
+
+I32
+setenv_getix(nam)
+char *nam;
+{
+    register I32 i, len = strlen(nam);
+
+    for (i = 0; environ[i]; i++) {
+	if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
+	    break;			/* strnEQ must come first to avoid */
+    }					/* potential SEGV's */
+    return i;
+}
+#endif /* !VMS */
+
+#ifdef UNLINK_ALL_VERSIONS
+I32
+unlnk(f)	/* unlink all versions of a file */
+char *f;
+{
+    I32 i;
+
+    for (i = 0; unlink(f) >= 0; i++) ;
+    return i ? 0 : -1;
+}
+#endif
+
+#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
+char *
+my_bcopy(from,to,len)
+register char *from;
+register char *to;
+register I32 len;
+{
+    char *retval = to;
+
+    if (from - to >= 0) {
+	while (len--)
+	    *to++ = *from++;
+    }
+    else {
+	to += len;
+	from += len;
+	while (len--)
+	    *(--to) = *(--from);
+    }
+    return retval;
+}
+#endif
+
+#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
+char *
+my_bzero(loc,len)
+register char *loc;
+register I32 len;
+{
+    char *retval = loc;
+
+    while (len--)
+	*loc++ = 0;
+    return retval;
+}
+#endif
+
+#ifndef HAS_MEMCMP
+I32
+my_memcmp(s1,s2,len)
+register unsigned char *s1;
+register unsigned char *s2;
+register I32 len;
+{
+    register I32 tmp;
+
+    while (len--) {
+	if (tmp = *s1++ - *s2++)
+	    return tmp;
+    }
+    return 0;
+}
+#endif /* HAS_MEMCMP */
+
+#if defined(I_STDARG) || defined(I_VARARGS)
+#ifndef HAS_VPRINTF
+
+#ifdef USE_CHAR_VSPRINTF
+char *
+#else
+int
+#endif
+vsprintf(dest, pat, args)
+char *dest, *pat, *args;
+{
+    FILE fakebuf;
+
+    fakebuf._ptr = dest;
+    fakebuf._cnt = 32767;
+#ifndef _IOSTRG
+#define _IOSTRG 0
+#endif
+    fakebuf._flag = _IOWRT|_IOSTRG;
+    _doprnt(pat, args, &fakebuf);	/* what a kludge */
+    (void)putc('\0', &fakebuf);
+#ifdef USE_CHAR_VSPRINTF
+    return(dest);
+#else
+    return 0;		/* perl doesn't use return value */
+#endif
+}
+
+int
+vfprintf(fd, pat, args)
+FILE *fd;
+char *pat, *args;
+{
+    _doprnt(pat, args, fd);
+    return 0;		/* wrong, but perl doesn't use the return value */
+}
+#endif /* HAS_VPRINTF */
+#endif /* I_VARARGS || I_STDARGS */
+
+#ifdef MYSWAP
+#if BYTEORDER != 0x4321
+short
+#ifndef CAN_PROTOTYPE
+my_swap(s)
+short s;
+#else
+my_swap(short s)
+#endif
+{
+#if (BYTEORDER & 1) == 0
+    short result;
+
+    result = ((s & 255) << 8) + ((s >> 8) & 255);
+    return result;
+#else
+    return s;
+#endif
+}
+
+long
+#ifndef CAN_PROTOTYPE
+my_htonl(l)
+register long l;
+#else
+my_htonl(long l)
+#endif
+{
+    union {
+	long result;
+	char c[sizeof(long)];
+    } u;
+
+#if BYTEORDER == 0x1234
+    u.c[0] = (l >> 24) & 255;
+    u.c[1] = (l >> 16) & 255;
+    u.c[2] = (l >> 8) & 255;
+    u.c[3] = l & 255;
+    return u.result;
+#else
+#if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
+    croak("Unknown BYTEORDER\n");
+#else
+    register I32 o;
+    register I32 s;
+
+    for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
+	u.c[o & 0xf] = (l >> s) & 255;
+    }
+    return u.result;
+#endif
+#endif
+}
+
+long
+#ifndef CAN_PROTOTYPE
+my_ntohl(l)
+register long l;
+#else
+my_ntohl(long l)
+#endif
+{
+    union {
+	long l;
+	char c[sizeof(long)];
+    } u;
+
+#if BYTEORDER == 0x1234
+    u.c[0] = (l >> 24) & 255;
+    u.c[1] = (l >> 16) & 255;
+    u.c[2] = (l >> 8) & 255;
+    u.c[3] = l & 255;
+    return u.l;
+#else
+#if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
+    croak("Unknown BYTEORDER\n");
+#else
+    register I32 o;
+    register I32 s;
+
+    u.l = l;
+    l = 0;
+    for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
+	l |= (u.c[o & 0xf] & 255) << s;
+    }
+    return l;
+#endif
+#endif
+}
+
+#endif /* BYTEORDER != 0x4321 */
+#endif /* MYSWAP */
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * If these functions are defined,
+ * the BYTEORDER is neither 0x1234 nor 0x4321.
+ * However, this is not assumed.
+ * -DWS
+ */
+
+#define HTOV(name,type)						\
+	type							\
+	name (n)						\
+	register type n;					\
+	{							\
+	    union {						\
+		type value;					\
+		char c[sizeof(type)];				\
+	    } u;						\
+	    register I32 i;					\
+	    register I32 s;					\
+	    for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {	\
+		u.c[i] = (n >> s) & 0xFF;			\
+	    }							\
+	    return u.value;					\
+	}
+
+#define VTOH(name,type)						\
+	type							\
+	name (n)						\
+	register type n;					\
+	{							\
+	    union {						\
+		type value;					\
+		char c[sizeof(type)];				\
+	    } u;						\
+	    register I32 i;					\
+	    register I32 s;					\
+	    u.value = n;					\
+	    n = 0;						\
+	    for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {	\
+		n += (u.c[i] & 0xFF) << s;			\
+	    }							\
+	    return n;						\
+	}
+
+#if defined(HAS_HTOVS) && !defined(htovs)
+HTOV(htovs,short)
+#endif
+#if defined(HAS_HTOVL) && !defined(htovl)
+HTOV(htovl,long)
+#endif
+#if defined(HAS_VTOHS) && !defined(vtohs)
+VTOH(vtohs,short)
+#endif
+#if defined(HAS_VTOHL) && !defined(vtohl)
+VTOH(vtohl,long)
+#endif
+
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in
+					   VMS.c, same with OS/2. */
+FILE *
+my_popen(cmd,mode)
+char	*cmd;
+char	*mode;
+{
+    int p[2];
+    register I32 this, that;
+    register I32 pid;
+    SV *sv;
+    I32 doexec = strNE(cmd,"-");
+
+    if (pipe(p) < 0)
+	return Nullfp;
+    this = (*mode == 'w');
+    that = !this;
+    if (tainting) {
+	if (doexec) {
+	    taint_env();
+	    taint_proper("Insecure %s%s", "EXEC");
+	}
+    }
+    while ((pid = (doexec?vfork():fork())) < 0) {
+	if (errno != EAGAIN) {
+	    close(p[this]);
+	    if (!doexec)
+		croak("Can't fork");
+	    return Nullfp;
+	}
+	sleep(5);
+    }
+    if (pid == 0) {
+	GV* tmpgv;
+
+#define THIS that
+#define THAT this
+	close(p[THAT]);
+	if (p[THIS] != (*mode == 'r')) {
+	    dup2(p[THIS], *mode == 'r');
+	    close(p[THIS]);
+	}
+	if (doexec) {
+#if !defined(HAS_FCNTL) || !defined(F_SETFD)
+	    int fd;
+
+#ifndef NOFILE
+#define NOFILE 20
+#endif
+	    for (fd = maxsysfd + 1; fd < NOFILE; fd++)
+		close(fd);
+#endif
+	    do_exec(cmd);	/* may or may not use the shell */
+	    _exit(1);
+	}
+	/*SUPPRESS 560*/
+	if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
+	    sv_setiv(GvSV(tmpgv),(I32)getpid());
+	forkprocess = 0;
+	hv_clear(pidstatus);	/* we have no children */
+	return Nullfp;
+#undef THIS
+#undef THAT
+    }
+    do_execfree();	/* free any memory malloced by child on vfork */
+    close(p[that]);
+    if (p[that] < p[this]) {
+	dup2(p[this], p[that]);
+	close(p[this]);
+	p[this] = p[that];
+    }
+    sv = *av_fetch(fdpid,p[this],TRUE);
+    (void)SvUPGRADE(sv,SVt_IV);
+    SvIVX(sv) = pid;
+    forkprocess = pid;
+    return fdopen(p[this], mode);
+}
+#else
+#if defined(atarist)
+FILE *popen();
+FILE *
+my_popen(cmd,mode)
+char	*cmd;
+char	*mode;
+{
+    return popen(cmd, mode);
+}
+#endif
+
+#endif /* !DOSISH */
+
+#ifdef DUMP_FDS
+dump_fds(s)
+char *s;
+{
+    int fd;
+    struct stat tmpstatbuf;
+
+    fprintf(stderr,"%s", s);
+    for (fd = 0; fd < 32; fd++) {
+	if (Fstat(fd,&tmpstatbuf) >= 0)
+	    fprintf(stderr," %d",fd);
+    }
+    fprintf(stderr,"\n");
+}
+#endif
+
+#ifndef HAS_DUP2
+int
+dup2(oldfd,newfd)
+int oldfd;
+int newfd;
+{
+#if defined(HAS_FCNTL) && defined(F_DUPFD)
+    if (oldfd == newfd)
+	return oldfd;
+    close(newfd);
+    return fcntl(oldfd, F_DUPFD, newfd);
+#else
+    int fdtmp[256];
+    I32 fdx = 0;
+    int fd;
+
+    if (oldfd == newfd)
+	return oldfd;
+    close(newfd);
+    while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
+	fdtmp[fdx++] = fd;
+    while (fdx > 0)
+	close(fdtmp[--fdx]);
+    return fd;
+#endif
+}
+#endif
+
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
+I32
+my_pclose(ptr)
+FILE *ptr;
+{
+    Signal_t (*hstat)(), (*istat)(), (*qstat)();
+    int status;
+    SV **svp;
+    int pid;
+
+    svp = av_fetch(fdpid,fileno(ptr),TRUE);
+    pid = (int)SvIVX(*svp);
+    SvREFCNT_dec(*svp);
+    *svp = &sv_undef;
+    fclose(ptr);
+#ifdef UTS
+    if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
+#endif
+    hstat = signal(SIGHUP, SIG_IGN);
+    istat = signal(SIGINT, SIG_IGN);
+    qstat = signal(SIGQUIT, SIG_IGN);
+    do {
+	pid = wait4pid(pid, &status, 0);
+    } while (pid == -1 && errno == EINTR);
+    signal(SIGHUP, hstat);
+    signal(SIGINT, istat);
+    signal(SIGQUIT, qstat);
+    return(pid < 0 ? pid : status);
+}
+#endif /* !DOSISH */
+
+#if  !defined(DOSISH) || defined(OS2)
+I32
+wait4pid(pid,statusp,flags)
+int pid;
+int *statusp;
+int flags;
+{
+    SV *sv;
+    SV** svp;
+    char spid[16];
+
+    if (!pid)
+	return -1;
+    if (pid > 0) {
+	sprintf(spid, "%d", pid);
+	svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
+	if (svp && *svp != &sv_undef) {
+	    *statusp = SvIVX(*svp);
+	    (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
+	    return pid;
+	}
+    }
+    else {
+	HE *entry;
+
+	hv_iterinit(pidstatus);
+	if (entry = hv_iternext(pidstatus)) {
+	    pid = atoi(hv_iterkey(entry,(I32*)statusp));
+	    sv = hv_iterval(pidstatus,entry);
+	    *statusp = SvIVX(sv);
+	    sprintf(spid, "%d", pid);
+	    (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
+	    return pid;
+	}
+    }
+#ifdef HAS_WAITPID
+    return waitpid(pid,statusp,flags);
+#else
+#ifdef HAS_WAIT4
+    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+#else
+    {
+	I32 result;
+	if (flags)
+	    croak("Can't do waitpid with flags");
+	else {
+	    while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
+		pidgone(result,*statusp);
+	    if (result < 0)
+		*statusp = -1;
+	}
+	return result;
+    }
+#endif
+#endif
+}
+#endif /* !DOSISH */
+
+void
+/*SUPPRESS 590*/
+pidgone(pid,status)
+int pid;
+int status;
+{
+    register SV *sv;
+    char spid[16];
+
+    sprintf(spid, "%d", pid);
+    sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
+    (void)SvUPGRADE(sv,SVt_IV);
+    SvIVX(sv) = status;
+    return;
+}
+
+#if defined(atarist) || defined(OS2)
+int pclose();
+I32
+my_pclose(ptr)
+FILE *ptr;
+{
+    return pclose(ptr);
+}
+#endif
+
+void
+repeatcpy(to,from,len,count)
+register char *to;
+register char *from;
+I32 len;
+register I32 count;
+{
+    register I32 todo;
+    register char *frombase = from;
+
+    if (len == 1) {
+	todo = *from;
+	while (count-- > 0)
+	    *to++ = todo;
+	return;
+    }
+    while (count-- > 0) {
+	for (todo = len; todo > 0; todo--) {
+	    *to++ = *from++;
+	}
+	from = frombase;
+    }
+}
+
+#ifndef CASTNEGFLOAT
+U32
+cast_ulong(f)
+double f;
+{
+    long along;
+
+#if CASTFLAGS & 2
+#   define BIGDOUBLE 2147483648.0
+    if (f >= BIGDOUBLE)
+	return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
+#endif
+    if (f >= 0.0)
+	return (unsigned long)f;
+    along = (long)f;
+    return (unsigned long)along;
+}
+# undef BIGDOUBLE
+#endif
+
+#ifndef CASTI32
+
+/* Look for MAX and MIN integral values.  If we can't find them,
+   we'll use 32-bit two's complement defaults.
+*/
+#ifndef LONG_MAX
+#  ifdef MAXLONG    /* Often used in <values.h> */
+#    define LONG_MAX MAXLONG
+#  else
+#    define LONG_MAX        2147483647L
+#  endif
+#endif
+
+#ifndef LONG_MIN
+#    define LONG_MIN        (-LONG_MAX - 1)
+#endif
+
+#ifndef ULONG_MAX
+#  ifdef MAXULONG 
+#    define LONG_MAX MAXULONG
+#  else
+#    define ULONG_MAX       4294967295L
+#  endif
+#endif
+
+/* Unfortunately, on some systems the cast_uv() function doesn't
+   work with the system-supplied definition of ULONG_MAX.  The
+   comparison  (f >= ULONG_MAX) always comes out true.  It must be a
+   problem with the compiler constant folding.
+
+   In any case, this workaround should be fine on any two's complement
+   system.  If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
+   ccflags.
+	       --Andy Dougherty      <doughera@lafcol.lafayette.edu>
+*/
+#ifndef MY_ULONG_MAX
+#  define MY_ULONG_MAX ((UV)LONG_MAX * (UV)2 + (UV)1)
+#endif
+
+I32
+cast_i32(f)
+double f;
+{
+    if (f >= LONG_MAX)
+	return (I32) LONG_MAX;
+    if (f <= LONG_MIN)
+	return (I32) LONG_MIN;
+    return (I32) f;
+}
+
+IV
+cast_iv(f)
+double f;
+{
+    if (f >= LONG_MAX)
+	return (IV) LONG_MAX;
+    if (f <= LONG_MIN)
+	return (IV) LONG_MIN;
+    return (IV) f;
+}
+
+UV
+cast_uv(f)
+double f;
+{
+    if (f >= MY_ULONG_MAX)
+	return (UV) MY_ULONG_MAX;
+    return (UV) f;
+}
+
+#endif
+
+#ifndef HAS_RENAME
+I32
+same_dirent(a,b)
+char *a;
+char *b;
+{
+    char *fa = strrchr(a,'/');
+    char *fb = strrchr(b,'/');
+    struct stat tmpstatbuf1;
+    struct stat tmpstatbuf2;
+#ifndef MAXPATHLEN
+#define MAXPATHLEN 1024
+#endif
+    char tmpbuf[MAXPATHLEN+1];
+
+    if (fa)
+	fa++;
+    else
+	fa = a;
+    if (fb)
+	fb++;
+    else
+	fb = b;
+    if (strNE(a,b))
+	return FALSE;
+    if (fa == a)
+	strcpy(tmpbuf,".");
+    else
+	strncpy(tmpbuf, a, fa - a);
+    if (Stat(tmpbuf, &tmpstatbuf1) < 0)
+	return FALSE;
+    if (fb == b)
+	strcpy(tmpbuf,".");
+    else
+	strncpy(tmpbuf, b, fb - b);
+    if (Stat(tmpbuf, &tmpstatbuf2) < 0)
+	return FALSE;
+    return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
+	   tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
+}
+#endif /* !HAS_RENAME */
+
+unsigned long
+scan_oct(start, len, retlen)
+char *start;
+I32 len;
+I32 *retlen;
+{
+    register char *s = start;
+    register unsigned long retval = 0;
+
+    while (len && *s >= '0' && *s <= '7') {
+	retval <<= 3;
+	retval |= *s++ - '0';
+	len--;
+    }
+    if (dowarn && len && (*s == '8' || *s == '9'))
+	warn("Illegal octal digit ignored");
+    *retlen = s - start;
+    return retval;
+}
+
+unsigned long
+scan_hex(start, len, retlen)
+char *start;
+I32 len;
+I32 *retlen;
+{
+    register char *s = start;
+    register unsigned long retval = 0;
+    char *tmp;
+
+    while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
+	retval <<= 4;
+	retval |= (tmp - hexdigit) & 15;
+	s++;
+    }
+    *retlen = s - start;
+    return retval;
+}
diff --git a/gnu/usr.bin/perl/util.h b/gnu/usr.bin/perl/util.h
new file mode 100644
index 00000000000..df518467342
--- /dev/null
+++ b/gnu/usr.bin/perl/util.h
@@ -0,0 +1,8 @@
+/*    util.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
diff --git a/gnu/usr.bin/perl/utils/Makefile b/gnu/usr.bin/perl/utils/Makefile
new file mode 100644
index 00000000000..33947c87f18
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/Makefile
@@ -0,0 +1,24 @@
+
+PERL = ../miniperl
+
+# Files to be built with variable substitution after miniperl is
+# available.  Dependencies handled manually below (for now).
+
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL
+
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL
+plextract  = c2ph h2ph h2xs perlbug perldoc pl2pm
+
+all: $(plextract)
+
+$(plextract):
+	$(PERL) -I../lib $@.PL
+
+clean:
+
+realclean:
+	rm -rf $(plextract) pstruct
+
+clobber:	realclean
+
+distclean:	clobber
diff --git a/gnu/usr.bin/perl/utils/c2ph.PL b/gnu/usr.bin/perl/utils/c2ph.PL
new file mode 100644
index 00000000000..219af029331
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/c2ph.PL
@@ -0,0 +1,1401 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+#
+#
+#   c2ph (aka pstruct)
+#   Tom Christiansen, <tchrist@convex.com>
+#
+#   As pstruct, dump C structures as generated from 'cc -g -S' stabs.
+#   As c2ph, do this PLUS generate perl code for getting at the structures.
+#
+#   See the usage message for more.  If this isn't enough, read the code.
+#
+
+=head1 NAME
+
+c2ph,pstruct - Dump C structures as generated from 'cc -g -S' stabs
+
+=head1 SYNOPSIS
+
+    c2ph [-dpnP] [var=val] [files ...]
+
+=head2 OPTIONS
+
+    Options:
+
+    -w	wide; short for: type_width=45 member_width=35 offset_width=8
+    -x	hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
+
+    -n	do not generate perl code  (default when invoked as pstruct)
+    -p	generate perl code         (default when invoked as c2ph)
+    -v	generate perl code, with C decls as comments
+
+    -i	do NOT recompute sizes for intrinsic datatypes
+    -a	dump information on intrinsics also
+
+    -t	trace execution
+    -d	spew reams of debugging output
+
+    -slist  give comma-separated list a structures to dump
+
+=head1 DESCRIPTION
+
+The following is the old c2ph.doc documentation by Tom Christiansen
+<tchrist@perl.com>
+Date: 25 Jul 91 08:10:21 GMT
+
+Once upon a time, I wrote a program called pstruct.  It was a perl
+program that tried to parse out C structures and display their member
+offsets for you.  This was especially useful for people looking at
+binary dumps or poking around the kernel.
+
+Pstruct was not a pretty program.  Neither was it particularly robust.
+The problem, you see, was that the C compiler was much better at parsing
+C than I could ever hope to be.
+
+So I got smart:  I decided to be lazy and let the C compiler parse the C,
+which would spit out debugger stabs for me to read.  These were much
+easier to parse.  It's still not a pretty program, but at least it's more
+robust.
+
+Pstruct takes any .c or .h files, or preferably .s ones, since that's
+the format it is going to massage them into anyway, and spits out
+listings like this:
+
+struct tty {
+  int                          tty.t_locker                         000      4
+  int                          tty.t_mutex_index                    004      4
+  struct tty *                 tty.t_tp_virt                        008      4
+  struct clist                 tty.t_rawq                           00c     20
+    int                        tty.t_rawq.c_cc                      00c      4
+    int                        tty.t_rawq.c_cmax                    010      4
+    int                        tty.t_rawq.c_cfx                     014      4
+    int                        tty.t_rawq.c_clx                     018      4
+    struct tty *               tty.t_rawq.c_tp_cpu                  01c      4
+    struct tty *               tty.t_rawq.c_tp_iop                  020      4
+    unsigned char *            tty.t_rawq.c_buf_cpu                 024      4
+    unsigned char *            tty.t_rawq.c_buf_iop                 028      4
+  struct clist                 tty.t_canq                           02c     20
+    int                        tty.t_canq.c_cc                      02c      4
+    int                        tty.t_canq.c_cmax                    030      4
+    int                        tty.t_canq.c_cfx                     034      4
+    int                        tty.t_canq.c_clx                     038      4
+    struct tty *               tty.t_canq.c_tp_cpu                  03c      4
+    struct tty *               tty.t_canq.c_tp_iop                  040      4
+    unsigned char *            tty.t_canq.c_buf_cpu                 044      4
+    unsigned char *            tty.t_canq.c_buf_iop                 048      4
+  struct clist                 tty.t_outq                           04c     20
+    int                        tty.t_outq.c_cc                      04c      4
+    int                        tty.t_outq.c_cmax                    050      4
+    int                        tty.t_outq.c_cfx                     054      4
+    int                        tty.t_outq.c_clx                     058      4
+    struct tty *               tty.t_outq.c_tp_cpu                  05c      4
+    struct tty *               tty.t_outq.c_tp_iop                  060      4
+    unsigned char *            tty.t_outq.c_buf_cpu                 064      4
+    unsigned char *            tty.t_outq.c_buf_iop                 068      4
+  (*int)()                     tty.t_oproc_cpu                      06c      4
+  (*int)()                     tty.t_oproc_iop                      070      4
+  (*int)()                     tty.t_stopproc_cpu                   074      4
+  (*int)()                     tty.t_stopproc_iop                   078      4
+  struct thread *              tty.t_rsel                           07c      4
+
+  etc.
+
+
+Actually, this was generated by a particular set of options.  You can control
+the formatting of each column, whether you prefer wide or fat, hex or decimal,
+leading zeroes or whatever.
+
+All you need to be able to use this is a C compiler than generates
+BSD/GCC-style stabs.  The -g option on native BSD compilers and GCC
+should get this for you.
+
+To learn more, just type a bogus option, like -\?, and a long usage message
+will be provided.  There are a fair number of possibilities.
+
+If you're only a C programmer, than this is the end of the message for you.
+You can quit right now, and if you care to, save off the source and run it
+when you feel like it.  Or not.
+
+
+
+But if you're a perl programmer, then for you I have something much more
+wondrous than just a structure offset printer.
+
+You see, if you call pstruct by its other incybernation, c2ph, you have a code
+generator that translates C code into perl code!  Well, structure and union
+declarations at least, but that's quite a bit.
+
+Prior to this point, anyone programming in perl who wanted to interact
+with C programs, like the kernel, was forced to guess the layouts of
+the C strutures, and then hardwire these into his program.  Of course,
+when you took your wonderfully crafted program to a system where the
+sgtty structure was laid out differently, you program broke.  Which is
+a shame.
+
+We've had Larry's h2ph translator, which helped, but that only works on
+cpp symbols, not real C, which was also very much needed.  What I offer
+you is a symbolic way of getting at all the C structures.  I've couched
+them in terms of packages and functions.  Consider the following program:
+
+    #!/usr/local/bin/perl
+
+    require 'syscall.ph';
+    require 'sys/time.ph';
+    require 'sys/resource.ph';
+
+    $ru = "\0" x &rusage'sizeof();
+
+    syscall(&SYS_getrusage, &RUSAGE_SELF, $ru)      && die "getrusage: $!";
+
+    @ru = unpack($t = &rusage'typedef(), $ru);
+
+    $utime =  $ru[ &rusage'ru_utime + &timeval'tv_sec  ]
+	   + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6;
+
+    $stime =  $ru[ &rusage'ru_stime + &timeval'tv_sec  ]
+	   + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6;
+
+    printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime;
+
+
+As you see, the name of the package is the name of the structure.  Regular
+fields are just their own names.  Plus the follwoing  accessor functions are
+provided for your convenience:
+
+    struct	This takes no arguments, and is merely the number of first-level
+		elements in the structure.  You would use this for indexing
+		into arrays of structures, perhaps like this
+
+
+		    $usec = $u[ &user'u_utimer
+				+ (&ITIMER_VIRTUAL * &itimerval'struct)
+				+ &itimerval'it_value
+				+ &timeval'tv_usec
+			      ];
+
+    sizeof   	Returns the bytes in the structure, or the member if
+	     	you pass it an argument, such as
+
+			&rusage'sizeof(&rusage'ru_utime)
+
+    typedef  	This is the perl format definition for passing to pack and
+	     	unpack.  If you ask for the typedef of a nothing, you get
+	     	the whole structure, otherwise you get that of the member
+	     	you ask for.  Padding is taken care of, as is the magic to
+	     	guarantee that a union is unpacked into all its aliases.
+	     	Bitfields are not quite yet supported however.
+
+    offsetof	This function is the byte offset into the array of that
+		member.  You may wish to use this for indexing directly
+		into the packed structure with vec() if you're too lazy
+		to unpack it.
+
+    typeof	Not to be confused with the typedef accessor function, this
+		one returns the C type of that field.  This would allow
+		you to print out a nice structured pretty print of some
+		structure without knoning anything about it beforehand.
+		No args to this one is a noop.  Someday I'll post such
+		a thing to dump out your u structure for you.
+
+
+The way I see this being used is like basically this:
+
+	% h2ph <some_include_file.h  >  /usr/lib/perl/tmp.ph
+	% c2ph  some_include_file.h  >> /usr/lib/perl/tmp.ph
+	% install
+
+It's a little tricker with c2ph because you have to get the includes right.
+I can't know this for your system, but it's not usually too terribly difficult.
+
+The code isn't pretty as I mentioned  -- I never thought it would be a 1000-
+line program when I started, or I might not have begun. :-)  But I would have
+been less cavalier in how the parts of the program communicated with each
+other, etc.  It might also have helped if I didn't have to divine the makeup
+of the stabs on the fly, and then account for micro differences between my
+compiler and gcc.
+
+Anyway, here it is.  Should run on perl v4 or greater.  Maybe less.
+
+
+--tom
+
+=cut
+
+$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
+
+
+######################################################################
+
+# some handy data definitions.   many of these can be reset later.
+
+$bitorder = 'b';  # ascending; set to B for descending bit fields
+
+%intrinsics =
+%template = (
+    'char', 			'c',
+    'unsigned char', 		'C',
+    'short',			's',
+    'short int',		's',
+    'unsigned short',		'S',
+    'unsigned short int',	'S',
+    'short unsigned int',	'S',
+    'int',			'i',
+    'unsigned int',		'I',
+    'long',			'l',
+    'long int',			'l',
+    'unsigned long',		'L',
+    'unsigned long',		'L',
+    'long unsigned int',	'L',
+    'unsigned long int',	'L',
+    'long long',		'q',
+    'long long int',		'q',
+    'unsigned long long',	'Q',
+    'unsigned long long int',	'Q',
+    'float',			'f',
+    'double',			'd',
+    'pointer',			'p',
+    'null',			'x',
+    'neganull',			'X',
+    'bit',			$bitorder,
+);
+
+&buildscrunchlist;
+delete $intrinsics{'neganull'};
+delete $intrinsics{'bit'};
+delete $intrinsics{'null'};
+
+# use -s to recompute sizes
+%sizeof = (
+    'char', 			'1',
+    'unsigned char', 		'1',
+    'short',			'2',
+    'short int',		'2',
+    'unsigned short',		'2',
+    'unsigned short int',	'2',
+    'short unsigned int',	'2',
+    'int',			'4',
+    'unsigned int',		'4',
+    'long',			'4',
+    'long int',			'4',
+    'unsigned long',		'4',
+    'unsigned long int',	'4',
+    'long unsigned int',	'4',
+    'long long',		'8',
+    'long long int',		'8',
+    'unsigned long long',	'8',
+    'unsigned long long int',	'8',
+    'float',			'4',
+    'double',			'8',
+    'pointer',			'4',
+);
+
+($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
+
+($offset_fmt, $size_fmt) = ('d', 'd');
+
+$indent = 2;
+
+$CC = 'cc';
+$CFLAGS = '-g -S';
+$DEFINES = '';
+
+$perl++ if $0 =~ m#/?c2ph$#;
+
+require 'getopts.pl';
+
+eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
+
+&Getopts('aixdpvtnws:') || &usage(0);
+
+$opt_d && $debug++;
+$opt_t && $trace++;
+$opt_p && $perl++;
+$opt_v && $verbose++;
+$opt_n && ($perl = 0);
+
+if ($opt_w) {
+    ($type_width, $member_width, $offset_width) = (45, 35, 8);
+}
+if ($opt_x) {
+    ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
+}
+
+eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
+
+sub PLUMBER {
+    select(STDERR);
+    print "oops, apperent pager foulup\n";
+    $isatty++;
+    &usage(1);
+}
+
+sub usage {
+    local($oops) = @_;
+    unless (-t STDOUT) {
+	select(STDERR);
+    } elsif (!$oops) {
+	$isatty++;
+	$| = 1;
+	print "hit <RETURN> for further explanation: ";
+	<STDIN>;
+	open (PIPE, "|". ($ENV{PAGER} || 'more'));
+	$SIG{PIPE} = PLUMBER;
+	select(PIPE);
+    }
+
+    print "usage: $0 [-dpnP] [var=val] [files ...]\n";
+
+    exit unless $isatty;
+
+    print <<EOF;
+
+Options:
+
+-w	wide; short for: type_width=45 member_width=35 offset_width=8
+-x	hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
+
+-n  	do not generate perl code  (default when invoked as pstruct)
+-p  	generate perl code         (default when invoked as c2ph)
+-v	generate perl code, with C decls as comments
+
+-i	do NOT recompute sizes for intrinsic datatypes
+-a	dump information on intrinsics also
+
+-t 	trace execution
+-d	spew reams of debugging output
+
+-slist  give comma-separated list a structures to dump
+
+
+Var Name        Default Value    Meaning
+
+EOF
+
+    &defvar('CC', 'which_compiler to call');
+    &defvar('CFLAGS', 'how to generate *.s files with stabs');
+    &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
+
+    print "\n";
+
+    &defvar('type_width', 'width of type field   (column 1)');
+    &defvar('member_width', 'width of member field (column 2)');
+    &defvar('offset_width', 'width of offset field (column 3)');
+    &defvar('size_width', 'width of size field   (column 4)');
+
+    print "\n";
+
+    &defvar('offset_fmt', 'sprintf format type for offset');
+    &defvar('size_fmt', 'sprintf format type for size');
+
+    print "\n";
+
+    &defvar('indent', 'how far to indent each nesting level');
+
+   print <<'EOF';
+
+    If any *.[ch] files are given, these will be catted together into
+    a temporary *.c file and sent through:
+	    $CC $CFLAGS $DEFINES
+    and the resulting *.s groped for stab information.  If no files are
+    supplied, then stdin is read directly with the assumption that it
+    contains stab information.  All other liens will be ignored.  At
+    most one *.s file should be supplied.
+
+EOF
+    close PIPE;
+    exit 1;
+}
+
+sub defvar {
+    local($var, $msg) = @_;
+    printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
+}
+
+$recurse = 1;
+
+if (@ARGV) {
+    if (grep(!/\.[csh]$/,@ARGV)) {
+	warn "Only *.[csh] files expected!\n";
+	&usage;
+    }
+    elsif (grep(/\.s$/,@ARGV)) {
+	if (@ARGV > 1) {
+	    warn "Only one *.s file allowed!\n";
+	    &usage;
+	}
+    }
+    elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
+	local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
+	$chdir = "cd $dir; " if $dir;
+	&system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
+	$ARGV[0] =~ s/\.c$/.s/;
+    }
+    else {
+	$TMP = "/tmp/c2ph.$$.c";
+	&system("cat @ARGV > $TMP") && exit 1;
+	&system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
+	unlink $TMP;
+	$TMP =~ s/\.c$/.s/;
+	@ARGV = ($TMP);
+    }
+}
+
+if ($opt_s) {
+    for (split(/[\s,]+/, $opt_s)) {
+	$interested{$_}++;
+    }
+}
+
+
+$| = 1 if $debug;
+
+main: {
+
+    if ($trace) {
+	if (-t && !@ARGV) {
+	    print STDERR "reading from your keyboard: ";
+	} else {
+	    print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
+	}
+    }
+
+STAB: while (<>) {
+	if ($trace && !($. % 10)) {
+	    $lineno = $..'';
+	    print STDERR $lineno, "\b" x length($lineno);
+	}
+	next unless /^\s*\.stabs\s+/;
+	$line = $_;
+	s/^\s*\.stabs\s+//;
+	if (s/\\\\"[d,]+$//) {
+	    $saveline .= $line;
+	    $savebar  = $_;
+	    next STAB;
+	}
+	if ($saveline) {
+	    s/^"//;
+	    $_ = $savebar . $_;
+	    $line = $saveline;
+	}
+	&stab;
+	$savebar = $saveline = undef;
+    }
+    print STDERR "$.\n" if $trace;
+    unlink $TMP if $TMP;
+
+    &compute_intrinsics if $perl && !$opt_i;
+
+    print STDERR "resolving types\n" if $trace;
+
+    &resolve_types;
+    &adjust_start_addrs;
+
+    $sum = 2 + $type_width + $member_width;
+    $pmask1 = "%-${type_width}s %-${member_width}s";
+    $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
+
+
+
+    if ($perl) {
+	# resolve template -- should be in stab define order, but even this isn't enough.
+	print STDERR "\nbuilding type templates: " if $trace;
+	for $i (reverse 0..$#type) {
+	    next unless defined($name = $type[$i]);
+	    next unless defined $struct{$name};
+	    ($iname = $name) =~ s/\..*//;
+	    $build_recursed = 0;
+	    &build_template($name) unless defined $template{&psou($name)} ||
+					$opt_s && !$interested{$iname};
+	}
+	print STDERR "\n\n" if $trace;
+    }
+
+    print STDERR "dumping structs: " if $trace;
+
+    local($iam);
+
+
+
+    foreach $name (sort keys %struct) {
+	($iname = $name) =~ s/\..*//;
+	next if $opt_s && !$interested{$iname};
+	print STDERR "$name " if $trace;
+
+	undef @sizeof;
+	undef @typedef;
+	undef @offsetof;
+	undef @indices;
+	undef @typeof;
+	undef @fieldnames;
+
+	$mname = &munge($name);
+
+	$fname = &psou($name);
+
+	print "# " if $perl && $verbose;
+	$pcode = '';
+	print "$fname {\n" if !$perl || $verbose;
+	$template{$fname} = &scrunch($template{$fname}) if $perl;
+	&pstruct($name,$name,0);
+	print "# " if $perl && $verbose;
+	print "}\n" if !$perl || $verbose;
+	print "\n" if $perl && $verbose;
+
+	if ($perl) {
+	    print "$pcode";
+
+	    printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
+
+	    print <<EOF;
+sub ${mname}'typedef {
+    local(\$${mname}'index) = shift;
+    defined \$${mname}'index
+	? \$${mname}'typedef[\$${mname}'index]
+	: \$${mname}'typedef;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'sizeof {
+    local(\$${mname}'index) = shift;
+    defined \$${mname}'index
+	? \$${mname}'sizeof[\$${mname}'index]
+	: \$${mname}'sizeof;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'offsetof {
+    local(\$${mname}'index) = shift;
+    defined \$${mname}index
+	? \$${mname}'offsetof[\$${mname}'index]
+	: \$${mname}'sizeof;
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'typeof {
+    local(\$${mname}'index) = shift;
+    defined \$${mname}index
+	? \$${mname}'typeof[\$${mname}'index]
+	: '$name';
+}
+EOF
+
+	    print <<EOF;
+sub ${mname}'fieldnames {
+    \@${mname}'fieldnames;
+}
+EOF
+
+	$iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u');
+
+	    print <<EOF;
+sub ${mname}'isastruct {
+    '$iam';
+}
+EOF
+
+	    print "\$${mname}'typedef = '" . &scrunch($template{$fname})
+		. "';\n";
+
+	    print "\$${mname}'sizeof = $sizeof{$name};\n\n";
+
+
+	    print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
+
+	    print "\n";
+
+	    print "\@${mname}'typedef[\@${mname}'indices] = (",
+			join("\n\t", '', @typedef), "\n    );\n\n";
+	    print "\@${mname}'sizeof[\@${mname}'indices] = (",
+			join("\n\t", '', @sizeof), "\n    );\n\n";
+	    print "\@${mname}'offsetof[\@${mname}'indices] = (",
+			join("\n\t", '', @offsetof), "\n    );\n\n";
+	    print "\@${mname}'typeof[\@${mname}'indices] = (",
+			join("\n\t", '', @typeof), "\n    );\n\n";
+	    print "\@${mname}'fieldnames[\@${mname}'indices] = (",
+			join("\n\t", '', @fieldnames), "\n    );\n\n";
+
+	    $template_printed{$fname}++;
+	    $size_printed{$fname}++;
+	}
+	print "\n";
+    }
+
+    print STDERR "\n" if $trace;
+
+    unless ($perl && $opt_a) {
+	print "\n1;\n" if $perl;
+	exit;
+    }
+
+
+
+    foreach $name (sort bysizevalue keys %intrinsics) {
+	next if $size_printed{$name};
+	print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
+    }
+
+    print "\n";
+
+    sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
+
+
+    foreach $name (sort keys %intrinsics) {
+	print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
+    }
+
+    print "\n1;\n" if $perl;
+
+    exit;
+}
+
+########################################################################################
+
+
+sub stab {
+    next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
+    s/"// 						|| next;
+    s/",([x\d]+),([x\d]+),([x\d]+),.*// 		|| next;
+
+    next if /^\s*$/;
+
+    $size = $3 if $3;
+    $_ = $continued . $_ if length($continued);
+    if (s/\\\\$//) {
+      # if last 2 chars of string are '\\' then stab is continued
+      # in next stab entry
+      chop;
+      $continued = $_;
+      next;
+    }
+    $continued = '';
+
+
+    $line = $_;
+
+    if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
+	print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
+	&pdecl($pdecl);
+	next;
+    }
+
+
+
+    if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {
+	local($ident) = $2;
+	push(@intrinsics, $ident);
+	$typeno = &typeno($3);
+	$type[$typeno] = $ident;
+	print STDERR "intrinsic $ident in new type $typeno\n" if $debug;
+	next;
+    }
+
+    if (($name, $typeordef, $typeno, $extra, $struct, $_)
+	= /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/)
+    {
+	$typeno = &typeno($typeno);  # sun foolery
+    }
+    elsif (/^[\$\w]+:/) {
+	next; # variable
+    }
+    else {
+	warn "can't grok stab: <$_> in: $line " if $_;
+	next;
+    }
+
+    #warn "got size $size for $name\n";
+    $sizeof{$name} = $size if $size;
+
+    s/;[-\d]*;[-\d]*;$//;  # we don't care about ranges
+
+    $typenos{$name} = $typeno;
+
+    unless (defined $type[$typeno]) {
+	&panic("type 0??") unless $typeno;
+	$type[$typeno] = $name unless defined $type[$typeno];
+	printf "new type $typeno is $name" if $debug;
+	if ($extra =~ /\*/ && defined $type[$struct]) {
+	    print ", a typedef for a pointer to " , $type[$struct] if $debug;
+	}
+    } else {
+	printf "%s is type %d", $name, $typeno if $debug;
+	print ", a typedef for " , $type[$typeno] if $debug;
+    }
+    print "\n" if $debug;
+    #next unless $extra =~ /[su*]/;
+
+    #$type[$struct] = $name;
+
+    if ($extra =~ /[us*]/) {
+	&sou($name, $extra);
+	$_ = &sdecl($name, $_, 0);
+    }
+    elsif (/^=ar/) {
+	print "it's a bare array typedef -- that's pretty sick\n" if $debug;
+	$_ = "$typeno$_";
+	$scripts = '';
+	$_ = &adecl($_,1);
+
+    }
+    elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
+	push(@intrinsics, $2);
+	$typeno = &typeno($3);
+	$type[$typeno] = $2;
+	print STDERR "intrinsic $2 in new type $typeno\n" if $debug;
+    }
+    elsif (s/^=e//) { # blessed be thy compiler; mine won't do this
+	&edecl;
+    }
+    else {
+	warn "Funny remainder for $name on line $_ left in $line " if $_;
+    }
+}
+
+sub typeno {  # sun thinks types are (0,27) instead of just 27
+    local($_) = @_;
+    s/\(\d+,(\d+)\)/$1/;
+    $_;
+}
+
+sub pstruct {
+    local($what,$prefix,$base) = @_;
+    local($field, $fieldname, $typeno, $count, $offset, $entry);
+    local($fieldtype);
+    local($type, $tname);
+    local($mytype, $mycount, $entry2);
+    local($struct_count) = 0;
+    local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
+    local($bits,$bytes);
+    local($template);
+
+
+    local($mname) = &munge($name);
+
+    sub munge {
+	local($_) = @_;
+	s/[\s\$\.]/_/g;
+	$_;
+    }
+
+    local($sname) = &psou($what);
+
+    $nesting++;
+
+    for $field (split(/;/, $struct{$what})) {
+	$pad = $prepad = 0;
+	$entry = '';
+	($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field);
+
+	$type = $type[$typeno];
+
+	$type =~ /([^[]*)(\[.*\])?/;
+	$mytype = $1;
+	$count .= $2;
+	$fieldtype = &psou($mytype);
+
+	local($fname) = &psou($name);
+
+	if ($build_templates) {
+
+	    $pad = ($offset - ($lastoffset + $lastlength))/8
+		if defined $lastoffset;
+
+	    if (! $finished_template{$sname}) {
+		if ($isaunion{$what}) {
+		    $template{$sname} .= 'X' x $revpad . ' '    if $revpad;
+		} else {
+		    $template{$sname} .= 'x' x $pad    . ' '    if $pad;
+		}
+	    }
+
+	    $template = &fetch_template($type);
+	    &repeat_template($template,$count);
+
+	    if (! $finished_template{$sname}) {
+		$template{$sname} .= $template;
+	    }
+
+	    $revpad = $length/8 if $isaunion{$what};
+
+	    ($lastoffset, $lastlength) = ($offset, $length);
+
+	} else {
+	    print '# ' if $perl && $verbose;
+	    $entry = sprintf($pmask1,
+			' ' x ($nesting * $indent) . $fieldtype,
+			"$prefix.$fieldname" . $count);
+
+	    $entry =~ s/(\*+)( )/$2$1/;
+
+	    printf $pmask2,
+		    $entry,
+		    ($base+$offset)/8,
+		    ($bits = ($base+$offset)%8) ? ".$bits" : "  ",
+		    $length/8,
+		    ($bits = $length % 8) ? ".$bits": ""
+			if !$perl || $verbose;
+
+	    if ($perl) {
+		$template = &fetch_template($type);
+		&repeat_template($template,$count);
+	    }
+
+	    if ($perl && $nesting == 1) {
+
+		push(@sizeof, int($length/8) .",\t# $fieldname");
+		push(@offsetof, int($offset/8) .",\t# $fieldname");
+		local($little) = &scrunch($template);
+		push(@typedef, "'$little', \t# $fieldname");
+		$type =~ s/(struct|union) //;
+		push(@typeof, "'$mytype" . ($count ? $count : '') .
+		    "',\t# $fieldname");
+		push(@fieldnames, "'$fieldname',");
+	    }
+
+	    print '  ', ' ' x $indent x $nesting, $template
+				if $perl && $verbose;
+
+	    print "\n" if !$perl || $verbose;
+
+	}
+	if ($perl) {
+	    local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
+	    $mycount *= &scripts2count($count) if $count;
+	    if ($nesting==1 && !$build_templates) {
+		$pcode .= sprintf("sub %-32s { %4d; }\n",
+			"${mname}'${fieldname}", $struct_count);
+		push(@indices, $struct_count);
+	    }
+	    $struct_count += $mycount;
+	}
+
+
+	&pstruct($type, "$prefix.$fieldname", $base+$offset)
+		if $recurse && defined $struct{$type};
+    }
+
+    $countof{$what} = $struct_count unless defined $countof{$whati};
+
+    $template{$sname} .= '$' if $build_templates;
+    $finished_template{$sname}++;
+
+    if ($build_templates && !defined $sizeof{$name}) {
+	local($fmt) = &scrunch($template{$sname});
+	print STDERR "no size for $name, punting with $fmt..." if $debug;
+	eval '$sizeof{$name} = length(pack($fmt, ()))';
+	if ($@) {
+	    chop $@;
+	    warn "couldn't get size for \$name: $@";
+	} else {
+	    print STDERR $sizeof{$name}, "\n" if $debUg;
+	}
+    }
+
+    --$nesting;
+}
+
+
+sub psize {
+    local($me) = @_;
+    local($amstruct) = $struct{$me} ?  'struct ' : '';
+
+    print '$sizeof{\'', $amstruct, $me, '\'} = ';
+    printf "%d;\n", $sizeof{$me};
+}
+
+sub pdecl {
+    local($pdecl) = @_;
+    local(@pdecls);
+    local($tname);
+
+    warn "pdecl: $pdecl\n" if $debug;
+
+    $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
+    $pdecl =~ s/\*//g;
+    @pdecls = split(/=/, $pdecl);
+    $typeno = $pdecls[0];
+    $tname = pop @pdecls;
+
+    if ($tname =~ s/^f//) { $tname = "$tname&"; }
+    #else { $tname = "$tname*"; }
+
+    for (reverse @pdecls) {
+	$tname  .= s/^f// ? "&" : "*";
+	#$tname =~ s/^f(.*)/$1&/;
+	print "type[$_] is $tname\n" if $debug;
+	$type[$_] = $tname unless defined $type[$_];
+    }
+}
+
+
+
+sub adecl {
+    ($arraytype, $unknown, $lower, $upper) = ();
+    #local($typeno);
+    # global $typeno, @type
+    local($_, $typedef) = @_;
+
+    while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) {
+	($arraytype, $unknown) = ($2, $3);
+	$arraytype = &typeno($arraytype);
+	$unknown = &typeno($unknown);
+	if (s/^(\d+);(\d+);//) {
+	    ($lower, $upper) = ($1, $2);
+	    $scripts .= '[' .  ($upper+1) . ']';
+	} else {
+	    warn "can't find array bounds: $_";
+	}
+    }
+    if (s/^([(,)\d*f=]*),(\d+),(\d+);//) {
+	($start, $length) = ($2, $3);
+	$whatis = $1;
+	if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) {
+	    $typeno = &typeno($1);
+	    &pdecl($whatis);
+	} else {
+	    $typeno = &typeno($whatis);
+	}
+    } elsif (s/^(\d+)(=[*suf]\d*)//) {
+	local($whatis) = $2;
+
+	if ($whatis =~ /[f*]/) {
+	    &pdecl($whatis);
+	} elsif ($whatis =~ /[su]/) {  #
+	    print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n"
+		if $debug;
+	    #$type[$typeno] = $name unless defined $type[$typeno];
+	    ##printf "new type $typeno is $name" if $debug;
+	    $typeno = $1;
+	    $type[$typeno] = "$prefix.$fieldname";
+	    local($name) = $type[$typeno];
+	    &sou($name, $whatis);
+	    $_ = &sdecl($name, $_, $start+$offset);
+	    1;
+	    $start = $start{$name};
+	    $offset = $sizeof{$name};
+	    $length = $offset;
+	} else {
+	    warn "what's this? $whatis in $line ";
+	}
+    } elsif (/^\d+$/) {
+	$typeno = $_;
+    } else {
+	warn "bad array stab: $_ in $line ";
+	next STAB;
+    }
+    #local($wasdef) = defined($type[$typeno]) && $debug;
+    #if ($typedef) {
+	#print "redefining $type[$typeno] to " if $wasdef;
+	#$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
+	#print "$type[$typeno]\n" if $wasdef;
+    #} else {
+	#$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
+    #}
+    $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
+    print "type[$arraytype] is $type[$arraytype]\n" if $debug;
+    print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
+    $_;
+}
+
+
+
+sub sdecl {
+    local($prefix, $_, $offset) = @_;
+
+    local($fieldname, $scripts, $type, $arraytype, $unknown,
+    $whatis, $pdecl, $upper,$lower, $start,$length) = ();
+    local($typeno,$sou);
+
+
+SFIELD:
+    while (/^([^;]+);/) {
+	$scripts = '';
+	warn "sdecl $_\n" if $debug;
+	if (s/^([\$\w]+)://) {
+	    $fieldname = $1;
+	} elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { #
+	    $typeno = &typeno($1);
+	    $type[$typeno] = "$prefix.$fieldname";
+	    local($name) = "$prefix.$fieldname";
+	    &sou($name,$2);
+	    $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
+	    $start = $start{$name};
+	    $offset += $sizeof{$name};
+	    #print "done with anon, start is $start, offset is $offset\n";
+	    #next SFIELD;
+	} else  {
+	    warn "weird field $_ of $line" if $debug;
+	    next STAB;
+	    #$fieldname = &gensym;
+	    #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
+	}
+
+	if (/^(\d+|\(\d+,\d+\))=ar/) {
+	    $_ = &adecl($_);
+	}
+	elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
+          ($start, $length) =  ($2, $3);
+          &panic("no length?") unless $length;
+          $typeno = &typeno($1) if $1;
+        }
+        elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) {
+	    ($start, $length) =  ($2, $3);
+	    &panic("no length?") unless $length;
+	    $typeno = &typeno($1) if $1;
+	}
+	elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
+	    ($pdecl, $start, $length) =  ($1,$5,$6);
+	    &pdecl($pdecl);
+	}
+	elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
+	    ($typeno, $sou) = ($1, $2);
+	    $typeno = &typeno($typeno);
+	    if (defined($type[$typeno])) {
+		warn "now how did we get type $1 in $fieldname of $line?";
+	    } else {
+		print "anon type $typeno is $prefix.$fieldname\n" if $debug;
+		$type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
+	    };
+	    local($name) = "$prefix.$fieldname";
+	    &sou($name,$sou);
+	    print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
+	    $type[$typeno] = "$prefix.$fieldname";
+	    $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
+	    $start = $start{$name};
+	    $length = $sizeof{$name};
+	}
+	else {
+	    warn "can't grok stab for $name ($_) in line $line ";
+	    next STAB;
+	}
+
+	&panic("no length for $prefix.$fieldname") unless $length;
+	$struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
+    }
+    if (s/;\d*,(\d+),(\d+);//) {
+	local($start, $size) = ($1, $2);
+	$sizeof{$prefix} = $size;
+	print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug;
+	$start{$prefix} = $start;
+    }
+    $_;
+}
+
+sub edecl {
+    s/;$//;
+    $enum{$name} = $_;
+    $_ = '';
+}
+
+sub resolve_types {
+    local($sou);
+    for $i (0 .. $#type) {
+	next unless defined $type[$i];
+	$_ = $type[$i];
+	unless (/\d/) {
+	    print "type[$i] $type[$i]\n" if $debug;
+	    next;
+	}
+	print "type[$i] $_ ==> " if $debug;
+	s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
+	s/^(\d+)\&/&type($1)/e;
+	s/^(\d+)/&type($1)/e;
+	s/(\*+)([^*]+)(\*+)/$1$3$2/;
+	s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
+	s/^(\d+)([\*\[].*)/&type($1).$2/e;
+	#s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
+	$type[$i] = $_;
+	print "$_\n" if $debug;
+    }
+}
+sub type { &psou($type[$_[0]] || "<UNDEFINED>"); }
+
+sub adjust_start_addrs {
+    for (sort keys %start) {
+	($basename = $_) =~ s/\.[^.]+$//;
+	$start{$_} += $start{$basename};
+	print "start: $_ @ $start{$_}\n" if $debug;
+    }
+}
+
+sub sou {
+    local($what, $_) = @_;
+    /u/ && $isaunion{$what}++;
+    /s/ && $isastruct{$what}++;
+}
+
+sub psou {
+    local($what) = @_;
+    local($prefix) = '';
+    if ($isaunion{$what})  {
+	$prefix = 'union ';
+    } elsif ($isastruct{$what})  {
+	$prefix = 'struct ';
+    }
+    $prefix . $what;
+}
+
+sub scrunch {
+    local($_) = @_;
+
+    return '' if $_ eq '';
+
+    study;
+
+    s/\$//g;
+    s/  / /g;
+    1 while s/(\w) \1/$1$1/g;
+
+    # i wanna say this, but perl resists my efforts:
+    #	   s/(\w)(\1+)/$2 . length($1)/ge;
+
+    &quick_scrunch;
+
+    s/ $//;
+
+    $_;
+}
+
+sub buildscrunchlist {
+    $scrunch_code = "sub quick_scrunch {\n";
+    for (values %intrinsics) {
+        $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n";
+    }
+    $scrunch_code .= "}\n";
+    print "$scrunch_code" if $debug;
+    eval $scrunch_code;
+    &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
+}
+
+sub fetch_template {
+    local($mytype) = @_;
+    local($fmt);
+    local($count) = 1;
+
+    &panic("why do you care?") unless $perl;
+
+    if ($mytype =~ s/(\[\d+\])+$//) {
+	$count .= $1;
+    }
+
+    if ($mytype =~ /\*/) {
+	$fmt = $template{'pointer'};
+    }
+    elsif (defined $template{$mytype}) {
+	$fmt = $template{$mytype};
+    }
+    elsif (defined $struct{$mytype}) {
+	if (!defined $template{&psou($mytype)}) {
+	    &build_template($mytype) unless $mytype eq $name;
+	}
+	elsif ($template{&psou($mytype)} !~ /\$$/) {
+	    #warn "incomplete template for $mytype\n";
+	}
+	$fmt = $template{&psou($mytype)} || '?';
+    }
+    else {
+	warn "unknown fmt for $mytype\n";
+	$fmt = '?';
+    }
+
+    $fmt x $count . ' ';
+}
+
+sub compute_intrinsics {
+    local($TMP) = "/tmp/c2ph-i.$$.c";
+    open (TMP, ">$TMP") || die "can't open $TMP: $!";
+    select(TMP);
+
+    print STDERR "computing intrinsic sizes: " if $trace;
+
+    undef %intrinsics;
+
+    print <<'EOF';
+main() {
+    char *mask = "%d %s\n";
+EOF
+
+    for $type (@intrinsics) {
+	next if !type || $type eq 'void' || $type =~ /complex/; # sun stuff
+	print <<"EOF";
+    printf(mask,sizeof($type), "$type");
+EOF
+    }
+
+    print <<'EOF';
+    printf(mask,sizeof(char *), "pointer");
+    exit(0);
+}
+EOF
+    close TMP;
+
+    select(STDOUT);
+    open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
+    while (<PIPE>) {
+	chop;
+	split(' ',$_,2);;
+	print "intrinsic $_[1] is size $_[0]\n" if $debug;
+	$sizeof{$_[1]} = $_[0];
+	$intrinsics{$_[1]} = $template{$_[0]};
+    }
+    close(PIPE) || die "couldn't read intrinsics!";
+    unlink($TMP, '/tmp/a.out');
+    print STDERR "done\n" if $trace;
+}
+
+sub scripts2count {
+    local($_) = @_;
+
+    s/^\[//;
+    s/\]$//;
+    s/\]\[/*/g;
+    $_ = eval;
+    &panic("$_: $@") if $@;
+    $_;
+}
+
+sub system {
+    print STDERR "@_\n" if $trace;
+    system @_;
+}
+
+sub build_template {
+    local($name) = @_;
+
+    &panic("already got a template for $name") if defined $template{$name};
+
+    local($build_templates) = 1;
+
+    local($lparen) = '(' x $build_recursed;
+    local($rparen) = ')' x $build_recursed;
+
+    print STDERR "$lparen$name$rparen " if $trace;
+    $build_recursed++;
+    &pstruct($name,$name,0);
+    print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
+    --$build_recursed;
+}
+
+
+sub panic {
+
+    select(STDERR);
+
+    print "\npanic: @_\n";
+
+    exit 1 if $] <= 4.003;  # caller broken
+
+    local($i,$_);
+    local($p,$f,$l,$s,$h,$a,@a,@sub);
+    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+	@a = @DB'args;
+	for (@a) {
+	    if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+		$_ = sprintf("%s",$_);
+	    }
+	    else {
+		s/'/\\'/g;
+		s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+		s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+		s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+	    }
+	}
+	$w = $w ? '@ = ' : '$ = ';
+	$a = $h ? '(' . join(', ', @a) . ')' : '';
+	push(@sub, "$w&$s$a from file $f line $l\n");
+	last if $signal;
+    }
+    for ($i=0; $i <= $#sub; $i++) {
+	last if $signal;
+	print $sub[$i];
+    }
+    exit 1;
+}
+
+sub squishseq {
+    local($num);
+    local($last) = -1e8;
+    local($string);
+    local($seq) = '..';
+
+    while (defined($num = shift)) {
+        if ($num == ($last + 1)) {
+            $string .= $seq unless $inseq++;
+            $last = $num;
+            next;
+        } elsif ($inseq) {
+            $string .= $last unless $last == -1e8;
+        }
+
+        $string .= ',' if defined $string;
+        $string .= $num;
+        $last = $num;
+        $inseq = 0;
+    }
+    $string .= $last if $inseq && $last != -e18;
+    $string;
+}
+
+sub repeat_template {
+    #  local($template, $scripts) = @_;  have to change caller's values
+
+    if ( $_[1] ) {
+	local($ncount) = &scripts2count($_[1]);
+	if ($_[0] =~ /^\s*c\s*$/i) {
+	    $_[0] = "A$ncount ";
+	    $_[1] = '';
+	} else {
+	    $_[0] = $template x $ncount;
+	}
+    }
+}
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+unlink 'pstruct';
+print "Linking c2ph to pstruct.\n";
+if (defined $Config{d_link}) {
+  link 'c2ph', 'pstruct';
+} else {
+  unshift @INC, '../lib';
+  require File::Copy;
+  File::Copy::syscopy('c2ph', 'pstruct');
+}
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/utils/h2ph.PL b/gnu/usr.bin/perl/utils/h2ph.PL
new file mode 100644
index 00000000000..370aa872134
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/h2ph.PL
@@ -0,0 +1,309 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+# Wanted:  $archlibexp
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+
+'di ';
+'ds 00 \"';
+'ig 00 ';
+
+\$perlincl = "$Config{archlibexp}";
+
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+chdir '/usr/include' || die "Can't cd /usr/include";
+
+@isatype = split(' ',<<END);
+	char	uchar	u_char
+	short	ushort	u_short
+	int	uint	u_int
+	long	ulong	u_long
+	FILE
+END
+
+@isatype{@isatype} = (1) x @isatype;
+$inif = 0;
+
+@ARGV = ('-') unless @ARGV;
+
+foreach $file (@ARGV) {
+    if ($file eq '-') {
+	open(IN, "-");
+	open(OUT, ">-");
+    }
+    else {
+	($outfile = $file) =~ s/\.h$/.ph/ || next;
+	print "$file -> $outfile\n";
+	if ($file =~ m|^(.*)/|) {
+	    $dir = $1;
+	    if (!-d "$perlincl/$dir") {
+		mkdir("$perlincl/$dir",0777);
+	    }
+	}
+	open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
+	open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
+    }
+    while (<IN>) {
+	chop;
+	while (/\\$/) {
+	    chop;
+	    $_ .= <IN>;
+	    chop;
+	}
+	if (s:/\*:\200:g) {
+	    s:\*/:\201:g;
+	    s/\200[^\201]*\201//g;	# delete single line comments
+	    if (s/\200.*//) {		# begin multi-line comment?
+		$_ .= '/*';
+		$_ .= <IN>;
+		redo;
+	    }
+	}
+	if (s/^#\s*//) {
+	    if (s/^define\s+(\w+)//) {
+		$name = $1;
+		$new = '';
+		s/\s+$//;
+		if (s/^\(([\w,\s]*)\)//) {
+		    $args = $1;
+		    if ($args ne '') {
+			foreach $arg (split(/,\s*/,$args)) {
+			    $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
+			    $curargs{$arg} = 1;
+			}
+			$args =~ s/\b(\w)/\$$1/g;
+			$args = "local($args) = \@_;\n$t    ";
+		    }
+		    s/^\s+//;
+		    do expr();
+		    $new =~ s/(["\\])/\\$1/g;
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;
+			print OUT $t,
+			  "eval 'sub $name {\n$t    ${args}eval \"$new\";\n$t}';\n";
+		    }
+		    else {
+			print OUT "sub $name {\n    ${args}eval \"$new\";\n}\n";
+		    }
+		    %curargs = ();
+		}
+		else {
+		    s/^\s+//;
+		    do expr();
+		    $new = 1 if $new eq '';
+		    if ($t ne '') {
+			$new =~ s/(['\\])/\\$1/g;
+			print OUT $t,"eval 'sub $name {",$new,";}';\n";
+		    }
+		    else {
+			print OUT $t,"sub $name {",$new,";}\n";
+		    }
+		}
+	    }
+	    elsif (/^include\s*<(.*)>/) {
+		($incl = $1) =~ s/\.h$/.ph/;
+		print OUT $t,"require '$incl';\n";
+	    }
+	    elsif (/^ifdef\s+(\w+)/) {
+		print OUT $t,"if (defined &$1) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^ifndef\s+(\w+)/) {
+		print OUT $t,"if (!defined &$1) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^if\s+//) {
+		$new = '';
+		$inif = 1;
+		do expr();
+		$inif = 0;
+		print OUT $t,"if ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (s/^elif\s+//) {
+		$new = '';
+		$inif = 1;
+		do expr();
+		$inif = 0;
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n${t}elsif ($new) {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^else/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n${t}else {\n";
+		$tab += 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+	    }
+	    elsif (/^endif/) {
+		$tab -= 4;
+		$t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+		print OUT $t,"}\n";
+	    }
+	}
+    }
+    print OUT "1;\n";
+}
+
+sub expr {
+    while ($_ ne '') {
+	s/^(\s+)//		&& do {$new .= ' '; next;};
+	s/^(0x[0-9a-fA-F]+)//	&& do {$new .= $1; next;};
+	s/^(\d+)[LlUu]*//	&& do {$new .= $1; next;};
+	s/^("(\\"|[^"])*")//	&& do {$new .= $1; next;};
+	s/^'((\\"|[^"])*)'//	&& do {
+	    if ($curargs{$1}) {
+		$new .= "ord('\$$1')";
+	    }
+	    else {
+		$new .= "ord('$1')";
+	    }
+	    next;
+	};
+	s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
+	    $new .= '$sizeof';
+	    next;
+	};
+	s/^([_a-zA-Z]\w*)//	&& do {
+	    $id = $1;
+	    if ($id eq 'struct') {
+		s/^\s+(\w+)//;
+		$id .= ' ' . $1;
+		$isatype{$id} = 1;
+	    }
+	    elsif ($id eq 'unsigned') {
+		s/^\s+(\w+)//;
+		$id .= ' ' . $1;
+		$isatype{$id} = 1;
+	    }
+	    if ($curargs{$id}) {
+		$new .= '$' . $id;
+	    }
+	    elsif ($id eq 'defined') {
+		$new .= 'defined';
+	    }
+	    elsif (/^\(/) {
+		s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i;	# cheat
+		$new .= " &$id";
+	    }
+	    elsif ($isatype{$id}) {
+		if ($new =~ /{\s*$/) {
+		    $new .= "'$id'";
+		}
+		elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) {
+		    $new =~ s/\(\s*$//;
+		    s/^[\s*]*\)//;
+		}
+		else {
+		    $new .= q(').$id.q(');
+		}
+	    }
+	    else {
+		if ($inif && $new !~ /defined\s*\($/) {
+		    $new .= '(defined(&' . $id . ') ? &' . $id . ' : 0)';
+		} 
+		elsif (/^\[/) { 
+		    $new .= ' $' . $id;
+		}
+		else {
+		    $new .= ' &' . $id;
+		}
+	    }
+	    next;
+	};
+	s/^(.)// && do { if ($1 ne '#') { $new .= $1; } next;};
+    }
+}
+##############################################################################
+
+	# These next few lines are legal in both Perl and nroff.
+
+.00 ;			# finish .ig
+
+'di			\" finish diversion--previous line must be blank
+.nr nl 0-1		\" fake up transition to first page again
+.nr % 0			\" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH H2PH 1 "August 8, 1990"
+.AT 3
+.SH NAME
+h2ph \- convert .h C header files to .ph Perl header files
+.SH SYNOPSIS
+.B h2ph [headerfiles]
+.SH DESCRIPTION
+.I h2ph
+converts any C header files specified to the corresponding Perl header file
+format.
+It is most easily run while in /usr/include:
+.nf
+
+	cd /usr/include; h2ph * sys/*
+
+.fi
+If run with no arguments, filters standard input to standard output.
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+/usr/include/*.h
+.br
+/usr/include/sys/*.h
+.br
+etc.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+perl(1)
+.SH DIAGNOSTICS
+The usual warnings if it can't read or write the files involved.
+.SH BUGS
+Doesn't construct the %sizeof array for you.
+.PP
+It doesn't handle all C constructs, but it does attempt to isolate
+definitions inside evals so that you can get at the definitions
+that it can translate.
+.PP
+It's only intended as a rough tool.
+You may need to dicker with the files produced.
+.ex
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL
new file mode 100644
index 00000000000..f9868dc37f0
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/h2xs.PL
@@ -0,0 +1,618 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+=head1 NAME
+
+h2xs - convert .h C header files to Perl extensions
+
+=head1 SYNOPSIS
+
+B<h2xs> [B<-AOPXcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
+
+B<h2xs> B<-h>
+
+=head1 DESCRIPTION
+
+I<h2xs> builds a Perl extension from any C header file.  The extension will
+include functions which can be used to retrieve the value of any #define
+statement which was in the C header.
+
+The I<module_name> will be used for the name of the extension.  If
+module_name is not supplied then the name of the header file will be used,
+with the first character capitalized.
+
+If the extension might need extra libraries, they should be included
+here.  The extension Makefile.PL will take care of checking whether
+the libraries actually exist and how they should be loaded.
+The extra libraries should be specified in the form -lm -lposix, etc,
+just as on the cc command line.  By default, the Makefile.PL will
+search through the library path determined by Configure.  That path
+can be augmented by including arguments of the form B<-L/another/library/path>
+in the extra-libraries argument.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-A>
+
+Omit all autoload facilities.  This is the same as B<-c> but also removes the
+S<C<require AutoLoader>> statement from the .pm file.
+
+=item B<-O>
+
+Allows a pre-existing extension directory to be overwritten.
+
+=item B<-P>
+
+Omit the autogenerated stub POD section. 
+
+=item B<-c>
+
+Omit C<constant()> from the .xs file and corresponding specialised
+C<AUTOLOAD> from the .pm file.
+
+=item B<-f>
+
+Allows an extension to be created for a header even if that header is
+not found in /usr/include.
+
+=item B<-h>
+
+Print the usage, help and version for this h2xs and exit.
+
+=item B<-n> I<module_name>
+
+Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
+
+=item B<-v> I<version>
+
+Specify a version number for this extension.  This version number is added
+to the templates.  The default is 0.01.
+
+=item B<-X>
+
+Omit the XS portion.  Used to generate templates for a module which is not
+XS-based.
+
+=back
+
+=head1 EXAMPLES
+
+
+	# Default behavior, extension is Rusers
+	h2xs rpcsvc/rusers
+
+	# Same, but extension is RUSERS
+	h2xs -n RUSERS rpcsvc/rusers
+
+	# Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
+	h2xs rpcsvc::rusers
+
+	# Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
+	h2xs -n ONC::RPC rpcsvc/rusers
+
+	# Without constant() or AUTOLOAD
+	h2xs -c rpcsvc/rusers
+
+	# Creates templates for an extension named RPC
+	h2xs -cfn RPC
+
+	# Extension is ONC::RPC.
+	h2xs -cfn ONC::RPC
+
+	# Makefile.PL will look for library -lrpc in 
+	# additional directory /opt/net/lib
+	h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
+
+
+=head1 ENVIRONMENT
+
+No environment variables are used.
+
+=head1 AUTHOR
+
+Larry Wall and others
+
+=head1 SEE ALSO
+
+L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
+
+=head1 DIAGNOSTICS
+
+The usual warnings if it can't read or write the files involved.
+
+=cut
+
+my( $H2XS_VERSION ) = '$Revision: 1.16 $' =~ /\$Revision:\s+([^\s]+)/;
+my $TEMPLATE_VERSION = '0.01';
+
+use Getopt::Std;
+
+sub usage{
+	warn "@_\n" if @_;
+    die "h2xs [-AOPXcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
+version: $H2XS_VERSION
+    -f   Force creation of the extension even if the C header does not exist.
+    -n   Specify a name to use for the extension (recommended).
+    -c   Omit the constant() function and specialised AUTOLOAD from the XS file.
+    -A   Omit all autoloading facilities (implies -c).
+    -O   Allow overwriting of a pre-existing extension directory.
+    -P   Omit the stub POD section.
+    -X   Omit the XS portion.
+    -v   Specify a version number for this extension.
+    -h   Display this help message
+extra_libraries
+         are any libraries that might be needed for loading the
+         extension, e.g. -lm would try to link in the math library.
+";
+}
+
+
+getopts("AOPXcfhv:n:") || usage;
+
+usage if $opt_h;
+
+if( $opt_v ){
+	$TEMPLATE_VERSION = $opt_v;
+}
+$opt_c = 1 if $opt_A;
+
+$path_h    = shift;
+$extralibs = "@ARGV";
+
+usage "Must supply header file or module name\n"
+	unless ($path_h or $opt_n);
+
+
+if( $path_h ){
+    $name = $path_h;
+    if( $path_h =~ s#::#/#g && $opt_n ){
+	warn "Nesting of headerfile ignored with -n\n";
+    }
+    $path_h .= ".h" unless $path_h =~ /\.h$/;
+    $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
+    die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
+
+    # Scan the header file (we should deal with nested header files)
+    # Record the names of simple #define constants into const_names
+    # Function prototypes are not (currently) processed.
+    open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
+    while (<CH>) {
+	if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
+	    $_ = $1;
+	    next if /^_.*_h_*$/i; # special case, but for what?
+	    $const_names{$_}++;
+	}
+    }
+    close(CH);
+    @const_names = sort keys %const_names;
+}
+
+
+$module = $opt_n || do {
+	$name =~ s/\.h$//;
+	if( $name !~ /::/ ){
+		$name =~ s#^.*/##;
+		$name = "\u$name";
+	}
+	$name;
+};
+
+(chdir 'ext', $ext = 'ext/') if -d 'ext';
+
+if( $module =~ /::/ ){
+	$nested = 1;
+	@modparts = split(/::/,$module);
+	$modfname = $modparts[-1];
+	$modpname = join('/',@modparts);
+}
+else {
+	$nested = 0;
+	@modparts = ();
+	$modfname = $modpname = $module;
+}
+
+
+if ($opt_O) {
+	warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
+} else {
+	die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
+}
+if( $nested ){
+	$modpath = "";
+	foreach (@modparts){
+		mkdir("$modpath$_", 0777);
+		$modpath .= "$_/";
+	}
+}
+mkdir($modpname, 0777);
+chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
+
+if( ! $opt_X ){  # use XS, unless it was disabled
+  open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
+}
+open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
+
+$" = "\n\t";
+warn "Writing $ext$modpname/$modfname.pm\n";
+
+print PM <<"END";
+package $module;
+
+use strict;
+END
+
+if( $opt_X || $opt_c || $opt_A ){
+	# we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
+	print PM <<'END';
+use vars qw($VERSION @ISA @EXPORT);
+END
+}
+else{
+	# we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
+	# will want Carp.
+	print PM <<'END';
+use Carp;
+use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
+END
+}
+
+print PM <<'END';
+
+require Exporter;
+END
+
+print PM <<"END" if ! $opt_X;  # use DynaLoader, unless XS was disabled
+require DynaLoader;
+END
+
+# require autoloader if XS is disabled.
+# if XS is enabled, require autoloader unless autoloading is disabled.
+if( $opt_X || (! $opt_A) ){
+	print PM <<"END";
+require AutoLoader;
+END
+}
+
+if( $opt_X || ($opt_c && ! $opt_A) ){
+	# we won't have our own AUTOLOAD(), so we'll inherit it.
+	if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
+		print PM <<"END";
+
+\@ISA = qw(Exporter AutoLoader DynaLoader);
+END
+	}
+	else{
+		print PM <<"END";
+
+\@ISA = qw(Exporter AutoLoader);
+END
+	}
+}
+else{
+	# 1) we have our own AUTOLOAD(), so don't need to inherit it.
+	# or
+	# 2) we don't want autoloading mentioned.
+	if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
+		print PM <<"END";
+
+\@ISA = qw(Exporter DynaLoader);
+END
+	}
+	else{
+		print PM <<"END";
+
+\@ISA = qw(Exporter);
+END
+	}
+}
+
+print PM<<"END";
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+\@EXPORT = qw(
+	@const_names
+);
+\$VERSION = '$TEMPLATE_VERSION';
+
+END
+
+print PM <<"END" unless $opt_c or $opt_X;
+sub AUTOLOAD {
+    # This AUTOLOAD is used to 'autoload' constants from the constant()
+    # XS function.  If a constant is not found then control is passed
+    # to the AUTOLOAD in AutoLoader.
+
+    my \$constname;
+    (\$constname = \$AUTOLOAD) =~ s/.*:://;
+    my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
+    if (\$! != 0) {
+	if (\$! =~ /Invalid/) {
+	    \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
+	    goto &AutoLoader::AUTOLOAD;
+	}
+	else {
+		croak "Your vendor has not defined $module macro \$constname";
+	}
+    }
+    eval "sub \$AUTOLOAD { \$val }";
+    goto &\$AUTOLOAD;
+}
+
+END
+
+if( ! $opt_X ){ # print bootstrap, unless XS is disabled
+	print PM <<"END";
+bootstrap $module \$VERSION;
+END
+}
+
+if( $opt_P ){ # if POD is disabled
+	$after = '__END__';
+}
+else {
+	$after = '=cut';
+}
+
+print PM <<"END";
+
+# Preloaded methods go here.
+
+# Autoload methods go after $after, and are processed by the autosplit program.
+
+1;
+__END__
+END
+
+$author = "A. U. Thor";
+$email = 'a.u.thor@a.galaxy.far.far.away';
+
+$pod = <<"END" unless $opt_P;
+## Below is the stub of documentation for your module. You better edit it!
+#
+#=head1 NAME
+#
+#$module - Perl extension for blah blah blah
+#
+#=head1 SYNOPSIS
+#
+#  use $module;
+#  blah blah blah
+#
+#=head1 DESCRIPTION
+#
+#Stub documentation for $module was created by h2xs. It looks like the
+#author of the extension was negligent enough to leave the stub
+#unedited.
+#
+#Blah blah blah.
+#
+#=head1 AUTHOR
+#
+#$author, $email
+#
+#=head1 SEE ALSO
+#
+#perl(1).
+#
+#=cut
+END
+
+$pod =~ s/^\#//gm unless $opt_P;
+print PM $pod unless $opt_P;
+
+close PM;
+
+
+if( ! $opt_X ){ # print XS, unless it is disabled
+warn "Writing $ext$modpname/$modfname.xs\n";
+
+print XS <<"END";
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+END
+if( $path_h ){
+	my($h) = $path_h;
+	$h =~ s#^/usr/include/##;
+print XS <<"END";
+#include <$h>
+
+END
+}
+
+if( ! $opt_c ){
+print XS <<"END";
+static int
+not_here(s)
+char *s;
+{
+    croak("$module::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static double
+constant(name, arg)
+char *name;
+int arg;
+{
+    errno = 0;
+    switch (*name) {
+END
+
+my(@AZ, @az, @under);
+
+foreach(@const_names){
+    @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
+    @az = 'a' .. 'z' if !@az && /^[a-z]/;
+    @under = '_'  if !@under && /^_/;
+}
+
+foreach $letter (@AZ, @az, @under) {
+
+    last if $letter eq 'a' && !@const_names;
+
+    print XS "    case '$letter':\n";
+    my($name);
+    while (substr($const_names[0],0,1) eq $letter) {
+	$name = shift(@const_names);
+	print XS <<"END";
+	if (strEQ(name, "$name"))
+#ifdef $name
+	    return $name;
+#else
+	    goto not_there;
+#endif
+END
+    }
+    print XS <<"END";
+	break;
+END
+}
+print XS <<"END";
+    }
+    errno = EINVAL;
+    return 0;
+
+not_there:
+    errno = ENOENT;
+    return 0;
+}
+
+END
+}
+
+# Now switch from C to XS by issuing the first MODULE declaration:
+print XS <<"END";
+
+MODULE = $module		PACKAGE = $module
+
+END
+
+# If a constant() function was written then output a corresponding
+# XS declaration:
+print XS <<"END" unless $opt_c;
+
+double
+constant(name,arg)
+	char *		name
+	int		arg
+
+END
+
+close XS;
+} # if( ! $opt_X )
+
+warn "Writing $ext$modpname/Makefile.PL\n";
+open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
+
+print PL <<'END';
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+END
+print PL "WriteMakefile(\n";
+print PL "    'NAME'	=> '$module',\n";
+print PL "    'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n"; 
+if( ! $opt_X ){ # print C stuff, unless XS is disabled
+  print PL "    'LIBS'	=> ['$extralibs'],   # e.g., '-lm' \n";
+  print PL "    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' \n";
+  print PL "    'INC'	=> '',     # e.g., '-I/usr/include/other' \n";
+}
+print PL ");\n";
+close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
+
+warn "Writing $ext$modpname/test.pl\n";
+open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
+print EX <<'_END_';
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+_END_
+print EX <<_END_;
+use $module;
+_END_
+print EX <<'_END_';
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+_END_
+close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
+
+warn "Writing $ext$modpname/Changes\n";
+open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
+print EX "Revision history for Perl extension $module.\n\n";
+print EX "$TEMPLATE_VERSION  ",scalar localtime,"\n";
+print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
+close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
+
+warn "Writing $ext$modpname/MANIFEST\n";
+open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
+@files = <*>;
+if (!@files) {
+  eval {opendir(D,'.');};
+  unless ($@) { @files = readdir(D); closedir(D); }
+}
+if (!@files) { @files = map {chomp && $_} `ls`; }
+print MANI join("\n",@files);
+close MANI;
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/utils/perlbug.PL b/gnu/usr.bin/perl/utils/perlbug.PL
new file mode 100644
index 00000000000..7a74c9fffdb
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/perlbug.PL
@@ -0,0 +1,647 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+use Config;
+use Getopt::Std;
+
+BEGIN {
+	eval "use Mail::Send;";
+	$::HaveSend = ($@ eq "");
+	eval "use Mail::Util;";
+	$::HaveUtil = ($@ eq "");
+};
+
+
+use strict;
+
+sub paraprint;
+
+
+my($Version) = "1.13";
+
+# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
+# Changed in 1.07 to see more sendmail execs, and added pipe output.
+# Changed in 1.08 to use correct address for sendmail.
+# Changed in 1.09 to close the REP file before calling it up in the editor.
+#                 Also removed some old comments duplicated elsewhere.
+# Changed in 1.10 to run under VMS without Mail::Send; also fixed
+#                 temp filename generation.
+# Changed in 1.11 to clean up some text and removed Mail::Send deactivator.
+# Changed in 1.12 to check for editor errors, make save/send distinction
+#                 clearer and add $ENV{REPLYTO}.
+# Changed in 1.13 to hopefully make it more difficult to accidentally
+#                 send mail
+
+# TODO: Allow the user to re-name the file on mail failure, and
+#       make sure failure (transmission-wise) of Mail::Send is 
+#       accounted for.
+
+my( $file, $cc, $address, $perlbug, $testaddress, $filename,
+    $subject, $from, $verbose, $ed, 
+    $fh, $me, $Is_VMS, $msg, $body, $andcc );
+
+Init();
+
+if($::opt_h) { Help(); exit; }
+
+if(!-t STDIN) {
+	paraprint <<EOF;
+Please use perlbug interactively. If you want to 
+include a file, you can use the -f switch.
+EOF
+	die "\n";
+}
+
+if($::opt_d or !-t STDOUT) { Dump(*STDOUT); exit; }
+
+Query();
+Edit();
+NowWhat();
+Send();
+
+exit;
+
+sub Init {
+ 
+	# -------- Setup --------
+
+	$Is_VMS = $^O eq 'VMS';
+
+	getopts("dhva:s:b:f:r:e:SCc:t");
+	
+
+	# This comment is needed to notify metaconfig that we are
+	# using the $perladmin, $cf_by, and $cf_time definitions.
+
+
+	# -------- Configuration ---------
+	
+	# perlbug address
+	$perlbug = 'perlbug@perl.com';
+	
+	# Test address
+	$testaddress = 'perlbug-test@perl.com';
+	
+	# Target address
+	$address = $::opt_a || ($::opt_t ? $testaddress : $perlbug);
+
+	# Possible administrator addresses, in order of confidence
+	# (Note that cf_email is not mentioned to metaconfig, since
+	# we don't really want it. We'll just take it if we have to.)
+	$cc = ($::opt_C ? "" : (
+		$::opt_c || $::Config{perladmin} || $::Config{cf_email} || $::Config{cf_by}
+		));
+	
+	# Users address, used in message and in Reply-To header
+	$from = $::opt_r || "";
+
+	# Include verbose configuration information
+	$verbose = $::opt_v || 0;
+
+	# Subject of bug-report message
+	$subject = $::opt_s || "";
+
+	# File to send as report
+	$file = $::opt_f || "";
+
+	# Body of report
+	$body = $::opt_b || "";
+
+	# Editor
+	$ed = ($::opt_f ? "file" : (
+			$::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || 
+		      ($Is_VMS ? "edit/tpu" : "vi")
+	      ));
+      
+	# My username
+	$me = getpwuid($<);
+
+}
+
+
+sub Query {
+
+	# Explain what perlbug is
+	
+	paraprint <<EOF;
+This program allows you to create a bug report,
+which will be sent as an e-mail message to $address
+once you have filled in the report.
+
+EOF
+
+
+	# Prompt for subject of message, if needed
+	if(! $subject) {
+		paraprint <<EOF;
+First of all, please provide a subject for the 
+message. It should be as a concise description of 
+the bug as is possible.
+
+EOF
+		print "Subject: ";
+	
+		$subject = <>;
+		chop $subject;
+	
+		my($err)=0;
+		while( $subject =~ /^\s*$/ ) {
+			print "\nPlease enter a subject: ";
+			$subject = <>;
+			chop $subject;
+			if($err++>5) {
+				die "Aborting.\n";
+			}
+		}
+	}
+	
+
+	# Prompt for return address, if needed
+	if( !$from) {
+
+		# Try and guess return address
+		my($domain);
+		
+		if($::HaveUtil) {
+			$domain = Mail::Util::maildomain();
+		} elsif ($Is_VMS) {
+			require Sys::Hostname;
+			$domain = Sys::Hostname::hostname();
+		} else {
+			$domain = `hostname`.".".`domainname`;
+			$domain =~ s/[\r\n]+//g;
+		}
+	    
+	    my($guess);
+	                     
+	        if( !$domain) {
+	        	$guess = "";
+	        } elsif ($Is_VMS && !$::Config{'d_has_sockets'}) { 
+	        	$guess = "$domain\:\:$me";
+	        } else {
+		    	$guess = "$me\@$domain" if $domain;
+		    	$guess = "$me\@unknown.addresss" unless $domain;
+			}
+			
+		$guess = $ENV{'REPLYTO'} if defined($ENV{'REPLYTO'});
+		$guess = $ENV{"REPLY-TO"} if defined($ENV{'REPLY-TO'});
+	
+		if( $guess ) {
+			paraprint <<EOF;
+
+
+Your e-mail address will be useful if you need to be contacted. If the
+default shown is not your full internet e-mail address, please correct it.
+
+EOF
+		} else {
+			paraprint <<EOF;
+
+So that you may be contacted if necessary, please enter 
+your full internet e-mail address here.
+
+EOF
+		}
+		print "Your address [$guess]: ";
+	
+		$from = <>;
+		chop $from;
+	
+		if($from eq "") { $from = $guess }
+	
+	}
+	
+	#if( $from =~ /^(.*)\@(.*)$/ ) {
+	#	$mailname = $1;
+	#	$maildomain = $2;
+	#}
+
+	if( $from eq $cc or $me eq $cc ) {
+		# Try not to copy ourselves
+		$cc = "yourself";
+	}
+
+
+	# Prompt for administrator address, unless an override was given
+	if( !$::opt_C and !$::opt_c ) {
+		paraprint <<EOF;
+
+
+A copy of this report can be sent to your local
+perl administrator. If the address is wrong, please 
+correct it, or enter 'none' or 'yourself' to not send
+a copy.
+
+EOF
+
+		print "Local perl administrator [$cc]: ";
+	
+		my($entry) = scalar(<>);
+		chop $entry;
+	
+		if($entry ne "") {
+			$cc = $entry;
+			if($me eq $cc) { $cc = "" }
+		}
+	
+	}
+
+	if($cc =~ /^(none|yourself|me|myself|ourselves)$/i) { $cc = "" }
+
+	$andcc = " and $cc" if $cc;
+
+
+	# Prompt for editor, if no override is given
+	if(! $::opt_e and ! $::opt_f and ! $::opt_b) {
+		paraprint <<EOF;
+
+
+Now you need to supply the bug report. Try to make
+the report concise but descriptive. Include any 
+relevant detail. Some information about your local
+perl configuration will automatically be included 
+at the end of the report. 
+
+You will probably want to use an editor to enter
+the report. If "$ed" is the editor you want
+to use, then just press Enter, otherwise type in
+the name of the editor you would like to use.
+
+If you would like to use a prepared file, type
+"file", and you will be asked for the filename.
+
+EOF
+
+		print "Editor [$ed]: ";
+	
+		my($entry) =scalar(<>);
+		chop $entry;
+	
+		if($entry ne "") {
+			$ed = $entry;
+		} 
+	}
+
+
+	# Generate scratch file to edit report in
+	
+	{
+	my($dir) = $Is_VMS ? 'sys$scratch:' : '/tmp/';
+	$filename = "bugrep0$$";
+	$filename++ while -e "$dir$filename";
+	$filename = "$dir$filename";
+	}
+	
+	
+	# Prompt for file to read report from, if needed
+	
+	if( $ed eq "file" and ! $file) {
+		paraprint <<EOF;
+
+
+What is the name of the file that contains your report?
+
+EOF
+
+		print "Filename: ";
+	
+		my($entry) = scalar(<>);
+		chop($entry);
+
+		if(!-f $entry or !-r $entry) {
+			print "\n\nUnable to read from `$entry'.\nExiting.\n";
+			exit;
+		}
+		$file = $entry;
+
+	}
+
+
+	# Generate report
+
+	open(REP,">$filename");
+
+	print REP <<EOF;
+This is a bug report for perl from $from,
+generated with the help of perlbug $Version running under perl $].
+
+EOF
+
+	if($body) {
+		print REP $body;
+	} elsif($file) {
+		open(F,"<$file") or die "Unable to read report file: $!\n";
+		while(<F>) {
+		print REP $_
+		}
+		close(F);
+	} else {
+		print REP "[Please enter your report here]\n";
+	}
+	
+	Dump(*REP);
+	close(REP);
+
+}
+
+sub Dump {
+	local(*OUT) = @_;
+	
+	print OUT <<EOF;
+
+
+
+Site configuration information for perl $]:
+
+EOF
+
+	if( $::Config{cf_by} and $::Config{cf_time}) {
+		print OUT "Configured by $::Config{cf_by} at $::Config{cf_time}.\n\n";
+	}
+
+	print OUT Config::myconfig;
+
+	if($verbose) {
+		print OUT "\nComplete configuration data for perl $]:\n\n";
+		my($value);
+		foreach (sort keys %::Config) {
+			$value = $::Config{$_};
+			$value =~ s/'/\\'/g;
+			print OUT "$_='$value'\n";
+		}
+	}
+}
+
+sub Edit {
+	# Edit the report
+	
+tryagain:	
+	if(!$file and !$body) {
+		my($sts) = system("$ed $filename");
+		if( $Is_VMS ? !($sts & 1) : $sts ) {
+			#print "\nUnable to run editor!\n";
+			paraprint <<EOF;
+
+The editor you chose (`$ed') could apparently not be run!
+Did you mistype the name of your editor? If so, please
+correct it here, otherwise just press Enter. 
+
+EOF
+			print "Editor [$ed]: ";
+		
+			my($entry) =scalar(<>);
+			chop $entry;
+	
+			if($entry ne "") {
+				$ed = $entry;
+				goto tryagain;
+			} else {
+			
+			paraprint <<EOF;
+
+You may want to save your report to a file, so you can edit and mail it
+yourself.
+EOF
+			}
+		} 
+	}
+}
+
+sub NowWhat {
+
+	# Report is done, prompt for further action
+	if( !$::opt_S ) {
+		while(1) {
+
+			paraprint <<EOF;
+
+
+Now that you have completed your report, would you like to send 
+the message to $address$andcc, display the message on 
+the screen, re-edit it, or cancel without sending anything?
+You may also save the message as a file to mail at another time.
+
+EOF
+
+			print "Action (Send/Display/Edit/Cancel/Save to File): ";
+			my($action) = scalar(<>);
+			chop $action;
+
+			if( $action =~ /^(f|sa)/i ) { # <F>ile/<Sa>ve
+				print "\n\nName of file to save message in [perlbug.rep]: ";
+				my($file) = scalar(<>);
+				chop $file;
+				if($file eq "") { $file = "perlbug.rep" }
+			
+				open(FILE,">$file");
+				open(REP,"<$filename");
+				print FILE "To: $address\nSubject: $subject\n";
+				print FILE "Cc: $cc\n" if $cc;
+				print FILE "Reply-To: $from\n" if $from;
+				print FILE "\n";
+				while(<REP>) { print FILE }
+				close(REP);
+				close(FILE);
+	
+				print "\nMessage saved in `$file'.\n";
+				exit;
+
+			} elsif( $action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
+				# Display the message
+				open(REP,"<$filename");
+				while(<REP>) { print $_ }
+				close(REP);
+			} elsif( $action =~ /^se/i ) { # <S>end
+				# Send the message
+				print "\
+Are you certain you want to send this message?
+Please type \"yes\" if you are: ";
+				my($reply) = scalar(<STDIN>);
+				chop($reply);
+				if( $reply eq "yes" ) {
+					last;
+				}
+			} elsif( $action =~ /^[er]/i ) { # <E>dit, <R>e-edit
+				# edit the message
+				Edit();
+				#system("$ed $filename");
+			} elsif( $action =~ /^[qc]/i ) { # <C>ancel, <Q>uit
+				1 while unlink($filename);  # remove all versions under VMS
+				print "\nCancelling.\n";
+				exit(0);
+			} elsif( $action =~ /^s/ ) {
+				paraprint <<EOF;
+
+I'm sorry, but I didn't understand that. Please type "send" or "save".
+EOF
+			}
+		
+		}
+	}
+}
+
+
+sub Send {
+
+	# Message has been accepted for transmission -- Send the message
+	
+	if($::HaveSend) {
+
+		$msg = new Mail::Send Subject => $subject, To => $address;
+	
+		$msg->cc($cc) if $cc;
+		$msg->add("Reply-To",$from) if $from;
+	    
+		$fh = $msg->open;
+
+		open(REP,"<$filename");
+		while(<REP>) { print $fh $_ }
+		close(REP);
+	
+		$fh->close;  
+	
+	} else {
+		if ($Is_VMS) {
+			if ( ($address =~ /@/ and $address !~ /^\w+%"/) or
+			     ($cc      =~ /@/ and $cc      !~ /^\w+%"/) ){
+				my($prefix);
+				foreach (qw[ IN MX SMTP UCX PONY WINS ],'') {
+					$prefix = "$_%",last if $ENV{"MAIL\$PROTOCOL_$_"};
+				}
+				$address = qq[${prefix}"$address"] unless $address =~ /^\w+%"/;
+				$cc = qq[${prefix}"$cc"] unless !$cc || $cc =~ /^\w+%"/;
+			}
+			$subject =~ s/"/""/g; $address =~ s/"/""/g; $cc =~ s/"/""/g;
+			my($sts) = system(qq[mail/Subject="$subject" $filename. "$address","$cc"]);
+			if (!($sts & 1)) { die "Can't spawn off mail\n\t(leaving bug report in $filename): $sts\n;" }
+		} else {
+			my($sendmail) = "";
+			
+			foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
+			{
+				$sendmail = $_, last if -e $_;
+			}
+			
+			paraprint <<"EOF" and die "\n" if $sendmail eq "";
+			
+I am terribly sorry, but I cannot find sendmail, or a close equivalent, and
+the perl package Mail::Send has not been installed, so I can't send your bug
+report. We apologize for the inconveniencence.
+
+So you may attempt to find some way of sending your message, it has
+been left in the file `$filename'.
+
+EOF
+			
+			open(SENDMAIL,"|$sendmail -t");
+			print SENDMAIL "To: $address\n";
+			print SENDMAIL "Subject: $subject\n";
+			print SENDMAIL "Cc: $cc\n" if $cc;
+			print SENDMAIL "Reply-To: $from\n" if $from;
+			print SENDMAIL "\n\n";
+			open(REP,"<$filename");
+			while(<REP>) { print SENDMAIL $_ }
+			close(REP);
+			
+			close(SENDMAIL);
+		}
+	
+	}
+	
+	print "\nMessage sent.\n";
+
+	1 while unlink($filename);  # remove all versions under VMS
+
+}
+
+sub Help {
+	print <<EOF; 
+
+A program to help generate bug reports about perl5, and mail them. 
+It is designed to be used interactively. Normally no arguments will
+be needed.
+	
+Usage:
+$0  [-v] [-a address] [-s subject] [-b body | -f file ]
+    [-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t]
+    
+Simplest usage:  run "$0", and follow the prompts.
+
+Options:
+
+  -v    Include Verbose configuration data in the report
+  -f    File containing the body of the report. Use this to 
+        quickly send a prepared message.
+  -S    Send without asking for confirmation.
+  -a    Address to send the report to. Defaults to `$address'.
+  -c    Address to send copy of report to. Defaults to `$cc'.
+  -C    Don't send copy to administrator.
+  -s    Subject to include with the message. You will be prompted 
+        if you don't supply one on the command line.
+  -b    Body of the report. If not included on the command line, or
+        in a file with -f, you will get a chance to edit the message.
+  -r    Your return address. The program will ask you to confirm
+        this if you don't give it here.
+  -e    Editor to use. 
+  -t    Test mode. The target address defaults to `$testaddress'.
+  -d	Data mode (the default if you redirect or pipe output.) 
+        This prints out your configuration data, without mailing
+        anything. You can use this with -v to get more complete data.
+  
+EOF
+}
+
+sub paraprint {
+    my @paragraphs = split /\n{2,}/, "@_";
+    print "\n\n";
+    for (@paragraphs) {   # implicit local $_
+    	s/(\S)\s*\n/$1 /g;
+	    write;
+	    print "\n";
+    }
+                       
+}
+                            
+
+format STDOUT =
+^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
+$_
+.
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/utils/perldoc.PL b/gnu/usr.bin/perl/utils/perldoc.PL
new file mode 100644
index 00000000000..e53d542cb93
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/perldoc.PL
@@ -0,0 +1,394 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+    eval 'exec perl -S $0 "$@"'
+	if 0;
+
+#
+# Perldoc revision #1 -- look up a piece of documentation in .pod format that
+# is embedded in the perl installation tree.
+#
+# This is not to be confused with Tom Christianson's perlman, which is a
+# man replacement, written in perl. This perldoc is strictly for reading
+# the perl manuals, though it too is written in perl.
+
+if(@ARGV<1) {
+	die <<EOF;
+Usage: $0 [-h] [-v] [-t] [-u] [-m] PageName|ModuleName|ProgramName
+
+We suggest you use "perldoc perldoc" to get aquainted 
+with the system.
+EOF
+}
+
+use Getopt::Std;
+$Is_VMS = $^O eq 'VMS';
+
+sub usage{
+        warn "@_\n" if @_;
+    die <<EOF;
+perldoc [-h] [-v] [-u] PageName|ModuleName|ProgramName...
+    -h   Display this help message.
+    -t   Display pod using pod2text instead of pod2man and nroff.
+    -u	 Display unformatted pod text
+    -m   Display modules file in its entirety
+    -v	 Verbosely describe what's going on.
+PageName|ModuleName...
+         is the name of a piece of documentation that you want to look at. You 
+         may either give a descriptive name of the page (as in the case of
+         `perlfunc') the name of a module, either like `Term::Info', 
+         `Term/Info', the partial name of a module, like `info', or 
+         `makemaker', or the name of a program, like `perldoc'.
+         
+Any switches in the PERLDOC environment variable will be used before the 
+command line arguments.
+
+EOF
+}
+
+use Text::ParseWords;
+
+
+unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
+
+getopts("mhtuv") || usage;
+
+usage if $opt_h || $opt_h; # avoid -w warning
+
+usage("only one of -t, -u, or -m") if $opt_t + $opt_u + $opt_m > 1;
+
+if ($opt_t) { require Pod::Text; import Pod::Text; }
+
+@pages = @ARGV;
+
+sub containspod {
+	my($file) = @_;
+	local($_);
+	open(TEST,"<$file");
+	while(<TEST>) {
+		if(/^=head/) {
+			close(TEST);
+			return 1;
+		}
+	}
+	close(TEST);
+	return 0;
+}
+
+ sub minus_f_nocase {
+     my($file) = @_;
+     local *DIR;
+     local($")="/";
+     my(@p,$p,$cip);
+     foreach $p (split(/\//, $file)){
+	if ($Is_VMS and not scalar @p) {
+	    # VMS filesystems don't begin at '/'
+	    push(@p,$p);
+	    next;
+	}
+ 	if (-d ("@p/$p")){
+ 	    push @p, $p;
+ 	} elsif (-f ("@p/$p")) {
+ 	    return "@p/$p";
+ 	} else {
+ 	    my $found=0;
+ 	    my $lcp = lc $p;
+ 	    opendir DIR, "@p";
+ 	    while ($cip=readdir(DIR)) {
+		$cip =~ s/\.dir$// if $Is_VMS;
+ 		if (lc $cip eq $lcp){
+ 		    $found++;
+ 		    last;
+ 		}
+ 	    }
+ 	    closedir DIR;
+ 	    return "" unless $found;
+ 	    push @p, $cip;
+ 	    return "@p" if -f "@p";
+ 	}
+     }
+     return; # is not a file
+ }
+ 
+  sub searchfor {
+  	my($recurse,$s,@dirs) = @_;
+  	$s =~ s!::!/!g;
+  	$s = VMS::Filespec::unixify($s) if $Is_VMS;
+  	printf STDERR "looking for $s in @dirs\n" if $opt_v;
+ 	my $ret;
+ 	my $i;
+ 	my $dir;
+  	for ($i=0;$i<@dirs;$i++) {
+  		$dir = $dirs[$i];
+  		($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
+ 	    if ((    $ret = minus_f_nocase "$dir/$s.pod")
+ 		or ( $ret = minus_f_nocase "$dir/$s.pm"  and containspod($ret))
+ 		or ( $ret = minus_f_nocase "$dir/$s"     and containspod($ret))
+ 		or ( $Is_VMS and 
+ 		     $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
+ 		or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
+ 		or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
+ 		{ return $ret; }
+ 		
+ 		if($recurse) {
+			opendir(D,$dir);
+			my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
+			closedir(D);
+			@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
+			next unless @newdirs;
+			print STDERR "Also looking in @newdirs\n" if $opt_v;
+			push(@dirs,@newdirs);
+ 		}
+ 	}
+  	return ();
+  }
+
+
+foreach (@pages) {
+	print STDERR "Searching for $_\n" if $opt_v;
+	# We must look both in @INC for library modules and in PATH
+	# for executables, like h2xs or perldoc itself.
+	@searchdirs = @INC;
+	unless ($opt_m) { 
+	    if ($Is_VMS) {
+		my($i,$trn);
+		for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
+		    push(@searchdirs,$trn);
+		}
+	    } else {
+		    push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
+	    }
+	    @files= searchfor(0,$_,@searchdirs);
+	}
+	if( @files ) {
+		print STDERR "Found as @files\n" if $opt_v;
+	} else {
+		# no match, try recursive search
+		
+		@searchdirs = grep(!/^\.$/,@INC);
+		
+		
+		@files= searchfor(1,$_,@searchdirs);
+		if( @files ) {
+			print STDERR "Loosely found as @files\n" if $opt_v;
+		} else {
+			print STDERR "No documentation found for '$_'\n";
+		}
+	}
+	push(@found,@files);
+}
+
+if(!@found) {
+	exit ($Is_VMS ? 98962 : 1);
+}
+
+if( ! -t STDOUT ) { $opt_f = 1 }
+
+unless($Is_VMS) {
+	$tmp = "/tmp/perldoc1.$$";
+	$goodresult = 0;
+	@pagers = qw( more less pg view cat );
+	unshift(@pagers,$ENV{PAGER}) if $ENV{PAGER};
+} else {
+	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
+	@pagers = qw( most more less type/page );
+	unshift(@pagers,$ENV{PERLDOC_PAGER}) if $ENV{PERLDOC_PAGER};
+	$goodresult = 1;
+}
+
+if ($opt_m) {
+    foreach $pager (@pagers) {
+	my($sts) = system("$pager @found");
+	exit 0 if ($Is_VMS ? ($sts & 1) : !$sts);
+    }
+    exit $Is_VMS ? $sts : 1;
+} 
+
+foreach (@found) {
+
+	if($opt_t) {
+		open(TMP,">>$tmp");
+		Pod::Text::pod2text($_,*TMP);
+		close(TMP);
+	} elsif(not $opt_u) {
+		open(TMP,">>$tmp");
+		$rslt = `pod2man $_ | nroff -man`;
+		if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
+		else      { $err = $?; }
+		print TMP $rslt unless $err;
+		close TMP;
+	}
+	                                                
+	if( $opt_u or $err or -z $tmp) {
+		open(OUT,">>$tmp");
+		open(IN,"<$_");
+		$cut = 1;
+		while (<IN>) {
+			$cut = $1 eq 'cut' if /^=(\w+)/;
+			next if $cut;
+			print OUT;
+		}
+		close(IN);
+		close(OUT);
+	}
+}
+
+if( $opt_f ) {
+	open(TMP,"<$tmp");
+	print while <TMP>;
+	close(TMP);
+} else {
+	foreach $pager (@pagers) {
+		$sts = system("$pager $tmp");
+		last if $Is_VMS && ($sts & 1);
+		last unless $sts;
+	}
+}
+
+1 while unlink($tmp); #Possibly pointless VMSism
+
+exit 0;
+
+__END__
+
+=head1 NAME
+
+perldoc - Look up Perl documentation in pod format.
+
+=head1 SYNOPSIS
+
+B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName|ModuleName|ProgramName
+
+=head1 DESCRIPTION
+
+I<perldoc> looks up a piece of documentation in .pod format that is
+embedded in the perl installation tree or in a perl script, and displays
+it via pod2man | nroff -man | $PAGER.  This is primarily used for the
+documentation for the perl library modules. 
+
+Your system may also have man pages installed for those modules, in
+which case you can probably just use the man(1) command.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-h> help
+
+Prints out a brief help message.
+
+=item B<-v> verbose
+
+Describes search for the item in detail.
+
+=item B<-t> text output
+
+Display docs using plain text converter, instead of nroff. This may be faster,
+but it won't look as nice.
+
+=item B<-u> unformatted
+
+Find docs only; skip reformatting by pod2*
+
+=item B<-m> module
+
+Display the entire module: both code and unformatted pod documentation.
+This may be useful if the docs don't explain a function in the detail
+you need, and you'd like to inspect the code directly; perldoc will find
+the file for you and simply hand it off for display.
+
+=item B<PageName|ModuleName|ProgramName>
+
+The item you want to look up.  Nested modules (such as C<File::Basename>)
+are specified either as C<File::Basename> or C<File/Basename>.  You may also
+give a descriptive name of a page, such as C<perlfunc>. You make also give a
+partial or wrong-case name, such as "basename" for "File::Basename", but
+this will be slower, if there is more then one page with the same partial
+name, you will only get the first one.
+
+=back
+
+=head1 ENVIRONMENT
+
+Any switches in the C<PERLDOC> environment variable will be used before the 
+command line arguments.  C<perldoc> also searches directories
+specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
+defined) and C<PATH> environment variables.
+(The latter is so that embedded pods for executables, such as
+C<perldoc> itself, are available.)
+
+=head1 AUTHOR
+
+Kenneth Albanowski <kjahds@kjahds.com>
+
+Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
+
+=head1 SEE ALSO
+
+=head1 DIAGNOSTICS
+
+=cut
+
+#
+# Version 1.11: Tue Dec 26 09:54:33 EST 1995
+#       Kenneth Albanowski <kjahds@kjahds.com>
+#   -added Charles Bailey's further VMS patches, and -u switch
+#   -added -t switch, with pod2text support
+# 
+# Version 1.10: Thu Nov  9 07:23:47 EST 1995
+#		Kenneth Albanowski <kjahds@kjahds.com>
+#	-added VMS support
+#	-added better error recognition (on no found pages, just exit. On
+#	 missing nroff/pod2man, just display raw pod.)
+#	-added recursive/case-insensitive matching (thanks, Andreas). This
+#	 slows things down a bit, unfortunately. Give a precise name, and
+#	 it'll run faster.
+#
+# Version 1.01:	Tue May 30 14:47:34 EDT 1995
+#		Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#   -added pod documentation.
+#   -added PATH searching.
+#   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
+#    and friends.
+#
+#
+# TODO:
+#
+#	Cache directories read during sloppy match
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/utils/pl2pm.PL b/gnu/usr.bin/perl/utils/pl2pm.PL
new file mode 100644
index 00000000000..e8277bb673d
--- /dev/null
+++ b/gnu/usr.bin/perl/utils/pl2pm.PL
@@ -0,0 +1,387 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+=head1 NAME
+
+pl2pm - Rough tool to translate Perl4 .pl files to Perl5 .pm modules.
+
+=head1 SYNOPSIS
+
+B<pl2pm> F<files>
+
+=head1 DESCRIPTION
+
+B<pl2pm> is a tool to aid in the conversion of Perl4-style .pl
+library files to Perl5-style library modules.  Usually, your old .pl
+file will still work fine and you should only use this tool if you
+plan to update your library to use some of the newer Perl 5 features,
+such as AutoLoading.
+
+=head1 LIMITATIONS
+
+It's just a first step, but it's usually a good first step.
+
+=head1 AUTHOR
+
+Larry Wall <lwall@sems.com>
+
+=cut
+
+while (<DATA>) {
+    chop;
+    $keyword{$_} = 1;
+}
+
+undef $/;
+$* = 1;
+while (<>) {
+    $newname = $ARGV;
+    $newname =~ s/\.pl$/.pm/ || next;
+    $newname =~ s#(.*/)?(\w+)#$1\u$2#;
+    if (-f $newname) {
+	warn "Won't overwrite existing $newname\n";
+	next;
+    }
+    $oldpack = $2;
+    $newpack = "\u$2";
+    @export = ();
+    print "$oldpack => $newpack\n" if $verbose;
+
+    s/\bstd(in|out|err)\b/\U$&/g;
+    s/(sub\s+)(\w+)(\s*\{[ \t]*\n)\s*package\s+$oldpack\s*;[ \t]*\n+/${1}main'$2$3/ig;
+    if (/sub\s+main'/) {
+	@export = m/sub\s+main'(\w+)/g;
+	s/(sub\s+)main'(\w+)/$1$2/g;
+    }
+    else {
+	@export = m/sub\s+([A-Za-z]\w*)/g;
+    }
+    @export_ok = grep($keyword{$_}, @export);
+    @export = grep(!$keyword{$_}, @export);
+    @export{@export} = (1) x @export;
+    s/(^\s*);#/$1#/g;
+    s/(#.*)require ['"]$oldpack\.pl['"]/$1use $newpack/;
+    s/(package\s*)($oldpack)\s*;[ \t]*\n+//ig;
+    s/([\$\@%&*])'(\w+)/&xlate($1,"",$2)/eg;
+    s/([\$\@%&*]?)(\w+)'(\w+)/&xlate($1,$2,$3)/eg;
+    if (!/\$\[\s*\)?\s*=\s*[^0\s]/) {
+	s/^\s*(local\s*\()?\s*\$\[\s*\)?\s*=\s*0\s*;[ \t]*\n//g;
+	s/\$\[\s*\+\s*//g;
+	s/\s*\+\s*\$\[//g;
+	s/\$\[/0/g;
+    }
+    s/open\s+(\w+)/open($1)/g;
+ 
+    if (s/\bdie\b/croak/g) {
+	$carp = "use Carp;\n";
+	s/croak "([^"]*)\\n"/croak "$1"/g;
+    }
+    else {
+	$carp = "";
+    }
+    if (@export_ok) {
+	$export_ok = "\@EXPORT_OK = qw(@export_ok);\n";
+    }
+    else {
+	$export_ok = "";
+    }
+
+    open(PM, ">$newname") || warn "Can't create $newname: $!\n";
+    print PM <<"END";
+package $newpack;
+require 5.000;
+require Exporter;
+$carp
+\@ISA = qw(Exporter);
+\@EXPORT = qw(@export);
+$export_ok
+$_
+END
+}
+
+sub xlate {
+    local($prefix, $pack, $ident) = @_;
+    if ($prefix eq '' && $ident =~ /^(t|s|m|d|ing|ll|ed|ve|re)$/) {
+	"${pack}'$ident";
+    }
+    elsif ($pack eq "" || $pack eq "main") {
+	if ($export{$ident}) {
+	    "$prefix$ident";
+	}
+	else {
+	    "$prefix${pack}::$ident";
+	}
+    }
+    elsif ($pack eq $oldpack) {
+	"$prefix${newpack}::$ident";
+    }
+    else {
+	"$prefix${pack}::$ident";
+    }
+}
+__END__
+AUTOLOAD
+BEGIN
+CORE
+DESTROY
+END
+abs
+accept
+alarm
+and
+atan2
+bind
+binmode
+bless
+caller
+chdir
+chmod
+chop
+chown
+chr
+chroot
+close
+closedir
+cmp
+connect
+continue
+cos
+crypt
+dbmclose
+dbmopen
+defined
+delete
+die
+do
+dump
+each
+else
+elsif
+endgrent
+endhostent
+endnetent
+endprotoent
+endpwent
+endservent
+eof
+eq
+eval
+exec
+exit
+exp
+fcntl
+fileno
+flock
+for
+foreach
+fork
+format
+formline
+ge
+getc
+getgrent
+getgrgid
+getgrnam
+gethostbyaddr
+gethostbyname
+gethostent
+getlogin
+getnetbyaddr
+getnetbyname
+getnetent
+getpeername
+getpgrp
+getppid
+getpriority
+getprotobyname
+getprotobynumber
+getprotoent
+getpwent
+getpwnam
+getpwuid
+getservbyname
+getservbyport
+getservent
+getsockname
+getsockopt
+glob
+gmtime
+goto
+grep
+gt
+hex
+if
+index
+int
+ioctl
+join
+keys
+kill
+last
+lc
+lcfirst
+le
+length
+link
+listen
+local
+localtime
+log
+lstat
+lt
+m
+mkdir
+msgctl
+msgget
+msgrcv
+msgsnd
+my
+ne
+next
+no
+not
+oct
+open
+opendir
+or
+ord
+pack
+package
+pipe
+pop
+print
+printf
+push
+q
+qq
+quotemeta
+qw
+qx
+rand
+read
+readdir
+readline
+readlink
+readpipe
+recv
+redo
+ref
+rename
+require
+reset
+return
+reverse
+rewinddir
+rindex
+rmdir
+s
+scalar
+seek
+seekdir
+select
+semctl
+semget
+semop
+send
+setgrent
+sethostent
+setnetent
+setpgrp
+setpriority
+setprotoent
+setpwent
+setservent
+setsockopt
+shift
+shmctl
+shmget
+shmread
+shmwrite
+shutdown
+sin
+sleep
+socket
+socketpair
+sort
+splice
+split
+sprintf
+sqrt
+srand
+stat
+study
+sub
+substr
+symlink
+syscall
+sysread
+system
+syswrite
+tell
+telldir
+tie
+time
+times
+tr
+truncate
+uc
+ucfirst
+umask
+undef
+unless
+unlink
+unpack
+unshift
+untie
+until
+use
+utime
+values
+vec
+wait
+waitpid
+wantarray
+warn
+while
+write
+x
+xor
+y
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/vms/Makefile b/gnu/usr.bin/perl/vms/Makefile
new file mode 100644
index 00000000000..99c5236bf73
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/Makefile
@@ -0,0 +1,1374 @@
+#> This file produced from Descrip.MMS by mms2make.pl
+#> Lines beginning with "#>" were commented out during the
+#> conversion process.  For more information, see mms2make.pl
+#>
+# Makefile for perl5 on VMS
+# Last revised 22-Mar-1996 by Charles Bailey  bailey@genetics.upenn.edu
+#
+#
+#	tidy      -- purge files generated by executing this file
+#	clean     -- remove all intermediate (e.g. object files, C files generated
+#	             during build) files generated by executing this file,
+#	             but leave `installable' files (images, library) intact
+#	realclean -- remove all files generated by executing this file
+#	cleansrc  -- `realclean' + purge *.c,*.h,Makefile
+#	crtl.opt  -- compiler-specific linker options file (made automatically)
+#
+
+#### Start of system configuration section. ####
+
+
+# File type to use for object files
+# File type to use for object libraries
+# File type to use for executable images
+# File type to use for object files
+O = .obj
+# File type to use for object libraries
+OLB = .olb
+# File type to use for executable images
+E = .exe
+
+ARCH = VMS_VAX
+OBJVAL = $@
+
+.first:
+	@ $$@[.vms]fndvers.com "" "" "[.vms]Makefile"
+
+# Updated by fndvers.com -- do not edit by hand
+PERL_VERSION = 5_003  #
+
+
+ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
+ARCHCORE = [.lib.$(ARCH).$(PERL_VERSION).CORE]
+ARCHAUTO = [.lib.$(ARCH).$(PERL_VERSION).auto]
+
+
+
+
+# -fno-builtin avoids bug in gcc up to version 2.6.2 which can destroy
+# data when memcpy() is called on large (>64 kB) blocks of memory
+# (fixed in gcc 2.6.3)
+XTRAOBJS = 
+LIBS1 = $(XTRAOBJS)
+DBGSPECFLAGS = /Show=(Source,Include,Expansion)
+# Some versions of DECCRTL on AXP have a bug in chdir() which causes the change
+# to persist after the image exits, even when this was not requested, iff
+# SYSNAM is enabled.  This is fixed in CSC Patch # AXPACRT04_061, but turning
+# off SYSNAM for the MM[SK] subprocess doesn't hurt anything, so we do it
+# just in case.
+.first:
+	@ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS sys$$Library
+	@ If f$$TrnLnm("Sys").eqs."" .and. f$$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include
+
+XTRACCFLAGS = /Include=[]/Object=$(O)
+XTRADEF =
+LIBS2 = sys$$Share:VAXCRTL/Shareable
+
+
+DBGCCFLAGS = /NoList
+DBGLINKFLAGS = /NoMap
+DBG = 
+
+# N.B. the targets for $(SOCKC) and $(SOCKH) assume that the permanent
+# copies live in [.vms], and the `clean' target will delete copies of
+# these files in the current default directory.
+SOCKDEF =
+SOCKLIB =
+SOCKC =
+SOCKH =
+SOCKCLIS =
+SOCKHLIS =
+SOCKOBJ =
+SOCKPM =
+
+# C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger
+CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
+LINKFLAGS = $(DBGLINKFLAGS)
+
+MAKE = $(MMS)
+MAKEFILE = [.VMS]Makefile   # this file
+NOOP = continue
+
+# Macros to invoke a copy of miniperl during the build.  Targets which
+# are built using these macros should depend on $(MINIPERL_EXE)
+MINIPERL_EXE = sys$$Disk:[]miniperl$(E)
+MINIPERL = MCR $(MINIPERL_EXE) "-I[.lib]"
+XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp -noprototypes
+# Macro to invoke a preexisting copy of Perl.  This is used to regenerate
+# some header files when rebuilding Perl, but premade versions are provided
+# in the distribution, so it's OK if this doesn't work; it's here to make
+# life easier for those who modify Perl and rebuild it.
+INSTPERL = perl
+
+# Space-separated list of "static" extensions to build into perlshr (case counts).
+MYEXT = DynaLoader
+# object files for these extensions; the trailing comma is required if
+# there are any object files specified
+# These must be built separately, or you must add rules below to build them
+myextobj = [.ext.dynaloader]dl_vms$(O),
+EXT = $(MYEXT)
+extobj = $(myextobj)
+
+
+#### End of system configuration section. ####
+
+
+h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h
+h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h
+h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h
+h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h
+h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS)
+
+c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c
+c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c
+c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS)
+
+c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c
+
+obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O)
+obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O)
+obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), globals$(O), vms$(O) $(SOCKOBJ)
+
+obj = $(obj1), $(obj2), $(obj3)
+
+ac1 = $(ARCHCORE)EXTERN.h $(ARCHCORE)INTERN.h  $(ARCHCORE)XSUB.h $(ARCHCORE)av.h
+ac2 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h
+ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
+ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h
+ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h
+ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h
+ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h
+ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt
+ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt
+acs =
+
+CRTL = []crtl.opt
+CRTLOPTS =,$(CRTL)/Options
+
+.suffixes:
+
+.suffixes: $(O) .c .xs
+
+.xs.c :
+	$(XSUBPP) $< >$@
+
+
+.c$(O) :
+	$(CC) $(CFLAGS) $<
+
+.xs$(O) :
+	$(XSUBPP) $< >$(MMS$SOURCE_NAME).c
+	$(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
+
+
+all : base extras archcorefiles preplibrary perlpods
+	@ $(NOOP)
+base : miniperl perl
+	@ $(NOOP)
+extras : Fcntl FileHandle Safe libmods utils podxform
+	@ $(NOOP)
+libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm 
+	@ $(NOOP)
+utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug
+	@ $(NOOP)
+podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man
+	@ $(NOOP)
+
+pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod
+pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod
+pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod
+pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod
+pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod
+pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod
+pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod
+pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
+
+perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod
+	@ $(NOOP)
+
+archcorefiles :  $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp
+	@ $(NOOP)
+
+miniperl : $(DBG)miniperl$(E)
+	@ Continue
+miniperl_objs = miniperlmain$(O), $(obj)
+$(MINIPERL_EXE) :  miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL)
+	Link $(LINKFLAGS)/NoDebug/Exe=$@ miniperlmain$(O), $(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS)
+$(DBG)miniperl$(E) :  $(miniperl_objs), $(DBG)libperl$(OLB) $(CRTL)
+	Link $(LINKFLAGS)/Exe=$@ miniperlmain$(O),$(DBG)libperl$(OLB)/Library/Include=globals  $(CRTLOPTS)
+
+$(DBG)libperl$(OLB) : $(obj)
+	@ If f$$Search("$@").eqs."" Then Library/Object/Create $(MMS$TARGET)
+	Library/Object/Replace $@ $(obj1)
+	Library/Object/Replace $@ $(obj2)
+	Library/Object/Replace $@ $(obj3)
+
+perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl
+	$(MINIPERL) [.VMS]Writemain.pl "$(EXT)"
+
+perl : $(DBG)perl$(E)
+	@ Continue
+$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
+	@ $$@[.vms]genopt "PerlShr.Opt/Write" "|" "''f$$Environment("Default")'$(DBG)PerlShr$(E)/Share"
+	Link $(LINKFLAGS)/Exe=$@ perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
+
+$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
+	Link /NoTrace$(LINKFLAGS)/Share=$@ $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option
+
+# The following files are built in one go by gen_shrfls.pl:
+#  perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP
+#  perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
+# The song and dance with gen_shrfls.opt accomodates DCL's 255 character
+# line length limit.
+# This is a backup target used only with older versions of the DECCRTL which
+# can't deal with pipes properly.  See ReadMe.VMS for details.
+$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+	$(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+	@ Delete/NoLog/NoConfirm gen_shrfls.opt;
+	@ If f$$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
+	@ Copy _NLA0: $(DBG)perlshr_xtras.ts
+
+$(ARCHDIR)config.pm : [.lib]config.pm
+	Create/Directory $(ARCHDIR)
+	Copy [.lib]config.pm $@
+
+# Once again, we accomodate DCL's 255 character buffer
+[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE)
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt
+	$(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt
+	@ Delete/NoLog/NoConfirm genconfig.opt;
+	$(MINIPERL) ConfigPM.
+
+[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE)
+	$(XSUBPP) [.ext.dynaloader]dl_vms.xs >$@
+
+[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c
+	$(CC) $(CFLAGS) /Object=$@ [.ext.dynaloader]dl_vms.c
+
+[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm
+	Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm
+	@ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm
+
+Safe : [.lib]Safe.pm [.lib.auto.Safe]Safe$(E)
+	@ $(NOOP)
+
+[.lib]Safe.pm : [.ext.Safe]Makefile
+	@ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.Safe]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.Safe]Safe$(E) : [.ext.Safe]Makefile
+	@ Set Default [.ext.Safe]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Safe]Makefile : [.ext.Safe]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E)
+	@ $(NOOP)
+
+[.lib]FileHandle.pm : [.ext.FileHandle]Makefile
+	@ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.FileHandle]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Makefile
+	@ Set Default [.ext.FileHandle]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.FileHandle]Makefile : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E)
+	@ $(NOOP)
+
+[.lib]Fcntl.pm : [.ext.Fcntl]Makefile
+	@ If f$$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Makefile
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Fcntl]Makefile : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+[.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm
+	@ If f$$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS]
+	Copy/Log/NoConfirm [.vms.ext]Filespec.pm $@
+
+[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) [.utils]perldoc.PL
+	Copy/Log [.utils]perldoc $@
+
+[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm
+	$(MINIPERL) Minimod.PL >$@
+
+[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) [.utils]c2ph.PL
+
+[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) [.utils]h2ph.PL
+
+[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) [.utils]h2xs.PL
+
+[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) [.utils]perlbug.PL
+	Rename/Log [.utils]perlbug $@
+
+[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) [.utils]pl2pm.PL
+
+[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) [.pod]pod2html.PL
+	Rename/Log [.pod]pod2html $@
+
+[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) [.pod]pod2latex.PL
+	Rename/Log [.pod]pod2latex $@
+
+[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) [.pod]pod2man.PL
+	Rename/Log [.pod]pod2man $@
+
+[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) [.pod]pod2text.PL
+	Rename/Log [.pod]pod2text $@
+
+preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM)
+	@ Write sys$$Output "Autosplitting Perl library . . ."
+	@ Create/Directory [.lib.auto]
+	@ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm
+
+[.lib.pod]perl.pod : [.pod]perl.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perl.pod $@
+
+[.lib.pod]perlbook.pod : [.pod]perlbook.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlbook.pod $@
+
+[.lib.pod]perlbot.pod : [.pod]perlbot.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlbot.pod $@
+
+[.lib.pod]perlcall.pod : [.pod]perlcall.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlcall.pod $@
+
+[.lib.pod]perldata.pod : [.pod]perldata.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perldata.pod $@
+
+[.lib.pod]perldebug.pod : [.pod]perldebug.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perldebug.pod $@
+
+[.lib.pod]perldiag.pod : [.pod]perldiag.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perldiag.pod $@
+
+[.lib.pod]perldsc.pod : [.pod]perldsc.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perldsc.pod $@
+
+[.lib.pod]perlembed.pod : [.pod]perlembed.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlembed.pod $@
+
+[.lib.pod]perlform.pod : [.pod]perlform.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlform.pod $@
+
+[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlfunc.pod $@
+
+[.lib.pod]perlguts.pod : [.pod]perlguts.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlguts.pod $@
+
+[.lib.pod]perlipc.pod : [.pod]perlipc.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlipc.pod $@
+
+[.lib.pod]perllol.pod : [.pod]perllol.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perllol.pod $@
+
+[.lib.pod]perlmod.pod : [.pod]perlmod.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlmod.pod $@
+
+[.lib.pod]perlobj.pod : [.pod]perlobj.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlobj.pod $@
+
+[.lib.pod]perlop.pod : [.pod]perlop.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlop.pod $@
+
+[.lib.pod]perlovl.pod : [.pod]perlovl.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlovl.pod $@
+
+[.lib.pod]perlpod.pod : [.pod]perlpod.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlpod.pod $@
+
+[.lib.pod]perlre.pod : [.pod]perlre.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlre.pod $@
+
+[.lib.pod]perlref.pod : [.pod]perlref.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlref.pod $@
+
+[.lib.pod]perlrun.pod : [.pod]perlrun.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlrun.pod $@
+
+[.lib.pod]perlsec.pod : [.pod]perlsec.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlsec.pod $@
+
+[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlstyle.pod $@
+
+[.lib.pod]perlsub.pod : [.pod]perlsub.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlsub.pod $@
+
+[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlsyn.pod $@
+
+[.lib.pod]perltie.pod : [.pod]perltie.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perltie.pod $@
+
+[.lib.pod]perltoc.pod : [.pod]perltoc.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perltoc.pod $@
+
+[.lib.pod]perltrap.pod : [.pod]perltrap.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perltrap.pod $@
+
+[.lib.pod]perlvar.pod : [.pod]perlvar.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlvar.pod $@
+
+[.lib.pod]perlxs.pod : [.pod]perlxs.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlxs.pod $@
+
+[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.pod]perlxstut.pod $@
+
+[.lib.pod]perlvms.pod : [.vms]perlvms.pod
+	@ If f$$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log [.vms]perlvms.pod $@
+
+printconfig :
+	@ $$@[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS)
+	@ $$@[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)"
+
+
+# The following three header files are generated automatically
+#	keywords.h :	keywords.pl
+#	opcode.h :	opcode.pl
+#	embed.h :	embed.pl global.sym interp.sym
+# The correct versions should be already supplied with the perl kit,
+# in case you don't have perl available.
+# To force them to run, type
+#	MMS regen_headers
+regen_headers :
+	$(INSTPERL) keywords.pl
+	$(INSTPERL) opcode.pl
+	$(INSTPERL) embed.pl
+
+# VMS uses modified perly.[ch] with tags for globaldefs if using DEC compiler
+perly.c : [.vms]perly_c.vms
+	Copy/Log [.vms]perly_c.vms $@
+perly.h : [.vms]perly_h.vms
+	Copy/Log [.vms]perly_h.vms $@
+
+# I now supply perly.c with the kits, so the following section is
+# commented out if you don't have byacc.
+# Altered for VMS by Charles Bailey  bailey@genetics.upenn.edu
+# perly.c:
+# 	@ Write Sys$Output "Expect 80 shift/reduce and 62 reduce/reduce conflicts"
+# 	\$(BYACC) -d perly.y
+# Has to be done by hand or by POSIX shell under VMS
+# 	sh \$(shellflags) ./perly.fixer y.tab.c perly.c
+# 	rename y.tab.h perly.h
+# 	$(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms
+
+perly$(O) : perly.c, perly.h, $(h)
+	$(CC) $(CFLAGS) perly.c
+
+test : all
+	- @[.VMS]Test.Com
+
+# CORE subset for MakeMaker, so we can build Perl without sources
+# Should move to VMS installperl when we get one
+$(ARCHCORE)EXTERN.h : EXTERN.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log EXTERN.h $@
+$(ARCHCORE)INTERN.h : INTERN.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log INTERN.h $@
+$(ARCHCORE)XSUB.h : XSUB.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log XSUB.h $@
+$(ARCHCORE)av.h : av.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log av.h $@
+$(ARCHCORE)config.h : config.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log config.h $@
+$(ARCHCORE)cop.h : cop.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log cop.h $@
+$(ARCHCORE)cv.h : cv.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log cv.h $@
+$(ARCHCORE)embed.h : embed.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log embed.h $@
+$(ARCHCORE)form.h : form.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log form.h $@
+$(ARCHCORE)gv.h : gv.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log gv.h $@
+$(ARCHCORE)handy.h : handy.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log handy.h $@
+$(ARCHCORE)hv.h : hv.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log hv.h $@
+$(ARCHCORE)keywords.h : keywords.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log keywords.h $@
+$(ARCHCORE)mg.h : mg.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log mg.h $@
+$(ARCHCORE)op.h : op.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log op.h $@
+$(ARCHCORE)opcode.h : opcode.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log opcode.h $@
+$(ARCHCORE)patchlevel.h : patchlevel.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log patchlevel.h $@
+$(ARCHCORE)perl.h : perl.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log perl.h $@
+$(ARCHCORE)perly.h : perly.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log perly.h $@
+$(ARCHCORE)pp.h : pp.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log pp.h $@
+$(ARCHCORE)proto.h : proto.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log proto.h $@
+$(ARCHCORE)regcomp.h : regcomp.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log regcomp.h $@
+$(ARCHCORE)regexp.h : regexp.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log regexp.h $@
+$(ARCHCORE)scope.h : scope.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log scope.h $@
+$(ARCHCORE)sv.h : sv.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log sv.h $@
+$(ARCHCORE)util.h : util.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log util.h $@
+$(ARCHCORE)vmsish.h : vmsish.h
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log vmsish.h $@
+$(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(DBG)libperl$(OLB) $@
+$(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log perlshr_attr.opt $@
+$(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts
+	@ If f$$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(DBG)perlshr_bld.opt $@
+$(ARCHAUTO)time.stamp :
+	@ If f$$Search("$(ARCHDIR)auto.dir").eqs."" Then Create/Directory $(ARCHAUTO)
+	@ If f$$Search("$@").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET)
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+av$(O) : EXTERN.h
+av$(O) : av.c
+av$(O) : av.h
+av$(O) : config.h
+av$(O) : cop.h
+av$(O) : cv.h
+av$(O) : embed.h
+av$(O) : form.h
+av$(O) : gv.h
+av$(O) : handy.h
+av$(O) : hv.h
+av$(O) : mg.h
+av$(O) : op.h
+av$(O) : opcode.h
+av$(O) : perl.h
+av$(O) : perly.h
+av$(O) : pp.h
+av$(O) : proto.h
+av$(O) : regexp.h
+av$(O) : scope.h
+av$(O) : sv.h
+av$(O) : vmsish.h
+av$(O) : util.h
+scope$(O) : EXTERN.h
+scope$(O) : av.h
+scope$(O) : config.h
+scope$(O) : cop.h
+scope$(O) : cv.h
+scope$(O) : embed.h
+scope$(O) : form.h
+scope$(O) : gv.h
+scope$(O) : handy.h
+scope$(O) : hv.h
+scope$(O) : mg.h
+scope$(O) : op.h
+scope$(O) : opcode.h
+scope$(O) : perl.h
+scope$(O) : perly.h
+scope$(O) : pp.h
+scope$(O) : proto.h
+scope$(O) : regexp.h
+scope$(O) : scope.c
+scope$(O) : scope.h
+scope$(O) : sv.h
+scope$(O) : vmsish.h
+scope$(O) : util.h
+op$(O) : EXTERN.h
+op$(O) : av.h
+op$(O) : config.h
+op$(O) : cop.h
+op$(O) : cv.h
+op$(O) : embed.h
+op$(O) : form.h
+op$(O) : gv.h
+op$(O) : handy.h
+op$(O) : hv.h
+op$(O) : mg.h
+op$(O) : op.c
+op$(O) : op.h
+op$(O) : opcode.h
+op$(O) : perl.h
+op$(O) : perly.h
+op$(O) : pp.h
+op$(O) : proto.h
+op$(O) : regexp.h
+op$(O) : scope.h
+op$(O) : sv.h
+op$(O) : vmsish.h
+op$(O) : util.h
+doop$(O) : EXTERN.h
+doop$(O) : av.h
+doop$(O) : config.h
+doop$(O) : cop.h
+doop$(O) : cv.h
+doop$(O) : doop.c
+doop$(O) : embed.h
+doop$(O) : form.h
+doop$(O) : gv.h
+doop$(O) : handy.h
+doop$(O) : hv.h
+doop$(O) : mg.h
+doop$(O) : op.h
+doop$(O) : opcode.h
+doop$(O) : perl.h
+doop$(O) : perly.h
+doop$(O) : pp.h
+doop$(O) : proto.h
+doop$(O) : regexp.h
+doop$(O) : scope.h
+doop$(O) : sv.h
+doop$(O) : vmsish.h
+doop$(O) : util.h
+doio$(O) : EXTERN.h
+doio$(O) : av.h
+doio$(O) : config.h
+doio$(O) : cop.h
+doio$(O) : cv.h
+doio$(O) : doio.c
+doio$(O) : embed.h
+doio$(O) : form.h
+doio$(O) : gv.h
+doio$(O) : handy.h
+doio$(O) : hv.h
+doio$(O) : mg.h
+doio$(O) : op.h
+doio$(O) : opcode.h
+doio$(O) : perl.h
+doio$(O) : perly.h
+doio$(O) : pp.h
+doio$(O) : proto.h
+doio$(O) : regexp.h
+doio$(O) : scope.h
+doio$(O) : sv.h
+doio$(O) : vmsish.h
+doio$(O) : util.h
+dump$(O) : EXTERN.h
+dump$(O) : av.h
+dump$(O) : config.h
+dump$(O) : cop.h
+dump$(O) : cv.h
+dump$(O) : dump.c
+dump$(O) : embed.h
+dump$(O) : form.h
+dump$(O) : gv.h
+dump$(O) : handy.h
+dump$(O) : hv.h
+dump$(O) : mg.h
+dump$(O) : op.h
+dump$(O) : opcode.h
+dump$(O) : perl.h
+dump$(O) : perly.h
+dump$(O) : pp.h
+dump$(O) : proto.h
+dump$(O) : regexp.h
+dump$(O) : scope.h
+dump$(O) : sv.h
+dump$(O) : vmsish.h
+dump$(O) : util.h
+hv$(O) : EXTERN.h
+hv$(O) : av.h
+hv$(O) : config.h
+hv$(O) : cop.h
+hv$(O) : cv.h
+hv$(O) : embed.h
+hv$(O) : form.h
+hv$(O) : gv.h
+hv$(O) : handy.h
+hv$(O) : hv.c
+hv$(O) : hv.h
+hv$(O) : mg.h
+hv$(O) : op.h
+hv$(O) : opcode.h
+hv$(O) : perl.h
+hv$(O) : perly.h
+hv$(O) : pp.h
+hv$(O) : proto.h
+hv$(O) : regexp.h
+hv$(O) : scope.h
+hv$(O) : sv.h
+hv$(O) : vmsish.h
+hv$(O) : util.h
+mg$(O) : EXTERN.h
+mg$(O) : av.h
+mg$(O) : config.h
+mg$(O) : cop.h
+mg$(O) : cv.h
+mg$(O) : embed.h
+mg$(O) : form.h
+mg$(O) : gv.h
+mg$(O) : handy.h
+mg$(O) : hv.h
+mg$(O) : mg.c
+mg$(O) : mg.h
+mg$(O) : op.h
+mg$(O) : opcode.h
+mg$(O) : perl.h
+mg$(O) : perly.h
+mg$(O) : pp.h
+mg$(O) : proto.h
+mg$(O) : regexp.h
+mg$(O) : scope.h
+mg$(O) : sv.h
+mg$(O) : vmsish.h
+mg$(O) : util.h
+perl$(O) : EXTERN.h
+perl$(O) : av.h
+perl$(O) : config.h
+perl$(O) : cop.h
+perl$(O) : cv.h
+perl$(O) : embed.h
+perl$(O) : form.h
+perl$(O) : gv.h
+perl$(O) : handy.h
+perl$(O) : hv.h
+perl$(O) : mg.h
+perl$(O) : op.h
+perl$(O) : opcode.h
+perl$(O) : perl.c
+perl$(O) : perl.h
+perl$(O) : perly.h
+perl$(O) : pp.h
+perl$(O) : proto.h
+perl$(O) : regexp.h
+perl$(O) : scope.h
+perl$(O) : sv.h
+perl$(O) : vmsish.h
+perl$(O) : util.h
+perly$(O) : EXTERN.h
+perly$(O) : av.h
+perly$(O) : config.h
+perly$(O) : cop.h
+perly$(O) : cv.h
+perly$(O) : embed.h
+perly$(O) : form.h
+perly$(O) : gv.h
+perly$(O) : handy.h
+perly$(O) : hv.h
+perly$(O) : mg.h
+perly$(O) : op.h
+perly$(O) : opcode.h
+perly$(O) : perl.h
+perly$(O) : perly.h
+perly$(O) : perly.c
+perly$(O) : pp.h
+perly$(O) : proto.h
+perly$(O) : regexp.h
+perly$(O) : scope.h
+perly$(O) : sv.h
+perly$(O) : vmsish.h
+perly$(O) : util.h
+pp$(O) : EXTERN.h
+pp$(O) : av.h
+pp$(O) : config.h
+pp$(O) : cop.h
+pp$(O) : cv.h
+pp$(O) : embed.h
+pp$(O) : form.h
+pp$(O) : gv.h
+pp$(O) : handy.h
+pp$(O) : hv.h
+pp$(O) : mg.h
+pp$(O) : op.h
+pp$(O) : opcode.h
+pp$(O) : perl.h
+pp$(O) : perly.h
+pp$(O) : pp.c
+pp$(O) : pp.h
+pp$(O) : proto.h
+pp$(O) : regexp.h
+pp$(O) : scope.h
+pp$(O) : sv.h
+pp$(O) : vmsish.h
+pp$(O) : util.h
+pp_ctl$(O) : EXTERN.h
+pp_ctl$(O) : av.h
+pp_ctl$(O) : config.h
+pp_ctl$(O) : cop.h
+pp_ctl$(O) : cv.h
+pp_ctl$(O) : embed.h
+pp_ctl$(O) : form.h
+pp_ctl$(O) : gv.h
+pp_ctl$(O) : handy.h
+pp_ctl$(O) : hv.h
+pp_ctl$(O) : mg.h
+pp_ctl$(O) : op.h
+pp_ctl$(O) : opcode.h
+pp_ctl$(O) : perl.h
+pp_ctl$(O) : perly.h
+pp_ctl$(O) : pp_ctl.c
+pp_ctl$(O) : pp.h
+pp_ctl$(O) : proto.h
+pp_ctl$(O) : regexp.h
+pp_ctl$(O) : scope.h
+pp_ctl$(O) : sv.h
+pp_ctl$(O) : vmsish.h
+pp_ctl$(O) : util.h
+pp_hot$(O) : EXTERN.h
+pp_hot$(O) : av.h
+pp_hot$(O) : config.h
+pp_hot$(O) : cop.h
+pp_hot$(O) : cv.h
+pp_hot$(O) : embed.h
+pp_hot$(O) : form.h
+pp_hot$(O) : gv.h
+pp_hot$(O) : handy.h
+pp_hot$(O) : hv.h
+pp_hot$(O) : mg.h
+pp_hot$(O) : op.h
+pp_hot$(O) : opcode.h
+pp_hot$(O) : perl.h
+pp_hot$(O) : perly.h
+pp_hot$(O) : pp_hot.c
+pp_hot$(O) : pp.h
+pp_hot$(O) : proto.h
+pp_hot$(O) : regexp.h
+pp_hot$(O) : scope.h
+pp_hot$(O) : sv.h
+pp_hot$(O) : vmsish.h
+pp_hot$(O) : util.h
+pp_sys$(O) : EXTERN.h
+pp_sys$(O) : av.h
+pp_sys$(O) : config.h
+pp_sys$(O) : cop.h
+pp_sys$(O) : cv.h
+pp_sys$(O) : embed.h
+pp_sys$(O) : form.h
+pp_sys$(O) : gv.h
+pp_sys$(O) : handy.h
+pp_sys$(O) : hv.h
+pp_sys$(O) : mg.h
+pp_sys$(O) : op.h
+pp_sys$(O) : opcode.h
+pp_sys$(O) : perl.h
+pp_sys$(O) : perly.h
+pp_sys$(O) : pp_sys.c
+pp_sys$(O) : pp.h
+pp_sys$(O) : proto.h
+pp_sys$(O) : regexp.h
+pp_sys$(O) : scope.h
+pp_sys$(O) : sv.h
+pp_sys$(O) : vmsish.h
+pp_sys$(O) : util.h
+regcomp$(O) : EXTERN.h
+regcomp$(O) : INTERN.h
+regcomp$(O) : av.h
+regcomp$(O) : config.h
+regcomp$(O) : cop.h
+regcomp$(O) : cv.h
+regcomp$(O) : embed.h
+regcomp$(O) : form.h
+regcomp$(O) : gv.h
+regcomp$(O) : handy.h
+regcomp$(O) : hv.h
+regcomp$(O) : mg.h
+regcomp$(O) : op.h
+regcomp$(O) : opcode.h
+regcomp$(O) : perl.h
+regcomp$(O) : perly.h
+regcomp$(O) : pp.h
+regcomp$(O) : proto.h
+regcomp$(O) : regcomp.c
+regcomp$(O) : regcomp.h
+regcomp$(O) : regexp.h
+regcomp$(O) : scope.h
+regcomp$(O) : sv.h
+regcomp$(O) : vmsish.h
+regcomp$(O) : util.h
+regexec$(O) : EXTERN.h
+regexec$(O) : av.h
+regexec$(O) : config.h
+regexec$(O) : cop.h
+regexec$(O) : cv.h
+regexec$(O) : embed.h
+regexec$(O) : form.h
+regexec$(O) : gv.h
+regexec$(O) : handy.h
+regexec$(O) : hv.h
+regexec$(O) : mg.h
+regexec$(O) : op.h
+regexec$(O) : opcode.h
+regexec$(O) : perl.h
+regexec$(O) : perly.h
+regexec$(O) : pp.h
+regexec$(O) : proto.h
+regexec$(O) : regcomp.h
+regexec$(O) : regexec.c
+regexec$(O) : regexp.h
+regexec$(O) : scope.h
+regexec$(O) : sv.h
+regexec$(O) : vmsish.h
+regexec$(O) : util.h
+gv$(O) : EXTERN.h
+gv$(O) : av.h
+gv$(O) : config.h
+gv$(O) : cop.h
+gv$(O) : cv.h
+gv$(O) : embed.h
+gv$(O) : form.h
+gv$(O) : gv.c
+gv$(O) : gv.h
+gv$(O) : handy.h
+gv$(O) : hv.h
+gv$(O) : mg.h
+gv$(O) : op.h
+gv$(O) : opcode.h
+gv$(O) : perl.h
+gv$(O) : perly.h
+gv$(O) : pp.h
+gv$(O) : proto.h
+gv$(O) : regexp.h
+gv$(O) : scope.h
+gv$(O) : sv.h
+gv$(O) : vmsish.h
+gv$(O) : util.h
+sv$(O) : EXTERN.h
+sv$(O) : av.h
+sv$(O) : config.h
+sv$(O) : cop.h
+sv$(O) : cv.h
+sv$(O) : embed.h
+sv$(O) : form.h
+sv$(O) : gv.h
+sv$(O) : handy.h
+sv$(O) : hv.h
+sv$(O) : mg.h
+sv$(O) : op.h
+sv$(O) : opcode.h
+sv$(O) : perl.h
+sv$(O) : perly.h
+sv$(O) : pp.h
+sv$(O) : proto.h
+sv$(O) : regexp.h
+sv$(O) : scope.h
+sv$(O) : sv.c
+sv$(O) : sv.h
+sv$(O) : vmsish.h
+sv$(O) : util.h
+taint$(O) : EXTERN.h
+taint$(O) : av.h
+taint$(O) : config.h
+taint$(O) : cop.h
+taint$(O) : cv.h
+taint$(O) : embed.h
+taint$(O) : form.h
+taint$(O) : gv.h
+taint$(O) : handy.h
+taint$(O) : hv.h
+taint$(O) : mg.h
+taint$(O) : op.h
+taint$(O) : opcode.h
+taint$(O) : perl.h
+taint$(O) : perly.h
+taint$(O) : pp.h
+taint$(O) : proto.h
+taint$(O) : regexp.h
+taint$(O) : scope.h
+taint$(O) : sv.h
+taint$(O) : taint.c
+taint$(O) : vmsish.h
+taint$(O) : util.h
+toke$(O) : EXTERN.h
+toke$(O) : av.h
+toke$(O) : config.h
+toke$(O) : cop.h
+toke$(O) : cv.h
+toke$(O) : embed.h
+toke$(O) : form.h
+toke$(O) : gv.h
+toke$(O) : handy.h
+toke$(O) : hv.h
+toke$(O) : keywords.h
+toke$(O) : mg.h
+toke$(O) : op.h
+toke$(O) : opcode.h
+toke$(O) : perl.h
+toke$(O) : perly.h
+toke$(O) : pp.h
+toke$(O) : proto.h
+toke$(O) : regexp.h
+toke$(O) : scope.h
+toke$(O) : sv.h
+toke$(O) : toke.c
+toke$(O) : vmsish.h
+toke$(O) : util.h
+util$(O) : EXTERN.h
+util$(O) : av.h
+util$(O) : config.h
+util$(O) : cop.h
+util$(O) : cv.h
+util$(O) : embed.h
+util$(O) : form.h
+util$(O) : gv.h
+util$(O) : handy.h
+util$(O) : hv.h
+util$(O) : mg.h
+util$(O) : op.h
+util$(O) : opcode.h
+util$(O) : perl.h
+util$(O) : perly.h
+util$(O) : pp.h
+util$(O) : proto.h
+util$(O) : regexp.h
+util$(O) : scope.h
+util$(O) : sv.h
+util$(O) : vmsish.h
+util$(O) : util.c
+util$(O) : util.h
+deb$(O) : EXTERN.h
+deb$(O) : av.h
+deb$(O) : config.h
+deb$(O) : cop.h
+deb$(O) : cv.h
+deb$(O) : deb.c
+deb$(O) : embed.h
+deb$(O) : form.h
+deb$(O) : gv.h
+deb$(O) : handy.h
+deb$(O) : hv.h
+deb$(O) : mg.h
+deb$(O) : op.h
+deb$(O) : opcode.h
+deb$(O) : perl.h
+deb$(O) : perly.h
+deb$(O) : pp.h
+deb$(O) : proto.h
+deb$(O) : regexp.h
+deb$(O) : scope.h
+deb$(O) : sv.h
+deb$(O) : vmsish.h
+deb$(O) : util.h
+run$(O) : EXTERN.h
+run$(O) : av.h
+run$(O) : config.h
+run$(O) : cop.h
+run$(O) : cv.h
+run$(O) : embed.h
+run$(O) : form.h
+run$(O) : gv.h
+run$(O) : handy.h
+run$(O) : hv.h
+run$(O) : mg.h
+run$(O) : op.h
+run$(O) : opcode.h
+run$(O) : perl.h
+run$(O) : perly.h
+run$(O) : pp.h
+run$(O) : proto.h
+run$(O) : regexp.h
+run$(O) : run.c
+run$(O) : scope.h
+run$(O) : sv.h
+run$(O) : vmsish.h
+run$(O) : util.h
+vms$(O) : EXTERN.h
+vms$(O) : av.h
+vms$(O) : config.h
+vms$(O) : cop.h
+vms$(O) : cv.h
+vms$(O) : embed.h
+vms$(O) : form.h
+vms$(O) : gv.h
+vms$(O) : handy.h
+vms$(O) : hv.h
+vms$(O) : mg.h
+vms$(O) : op.h
+vms$(O) : opcode.h
+vms$(O) : perl.h
+vms$(O) : perly.h
+vms$(O) : pp.h
+vms$(O) : proto.h
+vms$(O) : regexp.h
+vms$(O) : vms.c
+vms$(O) : scope.h
+vms$(O) : sv.h
+vms$(O) : vmsish.h
+vms$(O) : util.h
+miniperlmain$(O) : EXTERN.h
+miniperlmain$(O) : av.h
+miniperlmain$(O) : config.h
+miniperlmain$(O) : cop.h
+miniperlmain$(O) : cv.h
+miniperlmain$(O) : embed.h
+miniperlmain$(O) : form.h
+miniperlmain$(O) : gv.h
+miniperlmain$(O) : handy.h
+miniperlmain$(O) : hv.h
+miniperlmain$(O) : mg.h
+miniperlmain$(O) : miniperlmain.c
+miniperlmain$(O) : op.h
+miniperlmain$(O) : opcode.h
+miniperlmain$(O) : perl.h
+miniperlmain$(O) : perly.h
+miniperlmain$(O) : pp.h
+miniperlmain$(O) : proto.h
+miniperlmain$(O) : regexp.h
+miniperlmain$(O) : scope.h
+miniperlmain$(O) : sv.h
+miniperlmain$(O) : vmsish.h
+miniperlmain$(O) : util.h
+perlmain$(O) : EXTERN.h
+perlmain$(O) : av.h
+perlmain$(O) : config.h
+perlmain$(O) : cop.h
+perlmain$(O) : cv.h
+perlmain$(O) : embed.h
+perlmain$(O) : form.h
+perlmain$(O) : gv.h
+perlmain$(O) : handy.h
+perlmain$(O) : hv.h
+perlmain$(O) : mg.h
+perlmain$(O) : op.h
+perlmain$(O) : opcode.h
+perlmain$(O) : perl.h
+perlmain$(O) : perly.h
+perlmain$(O) : perlmain.c
+perlmain$(O) : pp.h
+perlmain$(O) : proto.h
+perlmain$(O) : regexp.h
+perlmain$(O) : scope.h
+perlmain$(O) : sv.h
+perlmain$(O) : vmsish.h
+perlmain$(O) : util.h
+globals$(O) : INTERN.h
+globals$(O) : av.h
+globals$(O) : config.h
+globals$(O) : cop.h
+globals$(O) : cv.h
+globals$(O) : embed.h
+globals$(O) : form.h
+globals$(O) : gv.h
+globals$(O) : handy.h
+globals$(O) : hv.h
+globals$(O) : mg.h
+globals$(O) : op.h
+globals$(O) : opcode.h
+globals$(O) : perl.h
+globals$(O) : perly.h
+globals$(O) : globals.c
+globals$(O) : pp.h
+globals$(O) : proto.h
+globals$(O) : regexp.h
+globals$(O) : scope.h
+globals$(O) : sv.h
+globals$(O) : vmsish.h
+globals$(O) : util.h
+
+config.h : [.vms]config.vms
+	Copy/Log/NoConfirm [.vms]config.vms []config.h
+
+vmsish.h : [.vms]vmsish.h
+	Copy/Log/NoConfirm [.vms]vmsish.h []vmsish.h
+
+vms.c : [.vms]vms.c
+	Copy/Log/Noconfirm [.vms]vms.c []
+
+$(CRTL) : $(MAKEFILE)
+	@ $$@[.vms]genopt "$(CRTL)/Write" "|" "$(LIBS1)|$(LIBS2)|$(SOCKLIB)"
+
+
+cleanlis :
+	- If f$$Search("*.Lis").nes."" Then Delete/NoConfirm/Log *.Lis;*
+	- If f$$Search("*.CPP").nes."" Then Delete/NoConfirm/Log *.CPP;*
+	- If f$$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;*
+
+tidy : cleanlis
+	- If f$$Search("*.Opt;-1").nes."" Then Purge/NoConfirm/Log *.Opt
+	- If f$$Search("*$(O);-1").nes."" Then Purge/NoConfirm/Log *$(O)
+	- If f$$Search("*$(E);-1").nes."" Then Purge/NoConfirm/Log *$(E)
+	- If f$$Search("Config.H;-1").nes."" Then Purge/NoConfirm/Log Config.H
+	- If f$$Search("Config.SH;-1").nes."" Then Purge/NoConfirm/Log Config.SH
+	- If f$$Search("perly.c;-1").nes."" Then Purge/NoConfirm/Log perly.c
+	- If f$$Search("perly.h;-1").nes."" Then Purge/NoConfirm/Log perly.h
+	- If f$$Search("VMSish.H;-1").nes."" Then Purge/NoConfirm/Log VMSish.H
+	- If f$$Search("VMS.C;-1")   .nes."" Then Purge/NoConfirm/Log VMS.C
+	- If f$$Search("Perlmain.C;-1")   .nes."" Then Purge/NoConfirm/Log Perlmain.C
+	- If f$$Search("Perlshr_Gbl*.Mar;-1")   .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar
+	- If f$$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O)
+	- If f$$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C
+	- If f$$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe]
+	- If f$$Search("[.Ext.FileHandle...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.FileHandle]
+	- If f$$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C
+	- If f$$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O)
+	- If f$$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al
+	- If f$$Search("[.Lib.Auto...]autosplit.ix;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ix
+	- If f$$Search("[.Lib]DynaLoader.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]DynaLoader.pm
+	- If f$$Search("[.Lib]Socket.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Socket.pm
+	- If f$$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm
+	- If f$$Search("$(ARCHDIR)Config.pm;-1").nes."" Then Purge/NoConfirm/Log $(ARCHDIR)Config.pm
+	- If f$$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.*
+	- If f$$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod
+	- If f$$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.*
+	- If f$$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*.
+	- If f$$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.
+
+clean : tidy
+	Set Default [.ext.Fcntl]
+	- $(MMS) clean
+	Set Default [--]
+	Set Default [.ext.FileHandle]
+	- $(MMS) clean
+	Set Default [--]
+	Set Default [.ext.Safe]
+	- $(MMS) clean
+	Set Default [--]
+	- If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
+	- If f$$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);*
+	- If f$$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
+	- If f$$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;*
+	- If f$$Search(f$$Parse("sys$$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);*
+	- If f$$Search(f$$Parse("sys$$Disk:[]","$(SOCKC)")).nes."" Then Delete/NoConfirm/Log $(SOCKC);*
+	- If f$$Search("perly.c").nes."" Then Delete/NoConfirm/Log perly.c;*
+	- If f$$Search("perly.h").nes."" Then Delete/NoConfirm/Log perly.h;*
+	- If f$$Search("VMSish.H").nes."" Then Delete/NoConfirm/Log VMSish.H;*
+	- If f$$Search("VMS.C")   .nes."" Then Delete/NoConfirm/Log VMS.C;*
+	- If f$$Search("Perlmain.C")   .nes."" Then Delete/NoConfirm/Log Perlmain.C;*
+	- If f$$Search("Perlshr_Gbl*.Mar")   .nes."" Then Delete/NoConfirm/Log Perlshr_Gbl*.Mar;*
+	- If f$$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;*
+	- If f$$Search("[.Ext.DynaLoader]DL_VMS$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O);*
+	- If f$$Search("[.Ext.DynaLoader]DL_VMS.C").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C;*
+	- If f$$Search("[.Ext.Socket]Socket$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket$(O);*
+	- If f$$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;*
+	- If f$$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;*
+	- If f$$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);*
+
+realclean : clean
+	Set Default [.ext.Fcntl]
+	- $(MMS) realclean
+	Set Default [--]
+	Set Default [.ext.FileHandle]
+	- $(MMS) realclean
+	Set Default [--]
+	Set Default [.ext.Safe]
+	- $(MMS) realclean
+	Set Default [--]
+	- If f$$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);*
+	- If f$$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
+	- $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);"
+	- If f$$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;*
+	- If f$$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;*
+	- If f$$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;*
+	- If f$$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;*
+	- If f$$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;*
+	- If f$$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*
+	- If f$$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;*
+	- If f$$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;*
+	- If f$$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;*
+	- If f$$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+
+cleansrc : clean
+	- If f$$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C
+	- If f$$Search("*.H;-1").nes."" Then Purge/NoConfirm/Log *.H
+	- If f$$Search("*.VMS;-1").nes."" Then Purge/NoConfirm/Log *.VMS
+	- If f$$Search("[.VMS]$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log [.VMS]$(MAKEFILE)
+	- If f$$Search("[.VMS]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.C
+	- If f$$Search("[.VMS]*.H;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.H
+	- If f$$Search("[.VMS]*.Pl;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.Pl
+	- If f$$Search("[.VMS]*.VMS;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.VMS
+	- If f$$Search("[.VMS...]*.pm;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.pm
+	- If f$$Search("[.VMS...]*.xs;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.xs
diff --git a/gnu/usr.bin/perl/vms/config.vms b/gnu/usr.bin/perl/vms/config.vms
new file mode 100644
index 00000000000..203e479016a
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/config.vms
@@ -0,0 +1,1647 @@
+/*
+ * This file was produced by hand because the configure utilities which
+ * are in the perl distribution are all shell scripts.  Someday, I hope
+ * we'll get a perl configure utility, but until then . . .
+ * 
+ * Feel free to add or change things to suit your needs, but be careful
+ * about moving the comments which say "config-skip" - they're used by
+ * GenConfig.pl when producing Config.pm.
+ *
+ * config.h for VMS
+ * Version: 5.002_01
+ */                 
+
+/* Configuration time: 22-Mar-1996 14:45
+ * Configured by: Charles Bailey  bailey@genetics.upenn.edu
+ * Target system: VMS
+ */
+
+#ifndef _config_h_
+#define _config_h_
+
+/* CAT2:
+ *	This macro catenates 2 tokens together.
+ */
+/* STRINGIFY:
+ *	This macro surrounds its token with double quotes.
+ */
+#ifdef __STDC__
+#define CAT2(a,b)a ## b
+#define CAT3(a,b,c)a ## b ## c
+#define CAT4(a,b,c,d)a ## b ## c ##d
+#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e
+#define StGiFy(a) # a
+#define STRINGIFY(A)StGiFy(a)
+#define SCAT2(a,b)StGiFy(a) StGiFy(b)
+#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c)
+#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d)
+#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e)
+#else
+#define CAT2(a,b)a/**/b
+#define CAT3(a,b,c)a/**/b/**/c
+#define CAT4(a,b,c,d)a/**/b/**/c/**/d
+#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e
+#define STRINGIFY(a)"a"
+#endif
+
+/* config-start */
+
+/* MEM_ALIGNBYTES:
+ *	This symbol contains the number of bytes required to align a
+ *	double. Usual values are 2, 4 and 8.
+ */
+#define MEM_ALIGNBYTES 8	/**/
+
+/* OSNAME:
+ *	This symbol contains the name of the operating system, as determined
+ *	by Configure.
+ */
+#define OSNAME "VMS"		/**/
+
+/* ARCHLIB_EXP:
+ *	This variable, if defined, holds the name of the directory in
+ *	which the user wants to put architecture-dependent public
+ *	library files for $package.  It is most often a local directory
+ *	such as /usr/local/lib.  Programs using this variable must be
+ *	prepared to deal with filename expansion.  If ARCHLIB_EXP is the
+ *	same as PRIVLIB_EXP, it is not defined, since presumably the
+ *	program already searches PRIVLIB_EXP.
+ */
+/*     ==> NOTE <==
+ * This value is automatically updated by FndVers.Com
+ * when Perl is built.  Please do not change it by hand; make
+ * any changes to FndVers.Com instead.
+ */
+#define ARCHLIB_EXP "/perl_root/lib/VMS_VAX/5_003"    /**/
+
+/* CPPSTDIN:
+ *	This symbol contains the first part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.	 Typical value of "cc -E" or "/lib/cpp", but it can also
+ *	call a wrapper. See CPPRUN.
+ */
+/* CPPMINUS:
+ *	This symbol contains the second part of the string which will invoke
+ *	the C preprocessor on the standard input and produce to standard
+ *	output.  This symbol will have the value "-" if CPPSTDIN needs a minus
+ *	to specify standard input, otherwise the value is "".
+ */
+#define CPPSTDIN "cc/noobj/preprocess=sys$output sys$input"
+#define CPPMINUS ""
+
+/* HAS_BCMP:
+ *	This symbol is defined if the bcmp() routine is available to
+ *	compare blocks of memory.
+ */
+#undef HAS_BCMP	/**/
+
+/* HAS_BCOPY:
+ *	This symbol is defined if the bcopy() routine is available to
+ *	copy blocks of memory.
+ */
+#undef HAS_BCOPY	/**/
+
+/* HAS_BZERO:
+ *	This symbol is defined if the bzero() routine is available to
+ *	set a memory block to 0.
+ */
+#undef HAS_BZERO	/**/
+
+/* CASTNEGFLOAT:
+ *	This symbol is defined if the C compiler can cast negative
+ *	numbers to unsigned longs, ints and shorts.
+ */
+/* CASTFLAGS:
+ *	This symbol contains flags that say what difficulties the compiler
+ *	has casting odd floating values to unsigned long:
+ *		0 = ok
+ *		1 = couldn't cast < 0
+ *		2 = couldn't cast >= 0x80000000
+ */
+#define	CASTNEGFLOAT		/**/
+#define CASTFLAGS 0		/**/
+
+/* HAS_CHSIZE:
+ *	This symbol, if defined, indicates that the chsize routine is available
+ *	to truncate files.  You might need a -lx to get this routine.
+ */
+#undef	HAS_CHSIZE		/**/
+
+/* HASCONST:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the const type. There is no need to actually test for that symbol
+ *	within your programs. The mere use of the "const" keyword will
+ *	trigger the necessary tests.
+ */
+#define HASCONST	/**/
+#ifndef HASCONST
+#define const
+#endif
+
+/* HAS_CRYPT:
+ *	This symbol, if defined, indicates that the crypt routine is available
+ *	to encrypt passwords and the like.
+ */
+#define HAS_CRYPT		/**/
+
+/* BYTEORDER:
+ *	This symbol hold the hexadecimal constant defined in byteorder,
+ *	i.e. 0x1234 or 0x4321, etc...
+ */
+#define BYTEORDER 0x1234	/* large digits for MSB */
+
+/* CSH:
+ *	This symbol, if defined, indicates that the C-shell exists.
+ *	If defined, contains the full pathname of csh.
+ */
+#undef CSH 		/**/
+
+/* HAS_DUP2:
+ *	This symbol, if defined, indicates that the dup2 routine is
+ *	available to duplicate file descriptors.
+ */
+#define HAS_DUP2	/**/
+
+/* HAS_FCHMOD:
+ *	This symbol, if defined, indicates that the fchmod routine is available
+ *	to change mode of opened files.  If unavailable, use chmod().
+ */
+#undef HAS_FCHMOD		/**/
+
+/* HAS_FCHOWN:
+ *	This symbol, if defined, indicates that the fchown routine is available
+ *	to change ownership of opened files.  If unavailable, use chown().
+ */
+#undef HAS_FCHOWN		/**/
+
+/* HAS_FCNTL:
+ *	This symbol, if defined, indicates to the C program that
+ *	the fcntl() function exists.
+ */
+#undef HAS_FCNTL		/**/
+
+/* HAS_FGETPOS:
+ *	This symbol, if defined, indicates that the fgetpos routine is
+ *	available to get the file position indicator, similar to ftell().
+ */
+#define HAS_FGETPOS	/**/
+
+/* FLEXFILENAMES:
+ *	This symbol, if defined, indicates that the system supports filenames
+ *	longer than 14 characters.
+ */
+#define	FLEXFILENAMES		/**/
+
+/* HAS_FLOCK:
+ *	This symbol, if defined, indicates that the flock routine is
+ *	available to do file locking.
+ */
+#undef HAS_FLOCK		/**/
+
+/* HAS_FSETPOS:
+ *	This symbol, if defined, indicates that the fsetpos routine is
+ *	available to set the file position indicator, similar to fseek().
+ */
+#define HAS_FSETPOS	/**/
+
+/* HAS_GETGROUPS:
+ *	This symbol, if defined, indicates that the getgroups() routine is
+ *	available to get the list of process groups.  If unavailable, multiple
+ *	groups are probably not supported.
+ */
+#undef HAS_GETGROUPS		/**/
+
+/* HAS_UNAME:
+ *	This symbol, if defined, indicates that the C program may use the
+ *	uname() routine to derive the host name.  See also HAS_GETHOSTNAME
+ *	and PHOSTNAME.
+ */
+#undef HAS_UNAME		/**/
+
+/* HAS_GETPGRP:
+ *	This symbol, if defined, indicates that the getpgrp routine is
+ *	available to get the current process group.
+ */
+#undef HAS_GETPGRP		/**/
+
+/* HAS_GETPGRP2:
+ *	This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ *	routine is available to get the current process group.
+ */
+#undef HAS_GETPGRP2		/**/
+
+/* HAS_GETPRIORITY:
+ *	This symbol, if defined, indicates that the getpriority routine is
+ *	available to get a process's priority.
+ */
+#undef HAS_GETPRIORITY		/**/
+
+/* HAS_KILLPG:
+ *	This symbol, if defined, indicates that the killpg routine is available
+ *	to kill process groups.  If unavailable, you probably should use kill
+ *	with a negative process number.
+ */
+#undef HAS_KILLPG	/**/
+
+/* HAS_LINK:
+ *	This symbol, if defined, indicates that the link routine is
+ *	available to create hard links.
+ */
+#undef HAS_LINK	/**/
+
+/* HAS_LSTAT:
+ *	This symbol, if defined, indicates that the lstat routine is
+ *	available to do file stats on symbolic links.
+ */
+#undef HAS_LSTAT		/**/
+
+/* HAS_LOCKF:
+ *	This symbol, if defined, indicates that the lockf routine is
+ *	available to do file locking.
+ */
+#undef HAS_LOCKF		/**/
+
+/* HAS_MBSTOWCS:
+ *	This symbol, if defined, indicates that the mbstowcs routine is
+ *	available to covert a multibyte string into a wide character string.
+ */
+#undef	HAS_MBSTOWCS		/**/
+
+/* HAS_MBTOWC:
+ *	This symbol, if defined, indicates that the mbtowc routine is available
+ *	to covert a multibyte to a wide character.
+ */
+#undef HAS_MBTOWC		/**/
+
+/* HAS_MEMCMP:
+ *	This symbol, if defined, indicates that the memcmp routine is available
+ *	to compare blocks of memory.
+ */
+#define HAS_MEMCMP	/**/
+
+/* HAS_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy blocks of memory.
+ */
+#define HAS_MEMCPY	/**/
+
+/* HAS_MEMMOVE:
+ *	This symbol, if defined, indicates that the memmove routine is available
+ *	to copy potentially overlapping blocks of memory. This should be used
+ *	only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
+ *	own version.
+ */
+#define HAS_MEMMOVE	/**/
+
+/* HAS_MEMSET:
+ *	This symbol, if defined, indicates that the memset routine is available
+ *	to set blocks of memory.
+ */
+#define HAS_MEMSET	/**/
+
+/* HAS_MKDIR:
+ *	This symbol, if defined, indicates that the mkdir routine is available
+ *	to create directories.  Otherwise you should fork off a new process to
+ *	exec /bin/mkdir.
+ */
+#define HAS_MKDIR		/**/
+
+/* HAS_MSG:
+ *	This symbol, if defined, indicates that the entire msg*(2) library is
+ *	supported (IPC mechanism based on message queues).
+ */
+#undef HAS_MSG		/**/
+
+/* HAS_OPEN3:
+ *	This manifest constant lets the C program know that the three
+ *	argument form of open(2) is available.
+ */
+#define HAS_OPEN3		/**/
+
+/* HAS_POLL:
+ *	This symbol, if defined, indicates that the poll routine is
+ *	available to poll active file descriptors.
+ */
+#undef HAS_POLL		/**/
+
+/* HAS_READDIR:
+ *	This symbol, if defined, indicates that the readdir routine is
+ *	available to read directory entries. You may have to include
+ *	<dirent.h>. See I_DIRENT.
+ */
+#define HAS_READDIR		/**/
+
+/* HAS_SEEKDIR:
+ *	This symbol, if defined, indicates that the seekdir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_SEEKDIR		/**/
+
+/* HAS_TELLDIR:
+ *	This symbol, if defined, indicates that the telldir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_TELLDIR		/**/
+
+/* HAS_REWINDDIR:
+ *	This symbol, if defined, indicates that the rewinddir routine is
+ *	available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+#define HAS_REWINDDIR		/**/
+
+/* HAS_RENAME:
+ *	This symbol, if defined, indicates that the rename routine is available
+ *	to rename files.  Otherwise you should do the unlink(), link(), unlink()
+ *	trick.
+ */
+#define HAS_RENAME	/**/
+
+/* HAS_RMDIR:
+ *	This symbol, if defined, indicates that the rmdir routine is
+ *	available to remove directories. Otherwise you should fork off a
+ *	new process to exec /bin/rmdir.
+ */
+#define HAS_RMDIR		/**/
+
+/* HAS_SEM:
+ *	This symbol, if defined, indicates that the entire sem*(2) library is
+ *	supported.
+ */
+#undef HAS_SEM		/**/
+
+/* HAS_SETEGID:
+ *	This symbol, if defined, indicates that the setegid routine is available
+ *	to change the effective gid of the current program.
+ */
+#undef HAS_SETEGID		/**/
+
+/* HAS_SETEUID:
+ *	This symbol, if defined, indicates that the seteuid routine is available
+ *	to change the effective uid of the current program.
+ */
+#undef HAS_SETEUID		/**/
+
+/* HAS_SETLOCALE:
+ *	This symbol, if defined, indicates that the setlocale routine is
+ *	available to handle locale-specific ctype implementations.
+ */
+#undef HAS_SETLOCALE	/**/
+
+/* HAS_SETPGID:
+ *	This symbol, if defined, indicates that the setpgid routine is
+ *	available to set process group ID.
+ */
+#undef HAS_SETPGID	/**/
+
+/* HAS_SETPGRP2:
+ *	This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ *	routine is available to set the current process group.
+ */
+#undef HAS_SETPGRP2		/**/
+
+/* HAS_SETPRIORITY:
+ *	This symbol, if defined, indicates that the setpriority routine is
+ *	available to set a process's priority.
+ */
+#undef HAS_SETPRIORITY		/**/
+
+/* HAS_SETREGID:
+ *	This symbol, if defined, indicates that the setregid routine is
+ *	available to change the real and effective gid of the current
+ *	process.
+ */
+/* HAS_SETRESGID:
+ *	This symbol, if defined, indicates that the setresgid routine is
+ *	available to change the real, effective and saved gid of the current
+ *	process.
+ */
+#undef HAS_SETREGID		/**/
+#undef HAS_SETRESGID		/**/
+
+/* HAS_SETREUID:
+ *	This symbol, if defined, indicates that the setreuid routine is
+ *	available to change the real and effective uid of the current
+ *	process.
+ */
+/* HAS_SETRESUID:
+ *	This symbol, if defined, indicates that the setresuid routine is
+ *	available to change the real, effective and saved uid of the current
+ *	process.
+ */
+#undef HAS_SETREUID		/**/
+#undef HAS_SETRESUID		/**/
+
+/* HAS_SETRGID:
+ *	This symbol, if defined, indicates that the setrgid routine is available
+ *	to change the real gid of the current program.
+ */
+#undef HAS_SETRGID		/**/
+
+/* HAS_SETRUID:
+ *	This symbol, if defined, indicates that the setruid routine is available
+ *	to change the real uid of the current program.
+ */
+#undef HAS_SETRUID		/**/
+
+/* HAS_SETSID:
+ *	This symbol, if defined, indicates that the setsid routine is
+ *	available to set the process group ID.
+ */
+#undef HAS_SETSID	/**/
+
+/* HAS_SHM:
+ *	This symbol, if defined, indicates that the entire shm*(2) library is
+ *	supported.
+ */
+#undef HAS_SHM		/**/
+
+/* Shmat_t:
+ *	This symbol holds the return type of the shmat() system call.
+ *	Usually set to 'void *' or 'char *'.
+ */
+/* HAS_SHMAT_PROTOTYPE:
+ *	This symbol, if defined, indicates that the sys/shm.h includes
+ *	a prototype for shmat().  Otherwise, it is up to the program to
+ *	guess one.  Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
+ *	but not always right so it should be emitted by the program only
+ *	when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+#undef Shmat_t 	/**/ /* config-skip */
+#undef HAS_SHMAT_PROTOTYPE	/**/
+
+/* HAS_SIGACTION:
+ *	This symbol, if defined, indicates that Vr4's sigaction() routine
+ *	is available.
+ */
+#undef HAS_SIGACTION	/**/
+
+/* USE_STAT_BLOCKS:
+ *	This symbol is defined if this system has a stat structure declaring
+ *	st_blksize and st_blocks.
+ */
+#undef USE_STAT_BLOCKS 	/**/
+
+/* USE_STDIO_PTR:
+ *	This symbol is defined if the _ptr and _cnt fields (or similar)
+ *	of the stdio FILE structure can be used to access the stdio buffer
+ *	for a file handle.  If this is defined, then the FILE_ptr(fp)
+ *	and FILE_cnt(fp) macros will also be defined and should be used
+ *	to access these fields.
+ */
+/* USE_STDIO_BASE:
+ *	This symbol is defined if the _base field (or similar) of the
+ *	stdio FILE structure can be used to access the stdio buffer for
+ *	a file handle.  If this is defined, then the FILE_base(fp) macro
+ *	will also be defined and should be used to access this field.
+ *	Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ *	to determine the number of bytes in the buffer.  USE_STDIO_BASE
+ *	will never be defined unless USE_STDIO_PTR is.
+ */
+/* VMS:
+ * Regular FILE * are pretty close to meeting these criteria, but socket
+ * I/O uses a summy FILE *, and Perl doesn't distinguish between socket
+ * and non-socket filehandles.
+ */
+#undef USE_STDIO_PTR 	/**/
+#undef USE_STDIO_BASE 	/**/
+
+/* FILE_ptr:
+ *	This macro is used to access the _ptr field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_PTR_LVALUE:
+ *	This symbol is defined if the FILE_ptr macro can be used as an
+ *	lvalue.
+ */
+/* FILE_cnt:
+ *	This macro is used to access the _cnt field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_PTR is defined.
+ */
+/* STDIO_CNT_LVALUE:
+ *	This symbol is defined if the FILE_cnt macro can be used as an
+ *	lvalue.
+ */
+#undef FILE_ptr
+#undef STDIO_PTR_LVALUE
+#undef FILE_cnt
+#undef STDIO_CNT_LVALUE
+
+/* FILE_base:
+ *	This macro is used to access the _base field (or equivalent) of the
+ *	FILE structure pointed to by its argument. This macro will always be
+ *	defined if USE_STDIO_BASE is defined.
+ */
+/* FILE_bufsiz:
+ *	This macro is used to determine the number of bytes in the I/O
+ *	buffer pointed to by _base field (or equivalent) of the FILE
+ *	structure pointed to its argument. This macro will always be defined
+ *	if USE_STDIO_BASE is defined.
+ */
+#undef FILE_base
+#undef FILE_bufsiz
+
+/* USE_STRUCT_COPY:
+ *	This symbol, if defined, indicates that this C compiler knows how
+ *	to copy structures.  If undefined, you'll need to use a block copy
+ *	routine of some sort instead.
+ */
+#define	USE_STRUCT_COPY	/**/
+
+/* HAS_STRERROR:
+ *	This symbol, if defined, indicates that the strerror routine is
+ *	available to translate error numbers to strings. See the writeup
+ *	of Strerror() in this file before you try to define your own.
+ */
+/* HAS_SYS_ERRLIST:
+ *	This symbol, if defined, indicates that the sys_errlist array is
+ *	available to translate error numbers to strings. The extern int
+ *	sys_nerr gives the size of that table.
+ */
+/* Strerror:
+ *	This preprocessor symbol is defined as a macro if strerror() is
+ *	not available to translate error numbers to strings but sys_errlist[]
+ *	array is there.
+ */
+#define HAS_STRERROR		/**/
+#undef HAS_SYS_ERRLIST	/**/
+#ifdef HAS_STRERROR
+#  define Strerror(e) strerror((e),vaxc$errno)
+#else
+#define Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ /* config-skip */
+#endif
+
+/* HAS_SYMLINK:
+ *	This symbol, if defined, indicates that the symlink routine is available
+ *	to create symbolic links.
+ */
+#undef HAS_SYMLINK	/**/
+
+/* HAS_SYSCALL:
+ *	This symbol, if defined, indicates that the syscall routine is
+ *	available to call arbitrary system calls. If undefined, that's tough.
+ */
+#undef HAS_SYSCALL	/**/
+
+/* HAS_SYSTEM:
+ *	This symbol, if defined, indicates that the system routine is
+ *	available to issue a shell command.
+ */
+#define HAS_SYSTEM	/**/
+
+/* Time_t:
+ *	This symbol holds the type returned by time(). It can be long,
+ *	or time_t on BSD sites (in which case <sys/types.h> should be
+ *	included).
+ */
+#define Time_t time_t		/* Time type */
+
+/* HAS_TRUNCATE:
+ *	This symbol, if defined, indicates that the truncate routine is
+ *	available to truncate files.
+ */
+#undef HAS_TRUNCATE	/**/
+
+
+/* HAS_VFORK:
+ *	This symbol, if defined, indicates that vfork() exists.
+ */
+#define HAS_VFORK	/**/
+
+/* Signal_t:
+ *	This symbol's value is either "void" or "int", corresponding to the
+ *	appropriate return type of a signal handler.  Thus, you can declare
+ *	a signal handler using "Signal_t (*handler)()", and define the
+ *	handler using "Signal_t handler(sig)".
+ */
+#define Signal_t void	/* Signal handler's return type */
+
+/* HASVOLATILE:
+ *	This symbol, if defined, indicates that this C compiler knows about
+ *	the volatile declaration.
+ */
+#define	HASVOLATILE	/**/
+#ifndef HASVOLATILE
+#define volatile /* config-skip */
+#endif
+
+/* HAS_VPRINTF:
+ *	This symbol, if defined, indicates that the vprintf routine is available
+ *	to printf with a pointer to an argument list.  If unavailable, you
+ *	may need to write your own, probably in terms of _doprnt().
+ */
+/* USE_CHAR_VSPRINTF:
+ *	This symbol is defined if this system has vsprintf() returning type
+ *	(char*).  The trend seems to be to declare it as "int vsprintf()".  It
+ *	is up to the package author to declare vsprintf correctly based on the
+ *	symbol.
+ */
+#define HAS_VPRINTF	/**/
+#undef USE_CHAR_VSPRINTF 	/**/
+
+/* HAS_WAIT4:
+ *	This symbol, if defined, indicates that wait4() exists.
+ */
+#undef HAS_WAIT4	/**/
+
+/* HAS_WAITPID:
+ *	This symbol, if defined, indicates that the waitpid routine is
+ *	available to wait for child process.
+ */
+#define HAS_WAITPID	/**/
+
+/* HAS_WCSTOMBS:
+ *	This symbol, if defined, indicates that the wcstombs routine is
+ *	available to convert wide character strings to multibyte strings.
+ */
+#undef HAS_WCSTOMBS	/**/
+
+/* I_DIRENT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <dirent.h>. Using this symbol also triggers the definition
+ *	of the Direntry_t define which ends up being 'struct dirent' or
+ *	'struct direct' depending on the availability of <dirent.h>.
+ */
+/* DIRNAMLEN:
+ *	This symbol, if defined, indicates to the C program that the length
+ *	of directory entry names is provided by a d_namlen field.  Otherwise
+ *	you need to do strlen() on the d_name field.
+ */
+#undef I_DIRENT		/**/
+#define DIRNAMLEN	/**/
+#define Direntry_t struct dirent
+
+/* I_FCNTL:
+ *	This manifest constant tells the C program to include <fcntl.h>.
+ */
+#undef I_FCNTL	/**/
+
+/* I_GRP:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <grp.h>.
+ */
+#undef I_GRP		/**/
+
+/* I_LIMITS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <limits.h> to get definition of symbols like WORD_BIT or
+ *	LONG_MAX, i.e. machine dependant limitations.
+ */
+#undef I_LIMITS		/**/
+
+/* I_MEMORY:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <memory.h>.
+ */
+#undef I_MEMORY		/**/
+
+/* I_NDBM:
+ *	This symbol, if defined, indicates that ndbm.h exists and should
+ *	be included.
+ */
+#undef I_NDBM	/**/
+
+/* I_STDARG:
+ *	This symbol, if defined, indicates that <stdarg.h> exists and should
+ *	be included.
+ */
+#define I_STDARG		/**/
+
+/* I_PWD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <pwd.h>.
+ */
+/* PWQUOTA:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_quota.
+ */
+/* PWAGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_age.
+ */
+/* PWCHANGE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_change.
+ */
+/* PWCLASS:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_class.
+ */
+/* PWEXPIRE:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_expire.
+ */
+/* PWCOMMENT:
+ *	This symbol, if defined, indicates to the C program that struct passwd
+ *	contains pw_comment.
+ */
+#undef I_PWD		/**/
+#undef PWQUOTA	/**/
+#undef PWAGE	/**/
+#undef PWCHANGE	/**/
+#undef PWCLASS	/**/
+#undef PWEXPIRE	/**/
+#define PWCOMMENT	/**/
+
+/* I_STDDEF:
+ *	This symbol, if defined, indicates that <stddef.h> exists and should
+ *	be included.
+ */
+#define I_STDDEF	/**/
+
+/* I_STDLIB:
+*	This symbol, if defined, indicates that <stdlib.h> exists and should
+*	be included.
+*/
+#define I_STDLIB		/**/
+
+/* I_STRING:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <string.h> (USG systems) instead of <strings.h> (BSD systems).
+ */
+#define I_STRING		/**/
+
+/* I_SYS_DIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/dir.h>.
+ */
+#undef I_SYS_DIR		/**/
+
+/* I_SYS_FILE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/file.h> to get definition of R_OK and friends.
+ */
+#undef I_SYS_FILE		/**/
+
+/* I_SYS_IOCTL:
+ *	This symbol, if defined, indicates that <sys/ioctl.h> exists and should
+ *	be included. Otherwise, include <sgtty.h> or <termio.h>.
+ */
+#undef	I_SYS_IOCTL		/**/
+
+/* I_SYS_NDIR:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/ndir.h>.
+ */
+#undef I_SYS_NDIR	/**/
+
+/* I_SYS_SELECT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/select.h> in order to get definition of struct timeval.
+ */
+#undef I_SYS_SELECT	/**/
+
+/* I_DBM:
+ *	This symbol, if defined, indicates that <dbm.h> exists and should
+ *	be included.
+ */
+/* I_RPCSVC_DBM:
+ *	This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ *	should be included.
+ */
+#undef I_DBM	/**/
+#undef I_RPCSVC_DBM	/**/
+
+/* I_SYS_STAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/stat.h>.
+ */
+#define	I_SYS_STAT		/**/
+
+/* I_SYS_TIMES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/times.h>.
+ */
+#undef	I_SYS_TIMES		/**/
+
+/* I_SYS_TYPES:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/types.h>.
+ */
+#define	I_SYS_TYPES		/**/
+
+/* I_SYS_UN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/un.h> to get UNIX domain socket definitions.
+ */
+#undef I_SYS_UN		/**/
+
+/* I_TERMIO:
+ *	This symbol, if defined, indicates that the program should include
+ *	<termio.h> rather than <sgtty.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+/* I_TERMIOS:
+ *	This symbol, if defined, indicates that the program should include
+ *	the POSIX termios.h rather than sgtty.h or termio.h.
+ *	There are also differences in the ioctl() calls that depend on the
+ *	value of this symbol.
+ */
+/* I_SGTTY:
+ *	This symbol, if defined, indicates that the program should include
+ *	<sgtty.h> rather than <termio.h>.  There are also differences in
+ *	the ioctl() calls that depend on the value of this symbol.
+ */
+#undef I_TERMIO		/**/
+#undef I_SGTTY		/**/
+#undef I_TERMIOS		/**/
+
+/* I_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <time.h>.
+ */
+/* I_SYS_TIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h>.
+ */
+/* I_SYS_TIME_KERNEL:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/time.h> with KERNEL defined.
+ */
+#define I_TIME		/**/
+#undef I_SYS_TIME		/**/
+#undef I_SYS_TIME_KERNEL		/**/
+
+/* I_UNISTD:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <unistd.h>.
+ */
+#undef I_UNISTD		/**/
+
+/* I_UTIME:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <utime.h>.
+ */
+#undef I_UTIME		/**/
+
+/* I_VARARGS:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <varargs.h>.
+ */
+#undef I_VARARGS		/**/
+
+
+/* I_VFORK:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include vfork.h.
+ */
+#undef I_VFORK	/**/
+
+/* CAN_PROTOTYPE:
+ *	If defined, this macro indicates that the C compiler can handle
+ *	function prototypes.
+ */
+/* _:
+ *	This macro is used to declare function parameters for folks who want
+ *	to make declarations with prototypes using a different style than
+ *	the above macros.  Use double parentheses.  For example:
+ *
+ *		int main _((int argc, char *argv[]));
+ */
+#define	CAN_PROTOTYPE	/**/
+#ifdef CAN_PROTOTYPE
+#define	_(args) args  /* config-skip */
+#else
+#define	_(args) ()    /* config-skip */
+#endif
+
+/* RANDBITS:
+ *	This symbol contains the number of bits of random number the rand()
+ *	function produces.  Usual values are 15, 16, and 31.
+ */
+#define RANDBITS 31		/**/
+
+
+/* Select_fd_set_t:
+ *	This symbol holds the type used for the 2nd, 3rd, and 4th
+ *	arguments to select.  Usually, this is 'fd_set *', if HAS_FD_SET
+ *	is defined, and 'int *' otherwise.  This is only useful if you 
+ *	have select(), of course.
+ */
+#define Select_fd_set_t 	int *	/**/
+
+/* STDCHAR:
+ *	This symbol is defined to be the type of char used in stdio.h.
+ *	It has the values "unsigned char" or "char".
+ */
+#define STDCHAR char	/**/
+
+/* UNLINK_ALL_VERSIONS:
+ *	This symbol, if defined, indicates that the program should arrange
+ *	to remove all versions of a file if unlink() is called.
+ */
+#undef UNLINK_ALL_VERSIONS		/**/
+
+/* LOC_SED:
+ *	This symbol holds the complete pathname to the sed program.
+ */
+#define LOC_SED 	"_NLA0:"	/**/
+
+/* BIN:
+ *	This symbol holds the path of the bin directory where the package will
+ *	be installed. Program must be prepared to deal with ~name substitution.
+ */
+#define BIN "/perl_root/000000"	/**/
+
+/* HAS_ALARM:
+ *	This symbol, if defined, indicates that the alarm routine is
+ *	available.
+ */
+#define HAS_ALARM		/**/
+
+/* HASATTRIBUTE:
+ *	This symbol indicates the C compiler can check for function attributes,
+ *	such as printf formats. This is normally only supported by GNU cc.
+ */
+#ifdef __GNUC__
+#  define HASATTRIBUTE 	/*config-skip*/
+#else
+#  undef HASATTRIBUTE 	/*config-skip*/
+#endif
+#ifndef HASATTRIBUTE
+#define __attribute__(_arg_)
+#endif
+
+/* CASTI32:
+ *	This symbol is defined if the C compiler can cast negative
+ *	or large floating point numbers to 32-bit ints.
+ */
+#define	CASTI32		/**/
+
+/* HAS_CHOWN:
+ *	This symbol, if defined, indicates that the chown routine is
+ *	available.
+ */
+#define HAS_CHOWN		/**/
+
+/* HAS_CHROOT:
+ *	This symbol, if defined, indicates that the chroot routine is
+ *	available.
+ */
+#undef HAS_CHROOT		/**/
+
+/* HAS_CUSERID:
+ *	This symbol, if defined, indicates that the cuserid routine is
+ *	available to get character login names.
+ */
+#define HAS_CUSERID		/**/
+
+/* HAS_DBL_DIG:
+ *	This symbol, if defined, indicates that this system's <float.h>
+ *	or <limits.h> defines the symbol DBL_DIG, which is the number
+ *	of significant digits in a double precision number.  If this
+ *	symbol is not defined, a guess of 15 is usually pretty good.
+ */
+#define HAS_DBL_DIG 	/* */
+
+/* HAS_DIFFTIME:
+ *	This symbol, if defined, indicates that the difftime routine is
+ *	available.
+ */
+#define HAS_DIFFTIME		/**/
+
+/* HAS_FORK:
+ *	This symbol, if defined, indicates that the fork routine is
+ *	available.
+ */
+/* VMS: In vmsish.h, fork is #defined to vfork.  This kludge gets around
+ * some obsolete code in pp.c, which should be fixed in its own right
+ * sometime.  - C. Bailey 26-Aug-1994
+ */
+#define HAS_FORK		/**/
+
+/* HAS_GETLOGIN:
+ *	This symbol, if defined, indicates that the getlogin routine is
+ *	available.
+ */
+#define HAS_GETLOGIN		/**/
+
+/* HAS_GETPPID:
+ *	This symbol, if defined, indicates that the getppid routine is
+ *	available.
+ */
+#undef HAS_GETPPID		/**/
+
+/* HAS_HTONL:
+ *	This symbol, if defined, indicates that the htonl() routine (and
+ *	friends htons() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_HTONS:
+ *	This symbol, if defined, indicates that the htons() routine (and
+ *	friends htonl() ntohl() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHL:
+ *	This symbol, if defined, indicates that the ntohl() routine (and
+ *	friends htonl() htons() ntohs()) are available to do network
+ *	order byte swapping.
+ */
+/* HAS_NTOHS:
+ *	This symbol, if defined, indicates that the ntohs() routine (and
+ *	friends htonl() htons() ntohl()) are available to do network
+ *	order byte swapping.
+ */
+#define HAS_HTONL             /**/
+#define HAS_HTONS             /**/
+#define HAS_NTOHL             /**/
+#define HAS_NTOHS             /**/
+ 
+/* HAS_MBLEN:
+ *	This symbol, if defined, indicates that the mblen routine is available
+ *	to find the number of bytes in a multibye character.
+ */
+#undef HAS_MBLEN		/**/
+
+/* HAS_MKTIME:
+ *	This symbol, if defined, indicates that the mktime routine is
+ *	available.
+ */
+#undef HAS_MKTIME		/**/
+
+/* HAS_NICE:
+ *	This symbol, if defined, indicates that the nice routine is
+ *	available.
+ */
+#define HAS_NICE		/**/
+
+/* HAS_PAUSE:
+ *	This symbol, if defined, indicates that the pause routine is
+ *	available.
+ */
+#define HAS_PAUSE		/**/
+
+/* HAS_PIPE:
+ *	This symbol, if defined, indicates that the pipe routine is
+ *	available.
+ */
+#define HAS_PIPE		/**/
+
+/* HAS_READLINK:
+ *	This symbol, if defined, indicates that the readlink routine is
+ *	available.
+ */
+#undef HAS_READLINK		/**/
+
+/* HAS_SETLINEBUF:
+ *	This symbol, if defined, indicates that the setlinebuf routine is
+ *	available to change stderr or stdout from block-buffered or unbuffered
+ *	to a line-buffered mode.
+ */
+#undef HAS_SETLINEBUF		/**/
+
+/* HAS_STRCHR:
+ *	This symbol is defined to indicate that the strchr()/strrchr()
+ *	functions are available for string searching. If not, try the
+ *	index()/rindex() pair.
+ */
+/* HAS_INDEX:
+ *	This symbol is defined to indicate that the index()/rindex()
+ *	functions are available for string searching.
+ */
+#define HAS_STRCHR	/**/
+#undef HAS_INDEX	/**/
+
+/* HAS_STRCOLL:
+ *	This symbol, if defined, indicates that the strcoll routine is
+ *	available to compare strings using collating information.
+ */
+#undef HAS_STRCOLL	/**/
+
+/* HAS_STRXFRM:
+ *	This symbol, if defined, indicates that the strxfrm() routine is
+ *	available to compare strings using collating information.
+ */
+#undef HAS_STRXFRM	/**/
+
+/* HAS_TCGETPGRP:
+ *	This symbol, if defined, indicates that the tcgetpgrp routine is
+ *	available to get foreground process group ID.
+ */
+#undef HAS_TCGETPGRP		/**/
+
+/* HAS_TCSETPGRP:
+ *	This symbol, if defined, indicates that the tcsetpgrp routine is
+ *	available to set foreground process group ID.
+ */
+#undef HAS_TCSETPGRP		/**/
+
+/* HAS_TIMES:
+ *	This symbol, if defined, indicates that the times() routine exists.
+ *	Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+#define HAS_TIMES		/**/
+
+/* HAS_TZNAME:
+ *	This symbol, if defined, indicates that the tzname[] array is
+ *	available to access timezone names.
+ */
+#undef HAS_TZNAME		/**/
+
+/* HAS_UMASK:
+ *	This symbol, if defined, indicates that the umask routine is
+ *	available to get the file creation mask.
+ */
+#define HAS_UMASK		/**/
+
+/* HAS_WCTOMB:
+ *	This symbol, if defined, indicates that the wctomb routine is available
+ *	to covert a wide character to a multibyte.
+ */
+#undef HAS_WCTOMB		/**/
+
+/* Fpos_t:
+ *	This symbol holds the type used to declare file positions in libc.
+ *	It can be fpos_t, long, uint, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Fpos_t fpos_t		/* File position type */
+
+/* Gid_t:
+ *	This symbol holds the return type of getgid() and the type of
+ *	argument to setrgid() and related functions.  Typically,
+ *	it is the type of group ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 500000)
+#  define Gid_t gid_t		/* config-skip */
+#else
+#  define Gid_t unsigned int	/* config-skip */
+#endif
+
+/* I_DLFCN:
+ *	This symbol, if defined, indicates that <dlfcn.h> exists and should
+ *	be included.
+ */
+#undef I_DLFCN		/**/
+
+/* I_FLOAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <float.h> to get definition of symbols like DBL_MAX or
+ *	DBL_MIN, i.e. machine dependent floating point values.
+ */
+#define I_FLOAT		/**/
+
+/* I_MATH:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <math.h>.
+ */
+#define I_MATH		/**/
+
+/* I_LOCALE:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <locale.h>.
+ */
+#undef	I_LOCALE		/**/
+
+/* I_SYS_STAT:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/stat.h>.
+ */
+#define I_SYS_STAT		/**/
+
+/* INTSIZE:
+ *	This symbol contains the size of an int, so that the C preprocessor
+ *	can make decisions based on it.
+ */
+#define INTSIZE 4		/**/
+
+/* Off_t:
+ *	This symbol holds the type used to declare offsets in the kernel.
+ *	It can be int, long, off_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Off_t int		/* <offset> type */
+
+/* Free_t:
+ *	This variable contains the return type of free().  It is usually
+ * void, but occasionally int.
+ */
+/* Malloc_t:
+ *	This symbol is the type of pointer returned by malloc and realloc.
+ */
+#define Malloc_t void *			/**/
+#define Free_t void			/**/
+
+/* MYMALLOC:
+ *	This symbol, if defined, indicates that we're using our own malloc.
+ */
+#undef MYMALLOC			/**/
+
+/* SIG_NAME:
+ *	This symbol contains a list of signal names in order. This is intended
+ *	to be used as a static array initialization, like this:
+ *		char *sig_name[] = { SIG_NAME };
+ *	The signals in the list are separated with commas, and each signal
+ *	is surrounded by double quotes. There is no leading SIG in the signal
+ *	name, i.e. SIGQUIT is known as "QUIT". Duplicates are allowed.
+ *	The signal number for sig_name[i] is stored in sig_num[i].
+ *	The last element is 0 to terminate the list with a NULL.  This
+ *	corresponds to the 0 at the end of the sig_num list.
+ *	See SIG_NUM and SIG_MAX.
+ */
+#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\
+                 "KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM",\
+                 "ABRT","USR1","USR2",0
+
+/* SIG_NUM:
+ *	This symbol contains a list of signal number, in the same order as the
+ *	SIG_NAME list. It is suitable for static array initialization, as in:
+ *		int sig_num[] = { SIG_NUM };
+ *	The signals in the list are separated with commas, and the indices
+ *	within that list and the SIG_NAME list match, so it's easy to compute
+ *	the signal name from a number or vice versa at the price of a small
+ *	dynamic linear lookup. Duplicates are allowed, so you can't assume
+ *	sig_num[i] == i.  Instead, the signal number corresponding to
+ * sig_name[i] is sig_number[i].
+ * The last element is 0, corresponding to the 0 at the end of
+ * the sig_name list.
+ */
+#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,6,16,17,0	/**/
+
+/* Mode_t:
+ *	This symbol holds the type used to declare file modes 
+ *	for systems calls.  It is usually mode_t, but may be
+ *	int or unsigned short.  It may be necessary to include <sys/types.h>
+ *	to get any typedef'ed information.
+ */
+#define Mode_t unsigned int	 /* file mode parameter for system calls*/
+
+/* SSize_t:
+ *	This symbol holds the type used by functions that return
+ *	a count of bytes or an error condition.  It must be a signed type.
+ *	It is usually ssize_t, but may be long or int, etc.
+ *	It may be necessary to include <sys/types.h> or <unistd.h>
+ *	to get any typedef'ed information.
+ *	We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+#define SSize_t int	 /* signed count of bytes */
+
+/* VAL_O_NONBLOCK:
+ *	This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ *	non-blocking I/O for the file descriptor. Note that there is no way
+ *	back, i.e. you cannot turn it blocking again this way. If you wish to
+ *	alternatively switch between blocking and non-blocking, use the
+ *	ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+/* VAL_EAGAIN:
+ *	This symbol holds the errno error code set by read() when no data was
+ *	present on the non-blocking file descriptor.
+ */
+/* RD_NODATA:
+ *	This symbol holds the return code from read() when no data is present
+ *	on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ *	not defined, then you can't distinguish between no data and EOF by
+ *	issuing a read(). You'll have to find another way to tell for sure!
+ */
+/* EOF_NONBLOCK:
+ *	This symbol, if defined, indicates to the C program that a read() on
+ *	a non-blocking file descriptor will return 0 on EOF, and not the value
+ *	held in RD_NODATA (-1 usually, in that case!).
+ */
+#define VAL_O_NONBLOCK
+#define VAL_EAGAIN
+#define RD_NODATA
+#undef EOF_NONBLOCK
+
+/* OLDARCHLIB_EXP:
+ *	This symbol contains the ~name expanded version of OLDARCHLIB, to be
+ *	used in programs that are not prepared to deal with ~ expansion at 
+ *	run-time.
+ */
+/*     ==> NOTE <==
+ * This value is automatically updated by FndVers.Com
+ * when Perl is built.  Please do not change it by hand; make
+ * any changes to FndVers.Com instead.
+ */
+#define OLDARCHLIB_EXP "/perl_root/lib/VMS_VAX"  /**/
+
+/* PRIVLIB_EXP:
+ *	This symbol contains the name of the private library for this package.
+ *	The library is private in the sense that it needn't be in anyone's
+ *	execution path, but it should be accessible by the world.  The program
+ *	should be prepared to do ~ expansion.
+ */
+#define PRIVLIB_EXP "/perl_root/lib"		/**/
+
+/* SITELIB_EXP:
+ *	This symbol contains the ~name expanded version of SITELIB, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+#define SITELIB_EXP	"/perl_root/lib/site_perl"	/**/
+
+/* SITEARCH_EXP:
+ *	This symbol contains the ~name expanded version of SITEARCH, to be used
+ *	in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+/*     ==> NOTE <==
+ * This value is automatically updated by FndVers.Com
+ * when Perl is built.  Please do not change it by hand; make
+ * any changes to FndVers.Com instead.
+ */
+#define SITEARCH_EXP "/perl_root/lib/site_perl/VMS_VAX"  /**/
+
+/* SCRIPTDIR:
+ *	This symbol holds the name of the directory in which the user wants
+ *	to put publicly executable scripts for the package in question.  It
+ *	is often a directory that is mounted across diverse architectures.
+ *	Programs must be prepared to deal with ~name expansion.
+ */
+#define SCRIPTDIR "/perl_root/script"	/**/
+
+/* Size_t:
+ *	This symbol holds the type used to declare length parameters
+ *	for string functions.  It is usually size_t, but may be
+ *	unsigned long, int, etc.  It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#define Size_t size_t	 /* length paramater for string functions */
+
+/* Uid_t:
+ *	This symbol holds the type used to declare user ids in the kernel.
+ *	It can be int, ushort, uid_t, etc... It may be necessary to include
+ *	<sys/types.h> to get any typedef'ed information.
+ */
+#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 500000)
+#  define Uid_t uid_t		/* config-skip */
+#else
+#  define Uid_t unsigned int	/* config-skip */
+#endif
+
+/* I_SYS_PARAM:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <sys/param.h>.
+ */
+#undef I_SYS_PARAM
+
+/* GNUC_ATTRIBUTE_CHECK:
+ *	This symbol indicates the C compiler can check for function attributes,
+ *	such as printf formats.
+ */
+/* VMS: true for gcc, undef for VAXC/DECC.  This is handled in Descrip.MMS
+ * C. Bailey  26-Aug-1994
+ */
+/*#define 	GNUC_ATTRIBUTE_CHECK 	/**/
+
+/* VOID_CLOSEDIR:
+ *	This symbol, if defined, indicates that the closedir() routine
+ *	does not return a value.
+ */
+#define VOID_CLOSEDIR		/**/
+
+/* HAS_DLERROR:
+ *	This symbol, if defined, indicates that the dlerror routine is
+ *	available.
+*/
+#undef HAS_DLERROR		/**/
+
+/* DLSYM_NEEDS_UNDERSCORE:
+ *	This symbol, if defined, indicates that we need to prepend an
+ *	underscore to the symbol name before calling dlsym().  This only
+ *	makes sense if you *have* dlsym, which we will presume is the
+ *	case if you're using dl_dlopen.xs.
+ */
+#undef 	DLSYM_NEEDS_UNDERSCORE 	/* */
+
+/* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ *	This symbol, if defined, indicates that setuid scripts are secure.
+ */
+/* DOSUID:
+ *	This symbol, if defined, indicates that the C program should
+ *	check the script that it is executing for setuid/setgid bits, and
+ *	attempt to emulate setuid/setgid on systems that have disabled
+ *	setuid #! scripts because the kernel can't do it securely.
+ *	It is up to the package designer to make sure that this emulation
+ *	is done securely.  Among other things, it should do an fstat on
+ *	the script it just opened to make sure it really is a setuid/setgid
+ *	script, it should make sure the arguments passed correspond exactly
+ *	to the argument on the #! line, and it should not trust any
+ *	subprocesses to which it must pass the filename rather than the
+ *	file descriptor of the script to be executed.
+ */
+#undef SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
+#undef DOSUID		/**/
+
+/* HAS_ISASCII:
+ *	This manifest constant lets the C program know that the
+ *	isascii is available.
+ */
+#define HAS_ISASCII		/**/
+
+/* HAS_LOCALECONV:
+ *	This symbol, if defined, indicates that the localeconv routine is
+ *	available for numeric and monetary formatting conventions.
+ */
+#undef HAS_LOCALECONV	/**/
+
+/* HAS_MKFIFO:
+ *	This symbol, if defined, indicates that the mkfifo routine is
+ *	available.
+ */
+#undef HAS_MKFIFO		/**/
+
+/* HAS_PATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given filename.
+ */
+/* HAS_FPATHCONF:
+ *	This symbol, if defined, indicates that pathconf() is available
+ *	to determine file-system related limits and options associated
+ *	with a given open file descriptor.
+ */
+#undef HAS_PATHCONF       /**/
+#undef HAS_FPATHCONF     /**/
+
+/* HAS_SAFE_BCOPY:
+ *	This symbol, if defined, indicates that the bcopy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+#undef HAS_SAFE_BCOPY	/**/
+
+/* HAS_SAFE_MEMCPY:
+ *	This symbol, if defined, indicates that the memcpy routine is available
+ *	to copy potentially overlapping memory blocks. Otherwise you should
+ *	probably use memmove() or memcpy(). If neither is defined, roll your
+ *	own version.
+ */
+#define HAS_SAFE_MEMCPY	/**/
+
+/* HAS_SETPGRP:
+ *	This symbol, if defined, indicates that the setpgrp routine is
+ *	available to set the current process group.
+ */
+/* USE_BSDPGRP:
+ *	This symbol, if defined, indicates that the BSD notion of process
+ *	group is to be used. For instance, you have to say setpgrp(pid, pgrp)
+ *	instead of the USG setpgrp().
+ */
+#undef HAS_SETPGRP		/**/
+#undef USE_BSDPGRP		/**/
+
+/* HAS_SYSCONF:
+ *	This symbol, if defined, indicates that sysconf() is available
+ *	to determine system related limits and options.
+ */
+#undef HAS_SYSCONF     /**/
+
+/* Gconvert:
+ *	This preprocessor macro is defined to convert a floating point
+ *	number to a string without a trailing decimal point.  This
+ *	emulates the behavior of sprintf("%g"), but is sometimes much more
+ *	efficient.  If gconvert() is not available, but gcvt() drops the
+ *	trailing decimal point, then gcvt() is used.  If all else fails,
+ *	a macro using sprintf("%g") is used.  Arguments for the Gconvert
+ *	macro are: value, number of digits, whether trailing zeros should
+ *	be retained, and the output buffer.
+ *	Possible values are:
+ *		d_Gconvert='gconvert((x),(n),(t),(b))'
+ *		d_Gconvert='gcvt((x),(n),(b))'
+ *		d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ *	The last two assume trailing zeros should not be kept.
+ */
+#define Gconvert(x,n,t,b) my_gconvert(x,n,t,b)
+
+/* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+/* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ */
+/* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ */
+#undef HAS_SIGSETJMP	/**/
+#ifdef HAS_SIGSETJMP
+#define Sigjmp_buf sigjmp_buf	/* config-skip */
+#define Sigsetjmp(buf,save_mask) sigsetjmp(buf,save_mask)	/* config-skip */
+#define Siglongjmp(buf,retval) siglongjmp(buf,retval)	/* config-skip */
+#else
+#define Sigjmp_buf jmp_buf	/* config-skip */
+#define Sigsetjmp(buf,save_mask) setjmp(buf)	/* config-skip */
+#define Siglongjmp(buf,retval) longjmp(buf,retval)	/* config-skip */
+#endif
+
+/* USE_DYNAMIC_LOADING:
+ *	This symbol, if defined, indicates that dynamic loading of
+ *	some sort is available.
+ */
+#define USE_DYNAMIC_LOADING		/**/
+
+/* STARTPERL:
+ *	This variable contains the string to put in front of a perl
+ *	script to make sure (one hopes) that it runs with perl and not
+ *	some shell.
+ */
+#define STARTPERL ""		/**/
+
+/* VOIDFLAGS:
+ *	This symbol indicates how much support of the void type is given by this
+ *	compiler.  What various bits mean:
+ *
+ *	    1 = supports declaration of void
+ *	    2 = supports arrays of pointers to functions returning void
+ *	    4 = supports comparisons between pointers to void functions and
+ *		    addresses of void functions
+ *	    8 = suports declaration of generic void pointers
+ *
+ *	The package designer should define VOIDUSED to indicate the requirements
+ *	of the package.  This can be done either by #defining VOIDUSED before
+ *	including config.h, or by defining defvoidused in Myinit.U.  If the
+ *	latter approach is taken, only those flags will be tested.  If the
+ *	level of void support necessary is not present, defines void to int.
+ */
+#ifndef VOIDUSED
+#define VOIDUSED 15
+#endif
+#define VOIDFLAGS 15
+#if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+#define void int		/* is void to be avoided? */  /* config-skip */
+#define M_VOID			/* Xenix strikes again */     /* config-skip */
+#endif
+
+#ifdef VMS_DO_SOCKETS
+/* HAS_SOCKET:
+ *	This symbol, if defined, indicates that the BSD socket interface is
+ *	supported.
+ */
+/* HAS_SOCKETPAIR:
+ *	This symbol, if defined, indicates that the BSD socketpair() call is
+ *	supported.
+ */
+#define HAS_SOCKET		/**/          /* config-skip */
+#undef HAS_SOCKETPAIR	/**/          /* config-skip */
+
+/* HAS_GETHOSTENT:
+ *	This symbol, if defined, indicates that the gethostent routine is
+ *	available to lookup host names in some data base or other.
+ */
+#define HAS_GETHOSTENT		/**/      /* config-skip */
+
+/* VMS: In general, TCP/IP header files should be included from
+ * sockadapt.h, instead of here, in order to keep the TCP/IP code
+ * together as much as possible.
+ */
+/* I_NETINET_IN:
+ *	This symbol, if defined, indicates to the C program that it should
+ *	include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
+ */
+#undef I_NETINET_IN	/**/              /* config-skip */
+
+/* Groups_t:
+ *	This symbol holds the type used for the second argument to
+ *	getgroups().  Usually, this is the same of gidtype, but
+ *	sometimes it isn't.  It can be int, ushort, uid_t, etc... 
+ *	It may be necessary to include <sys/types.h> to get any 
+ *	typedef'ed information.  This is only required if you have
+ *	getgroups().
+ */
+#ifdef HAS_GETGROUPS
+#define Groups_t unsigned int	/* Type for 2nd arg to getgroups() */  /* config-skip */
+#endif
+
+/* DB_Prefix_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is u_int32_t.
+ */
+/* DB_Hash_t:
+ *	This symbol contains the type of the prefix structure element
+ *	in the <db.h> header file.  In older versions of DB, it was
+ *	int, while in newer ones it is size_t.
+ */
+#undef DB_Hash_t	/**/
+#undef DB_Prefix_t	/**/
+
+/* I_NET_ERRNO:
+ *	This symbol, if defined, indicates that <net/errno.h> exists and 
+ *	should be included.
+*/
+#undef I_NET_ERRNO		/**/          /* config-skip */
+
+/* HAS_SELECT:
+ *	This symbol, if defined, indicates that the select routine is
+ *	available to select active file descriptors. If the timeout field
+ *	is used, <sys/time.h> may need to be included.
+ */
+#define HAS_SELECT	/**/              /* config-skip */
+
+#else /* VMS_DO_SOCKETS */
+
+#undef HAS_SOCKET		/**/          /* config-skip */
+#undef HAS_SOCKETPAIR	/**/          /* config-skip */
+#undef HAS_GETHOSTENT		/**/      /* config-skip */
+#undef I_NETINET_IN	/**/              /* config-skip */
+#undef I_NET_ERRNO		/**/          /* config-skip */
+#undef HAS_SELECT	/**/              /* config-skip */
+
+#endif /* !VMS_DO_SOCKETS */
+
+#endif
diff --git a/gnu/usr.bin/perl/vms/descrip.mms b/gnu/usr.bin/perl/vms/descrip.mms
new file mode 100644
index 00000000000..7e52f19cc97
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/descrip.mms
@@ -0,0 +1,1525 @@
+# Descrip.MMS for perl5 on VMS
+# Last revised 22-Mar-1996 by Charles Bailey  bailey@genetics.upenn.edu
+#
+#: This file uses MMS syntax, and can be processed using DEC's MMS product,
+#: or the free MMK clone (available by ftp at ftp.spc.edu).  If you want to
+#: a Unix-style MAKE tool, run this file through mms2make.pl, which should
+#: be found in the same directory as this file.  (There should be a pre-made
+#: copy of Makefile for VAXC in this directory to allow you to build perl.)
+#:
+#: Lines beginning with "#:" will be removed by mms2make.pl when converting
+#: this file to MAKE syntax.
+#:
+#:	Usage:
+#: Building with VAX C, on system without DEC C installed or with VAX C default:
+#:	$ MMS
+#: Building with VAX C, on system with DEC C installed as default C compiler:
+#:	$ MMS /MACRO=("cc=CC/VAXC")
+#: Building with DEC C, on system without VAX C installed or with DEC C default:
+#:	$ MMS /MACRO=("decc=1")
+#: Building with DEC C, on system with VAX C installed as default C compiler:
+#:	$ MMS /MACRO=("decc=1","cc=CC/DECC")
+#: Building with GNU C
+#:	$ MMS /MACRO=("gnuc=1")
+#: To each of the above, add /Macro="__AXP__=1" if building on an AXP,
+#:                           /Macro="__DEBUG__=1" to build a debug version
+#:                           (i.e. VMS debugger, not perl -D), and
+#:                           /Macro="SOCKET=1" to include socket support.
+#
+#	tidy      -- purge files generated by executing this file
+#	clean     -- remove all intermediate (e.g. object files, C files generated
+#	             during build) files generated by executing this file,
+#	             but leave `installable' files (images, library) intact
+#	realclean -- remove all files generated by executing this file
+#	cleansrc  -- `realclean' + purge *.c,*.h,descrip.mms
+#	crtl.opt  -- compiler-specific linker options file (made automatically)
+#
+
+#### Start of system configuration section. ####
+
+
+#: >>>>> Architecture-specific options <<<<<
+.ifdef AXE
+# File type to use for object files
+O = .abj
+# File type to use for object libraries
+OLB = .alb
+# File type to use for executable images
+E = .axe
+.else
+# File type to use for object files
+O = .obj
+# File type to use for object libraries
+OLB = .olb
+# File type to use for executable images
+E = .exe
+.endif
+
+.ifdef __AXP__
+DECC = 1
+ARCH = VMS_AXP
+OBJVAL = $(O)
+.else
+ARCH = VMS_VAX
+OBJVAL = $(MMS$TARGET_NAME)$(O)
+.endif
+
+.first
+	@ @[.vms]fndvers.com "" "" "[.vms]descrip.mms"
+
+# Updated by fndvers.com -- do not edit by hand
+PERL_VERSION = 5_003  #
+
+
+ARCHDIR =  [.lib.$(ARCH).$(PERL_VERSION)]
+ARCHCORE = [.lib.$(ARCH).$(PERL_VERSION).CORE]
+ARCHAUTO = [.lib.$(ARCH).$(PERL_VERSION).auto]
+
+
+#: Backwards compatibility
+.ifdef DECC_PIPES_BROKEN
+PIPES_BROKEN = 1
+.endif
+
+
+#: >>>>>Compiler-specific options <<<<<
+.ifdef GNUC
+.first
+	@ If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]
+CC = gcc
+# -fno-builtin avoids bug in gcc up to version 2.6.2 which can destroy
+# data when memcpy() is called on large (>64 kB) blocks of memory
+# (fixed in gcc 2.6.3)
+XTRACCFLAGS = /Obj=$(MMS$TARGET_NAME)$(O)/NoCase_Hack/Optimize=2/CC1="""""-fno-builtin"""""
+DBGSPECFLAGS =
+XTRADEF = ,GNUC_ATTRIBUTE_CHECK
+XTRAOBJS =
+LIBS1 = GNU_CC:[000000]GCCLIB.OLB/Library
+LIBS2 = Sys$Share:VAXCRTL/Shareable
+.else
+XTRAOBJS = 
+LIBS1 = $(XTRAOBJS)
+DBGSPECFLAGS = /Show=(Source,Include,Expansion)
+.ifdef decc
+# Some versions of DECCRTL on AXP have a bug in chdir() which causes the change
+# to persist after the image exits, even when this was not requested, iff
+# SYSNAM is enabled.  This is fixed in CSC Patch # AXPACRT04_061, but turning
+# off SYSNAM for the MM[SK] subprocess doesn't hurt anything, so we do it
+# just in case.
+.first
+	@ Set Process/Privilege=(NoSYSNAM)
+	@ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include
+.ifdef __AXP__
+	@ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS Sys$Library
+.else
+	@ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS DECC$Library_Include
+.endif
+
+LIBS2 = 
+XTRACCFLAGS = /Include=[]/Standard=Relaxed_ANSI/Prefix=All/Obj=$(OBJVAL)
+XTRADEF =
+.else # VAXC
+.first
+	@ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
+	@ If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include
+
+XTRACCFLAGS = /Include=[]/Object=$(O)
+XTRADEF =
+LIBS2 = Sys$Share:VAXCRTL/Shareable
+.endif
+.endif
+
+
+#: >>>>> Configuration options <<<<<
+#: __DEBUG__: builds images with full VMS debugger support
+.ifdef __DEBUG__
+DBGCCFLAGS = /List/Debug/NoOpt$(DBGSPECFLAGS)
+DBGLINKFLAGS = /Trace/Debug/Map/Full/Cross
+DBG = DBG
+.else
+DBGCCFLAGS = /NoList
+DBGLINKFLAGS = /NoMap
+DBG = 
+.endif
+
+#: SOCKET: build in support for TCP/IP sockets
+#: By default, used SOCKETSHR library; see ReadMe.VMS
+#: for information on changing socket support
+.ifdef SOCKET
+SOCKDEF = ,VMS_DO_SOCKETS
+SOCKLIB = SocketShr/Share
+# N.B. the targets for $(SOCKC) and $(SOCKH) assume that the permanent
+# copies live in [.vms], and the `clean' target will delete copies of
+# these files in the current default directory.
+SOCKC = sockadapt.c
+SOCKH = sockadapt.h
+SOCKCLIS = ,$(SOCKC)
+SOCKHLIS = ,$(SOCKH)
+SOCKOBJ = ,sockadapt$(O)
+SOCKPM = [.lib]Socket.pm
+.else
+SOCKDEF =
+SOCKLIB =
+SOCKC =
+SOCKH =
+SOCKCLIS =
+SOCKHLIS =
+SOCKOBJ =
+SOCKPM =
+.endif
+
+# C preprocessor manifest "DEBUGGING" ==> perl -D, not the VMS debugger
+CFLAGS = /Define=(DEBUGGING$(SOCKDEF)$(XTRADEF))$(XTRACCFLAGS)$(DBGCCFLAGS)
+LINKFLAGS = $(DBGLINKFLAGS)
+
+MAKE = $(MMS)
+MAKEFILE = [.VMS]Descrip.MMS   # this file
+NOOP = continue
+
+# Macros to invoke a copy of miniperl during the build.  Targets which
+# are built using these macros should depend on $(MINIPERL_EXE)
+MINIPERL_EXE = Sys$Disk:[]miniperl$(E)
+MINIPERL = MCR $(MINIPERL_EXE) "-I[.lib]"
+XSUBPP = $(MINIPERL) [.lib.extutils]xsubpp -noprototypes
+# Macro to invoke a preexisting copy of Perl.  This is used to regenerate
+# some header files when rebuilding Perl, but premade versions are provided
+# in the distribution, so it's OK if this doesn't work; it's here to make
+# life easier for those who modify Perl and rebuild it.
+INSTPERL = perl
+
+# Space-separated list of "static" extensions to build into perlshr (case counts).
+MYEXT = DynaLoader
+# object files for these extensions; the trailing comma is required if
+# there are any object files specified
+# These must be built separately, or you must add rules below to build them
+myextobj = [.ext.dynaloader]dl_vms$(O),
+#: We include the Socket extension by default if we're building with socket
+#: support, since it's small and not really worth bothering to keep track
+#: of separately.
+.ifdef SOCKET
+EXT = $(MYEXT) Socket
+extobj = $(myextobj) [.ext.socket]socket$(O), 
+.else
+EXT = $(MYEXT)
+extobj = $(myextobj)
+.endif
+
+
+#### End of system configuration section. ####
+
+
+h1 = EXTERN.h, INTERN.h, XSUB.h, av.h, config.h, cop.h, cv.h
+h2 = embed.h, form.h, gv.h, handy.h, hv.h, keywords.h, mg.h, op.h
+h3 = opcode.h, patchlevel.h, perl.h, perly.h, pp.h, proto.h, regcomp.h
+h4 = regexp.h, scope.h, sv.h, vmsish.h, util.h
+h = $(h1), $(h2), $(h3), $(h4) $(SOCKHLIS)
+
+c1 = av.c, scope.c, op.c, doop.c, doio.c, dump.c, hv.c, mg.c
+c2 = perl.c, perly.c, pp.c, pp_hot.c, pp_ctl.c, pp_sys.c, regcomp.c, regexec.c
+c3 = gv.c, sv.c, taint.c, toke.c, util.c, deb.c, run.c, globals.c, vms.c $(SOCKCLIS)
+
+c = $(c1), $(c2), $(c3), miniperlmain.c, perlmain.c
+
+obj1 = perl$(O), gv$(O), toke$(O), perly$(O), op$(O), regcomp$(O), dump$(O), util$(O), mg$(O)
+obj2 = hv$(O), av$(O), run$(O), pp_hot$(O), sv$(O), pp$(O), scope$(O), pp_ctl$(O), pp_sys$(O)
+obj3 = doop$(O), doio$(O), regexec$(O), taint$(O), deb$(O), globals$(O), vms$(O) $(SOCKOBJ)
+
+obj = $(obj1), $(obj2), $(obj3)
+
+ac1 = $(ARCHCORE)EXTERN.h $(ARCHCORE)INTERN.h  $(ARCHCORE)XSUB.h $(ARCHCORE)av.h
+ac2 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h
+ac3 = $(ARCHCORE)form.h $(ARCHCORE)gv.h $(ARCHCORE)handy.h $(ARCHCORE)hv.h
+ac4 = $(ARCHCORE)keywords.h $(ARCHCORE)mg.h $(ARCHCORE)op.h $(ARCHCORE)opcode.h
+ac5 = $(ARCHCORE)patchlevel.h $(ARCHCORE)perl.h $(ARCHCORE)perly.h
+ac6 = $(ARCHCORE)pp.h $(ARCHCORE)proto.h $(ARCHCORE)regcomp.h
+ac7 = $(ARCHCORE)regexp.h $(ARCHCORE)scope.h $(ARCHCORE)sv.h $(ARCHCORE)util.h
+ac8 = $(ARCHCORE)vmsish.h $(ARCHCORE)$(DBG)libperl$(OLB) $(ARCHCORE)perlshr_attr.opt
+ac9 = $(ARCHCORE)$(DBG)perlshr_bld.opt
+.ifdef SOCKET
+acs = $(ARCHCORE)$(SOCKH)
+.else
+acs =
+.endif
+
+CRTL = []crtl.opt
+CRTLOPTS =,$(CRTL)/Options
+
+.SUFFIXES
+
+.ifdef LINK_ONLY
+.else
+.SUFFIXES $(O) .c .xs
+
+.xs.c :
+	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+
+
+.c$(O) :
+	$(CC) $(CFLAGS) $(MMS$SOURCE)
+
+.xs$(O) :
+	$(XSUBPP) $(MMS$SOURCE) >$(MMS$SOURCE_NAME).c
+	$(CC) $(CFLAGS) $(MMS$SOURCE_NAME).c
+.endif
+
+
+all : base extras archcorefiles preplibrary perlpods
+	@ $(NOOP)
+base : miniperl perl
+	@ $(NOOP)
+extras : Fcntl FileHandle Safe libmods utils podxform
+	@ $(NOOP)
+libmods : [.lib]Config.pm $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm 
+	@ $(NOOP)
+utils : [.lib.pod]perldoc [.lib.ExtUtils]Miniperl.pm [.utils]c2ph [.utils]h2ph [.utils]h2xs [.lib]perlbug
+	@ $(NOOP)
+podxform : [.lib.pod]pod2text [.lib.pod]pod2html [.lib.pod]pod2latex [.lib.pod]pod2man
+	@ $(NOOP)
+
+pod1 = [.lib.pod]perl.pod [.lib.pod]perlbook.pod [.lib.pod]perlbot.pod [.lib.pod]perlcall.pod
+pod2 = [.lib.pod]perldata.pod [.lib.pod]perldebug.pod [.lib.pod]perldiag.pod [.lib.pod]perldsc.pod
+pod3 = [.lib.pod]perlembed.pod [.lib.pod]perlform.pod [.lib.pod]perlfunc.pod [.lib.pod]perlguts.pod
+pod4 = [.lib.pod]perlipc.pod [.lib.pod]perllol.pod [.lib.pod]perlmod.pod [.lib.pod]perlobj.pod
+pod5 = [.lib.pod]perlop.pod [.lib.pod]perlovl.pod [.lib.pod]perlpod.pod [.lib.pod]perlre.pod
+pod6 = [.lib.pod]perlref.pod [.lib.pod]perlrun.pod [.lib.pod]perlsec.pod [.lib.pod]perlstyle.pod
+pod7 = [.lib.pod]perlsub.pod [.lib.pod]perlsyn.pod [.lib.pod]perltie.pod [.lib.pod]perltoc.pod
+pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.pod]perlxstut.pod
+
+perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod
+	@ $(NOOP)
+
+archcorefiles :  $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(acs) $(ARCHAUTO)time.stamp
+	@ $(NOOP)
+
+miniperl : $(DBG)miniperl$(E)
+	@ Continue
+miniperl_objs = miniperlmain$(O), $(obj)
+$(MINIPERL_EXE) :  miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL)
+	Link $(LINKFLAGS)/NoDebug/Exe=$(MMS$TARGET) miniperlmain$(O), $(DBG)libperl$(OLB)/Library/Include=globals $(CRTLOPTS)
+$(DBG)miniperl$(E) :  $(miniperl_objs), $(DBG)libperl$(OLB) $(CRTL)
+	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) miniperlmain$(O),$(DBG)libperl$(OLB)/Library/Include=globals  $(CRTLOPTS)
+
+$(DBG)libperl$(OLB) : $(obj)
+	@ If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)
+	Library/Object/Replace $(MMS$TARGET) $(obj1)
+	Library/Object/Replace $(MMS$TARGET) $(obj2)
+	Library/Object/Replace $(MMS$TARGET) $(obj3)
+
+perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl
+	$(MINIPERL) [.VMS]Writemain.pl "$(EXT)"
+
+perl : $(DBG)perl$(E)
+	@ Continue
+$(DBG)perl$(E) : perlmain$(O), $(DBG)perlshr$(E), $(MINIPERL_EXE)
+	@ @[.vms]genopt "PerlShr.Opt/Write" "|" "''F$Environment("Default")'$(DBG)PerlShr$(E)/Share"
+.ifdef gnuc
+	@ @[.vms]genopt "PerlShr.Opt/Append" "|" "$(LIBS1)|$(LIBS2)"
+.endif
+	Link $(LINKFLAGS)/Exe=$(MMS$TARGET) perlmain$(O), perlshr.opt/Option, perlshr_attr.opt/Option
+
+$(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts
+	Link /NoTrace$(LINKFLAGS)/Share=$(MMS$TARGET) $(extobj) []$(DBG)perlshr_bld.opt/Option, perlshr_attr.opt/Option
+
+# The following files are built in one go by gen_shrfls.pl:
+#  perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP
+#  perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only
+# The song and dance with gen_shrfls.opt accomodates DCL's 255 character
+# line length limit.
+.ifdef PIPES_BROKEN
+# This is a backup target used only with older versions of the DECCRTL which
+# can't deal with pipes properly.  See ReadMe.VMS for details.
+$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
+	$(CC) $(CFLAGS)/NoObject/NoList/PreProcess=perl.i perl.h
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "~~NOCC~~perl.i~~$(CC)$(CFLAGS)" >gen_shrfls.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+	$(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+	@ Delete/NoLog/NoConfirm perl.i;, gen_shrfls.opt;
+	@ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
+	@ Copy _NLA0: $(DBG)perlshr_xtras.ts
+.else
+$(DBG)perlshr_xtras.ts : perl.h config.h vmsish.h proto.h [.vms]gen_shrfls.pl $(MINIPERL_EXE) $(MAKEFILE) $(CRTL)
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "$(CC)$(CFLAGS)" >gen_shrfls.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV);" "$(O)" "$(DBG)" "$(OLB)" "$(EXT)" "$(CRTL)" >>gen_shrfls.opt
+	$(MINIPERL) [.vms]gen_shrfls.pl -f gen_shrfls.opt
+	@ Delete/NoLog/NoConfirm gen_shrfls.opt;
+	@ If F$Search("$(DBG)perlshr_xtras.ts").nes."" Then Delete/NoLog/NoConfirm $(DBG)perlshr_xtras.ts;*
+	@ Copy _NLA0: $(DBG)perlshr_xtras.ts
+.endif
+
+$(ARCHDIR)config.pm : [.lib]config.pm
+	Create/Directory $(ARCHDIR)
+	Copy $(MMS$SOURCE) $(MMS$TARGET)
+
+# Once again, we accomodate DCL's 255 character buffer
+[.lib]config.pm : [.vms]config.vms [.vms]genconfig.pl $(MINIPERL_EXE)
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "cc=$(CC)$(CFLAGS)" >genconfig.opt
+	@ $(MINIPERL) -e "print join('|',@ARGV),'|';" "ldflags=$(LINKFLAGS)|obj_ext=$(O)|exe_ext=$(E)|lib_ext=$(OLB)" >>genconfig.opt
+	$(MINIPERL) [.VMS]GenConfig.Pl -f genconfig.opt
+	@ Delete/NoLog/NoConfirm genconfig.opt;
+	$(MINIPERL) ConfigPM.
+
+[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(MINIPERL_EXE)
+	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+
+[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c
+	$(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
+
+[.lib]DynaLoader.pm : [.ext.dynaloader]dynaloader.pm
+	Copy/Log/NoConfirm [.ext.dynaloader]dynaloader.pm [.lib]DynaLoader.pm
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]DynaLoader.pm
+
+Safe : [.lib]Safe.pm [.lib.auto.Safe]Safe$(E)
+	@ $(NOOP)
+
+[.lib]Safe.pm : [.ext.Safe]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.Safe]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.Safe]Safe$(E) : [.ext.Safe]Descrip.MMS
+	@ Set Default [.ext.Safe]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Safe]Descrip.MMS : [.ext.Safe]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Safe]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+FileHandle : [.lib]FileHandle.pm [.lib.auto.FileHandle]FileHandle$(E)
+	@ $(NOOP)
+
+[.lib]FileHandle.pm : [.ext.FileHandle]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.FileHandle]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.FileHandle]FileHandle$(E) : [.ext.FileHandle]Descrip.MMS
+	@ Set Default [.ext.FileHandle]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.FileHandle]Descrip.MMS : [.ext.FileHandle]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.FileHandle]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+Fcntl : [.lib]Fcntl.pm [.lib.auto.Fcntl]Fcntl$(E)
+	@ $(NOOP)
+
+[.lib]Fcntl.pm : [.ext.Fcntl]Descrip.MMS
+	@ If F$Search("[.lib]auto.dir").eqs."" Then Create/Directory [.lib.auto]
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+[.lib.auto.Fcntl]Fcntl$(E) : [.ext.Fcntl]Descrip.MMS
+	@ Set Default [.ext.Fcntl]
+	$(MMS)
+	@ Set Default [--]
+
+# Add "-I[--.lib]" t $(MINIPERL) so we use this copy of lib after C<chdir>
+# ${@} necessary to distract different versions of MM[SK]/make
+[.ext.Fcntl]Descrip.MMS : [.ext.Fcntl]Makefile.PL $(ARCHDIR)Config.pm [.lib.VMS]Filespec.pm [.lib]DynaLoader.pm perlshr$(E)
+	$(MINIPERL) "-I[--.lib]" -e "chdir('[.ext.Fcntl]') or die $!; do 'Makefile.PL'; print ${@} if ${@};" "INST_LIB=[--.lib]" "INST_ARCHLIB=[--.lib]"
+
+[.lib.VMS]Filespec.pm : [.vms.ext]Filespec.pm
+	@ If F$Search("[.lib]VMS.Dir").eqs."" Then Create/Directory [.lib.VMS]
+	Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perldoc : [.utils]perldoc.PL $(ARCHDIR)Config.pm
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) $(MMS$SOURCE)
+	Copy/Log [.utils]perldoc $(MMS$TARGET)
+
+[.lib.ExtUtils]Miniperl.pm : Minimod.PL miniperlmain.c $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE) >$(MMS$TARGET)
+
+[.utils]c2ph : [.utils]c2ph.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+
+[.utils]h2ph : [.utils]h2ph.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+
+[.utils]h2xs : [.utils]h2xs.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+
+[.lib]perlbug : [.utils]perlbug.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+	Rename/Log [.utils]perlbug $(MMS$TARGET)
+
+[.utils]pl2pm : [.utils]pl2pm.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) $(MMS$SOURCE)
+
+[.lib.pod]pod2html : [.pod]pod2html.PL $(ARCHDIR)Config.pm
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) $(MMS$SOURCE)
+	Rename/Log [.pod]pod2html $(MMS$TARGET)
+
+[.lib.pod]pod2latex : [.pod]pod2latex.PL $(ARCHDIR)Config.pm
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) $(MMS$SOURCE)
+	Rename/Log [.pod]pod2latex $(MMS$TARGET)
+
+[.lib.pod]pod2man : [.pod]pod2man.PL $(ARCHDIR)Config.pm
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) $(MMS$SOURCE)
+	Rename/Log [.pod]pod2man $(MMS$TARGET)
+
+[.lib.pod]pod2text : [.pod]pod2text.PL $(ARCHDIR)Config.pm
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	$(MINIPERL) $(MMS$SOURCE)
+	Rename/Log [.pod]pod2text $(MMS$TARGET)
+
+preplibrary : $(MINIPERL_EXE) $(ARCHDIR)Config.pm [.lib]DynaLoader.pm [.lib.VMS]Filespec.pm $(SOCKPM)
+	@ Write Sys$Output "Autosplitting Perl library . . ."
+	@ Create/Directory [.lib.auto]
+	@ $(MINIPERL) -e "use AutoSplit; autosplit_lib_modules(@ARGV)" [.lib]*.pm [.lib.*]*.pm
+
+[.lib.pod]perl.pod : [.pod]perl.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlbook.pod : [.pod]perlbook.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlbot.pod : [.pod]perlbot.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlcall.pod : [.pod]perlcall.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perldata.pod : [.pod]perldata.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perldebug.pod : [.pod]perldebug.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perldiag.pod : [.pod]perldiag.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perldsc.pod : [.pod]perldsc.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlembed.pod : [.pod]perlembed.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlform.pod : [.pod]perlform.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlfunc.pod : [.pod]perlfunc.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlguts.pod : [.pod]perlguts.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlipc.pod : [.pod]perlipc.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perllol.pod : [.pod]perllol.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlmod.pod : [.pod]perlmod.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlobj.pod : [.pod]perlobj.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlop.pod : [.pod]perlop.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlovl.pod : [.pod]perlovl.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlpod.pod : [.pod]perlpod.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlre.pod : [.pod]perlre.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlref.pod : [.pod]perlref.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlrun.pod : [.pod]perlrun.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlsec.pod : [.pod]perlsec.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlstyle.pod : [.pod]perlstyle.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlsub.pod : [.pod]perlsub.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlsyn.pod : [.pod]perlsyn.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perltie.pod : [.pod]perltie.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perltoc.pod : [.pod]perltoc.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perltrap.pod : [.pod]perltrap.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlvar.pod : [.pod]perlvar.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlxs.pod : [.pod]perlxs.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlxstut.pod : [.pod]perlxstut.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+[.lib.pod]perlvms.pod : [.vms]perlvms.pod
+	@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
+	@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+printconfig :
+        @ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS)
+        @ @[.vms]myconfig "$(CC)" "$(CFLAGS)" "$(LINKFLAGS)" "$(LIBS1)" "$(LIBS2)" "$(SOCKLIB)" "$(EXT)" "$(DBG)"
+
+.ifdef SOCKET
+
+.ifdef LINK_ONLY
+.else
+$(SOCKOBJ) : $(SOCKC) $(SOCKH)
+
+[.ext.Socket]Socket$(O) : [.ext.Socket]Socket.c
+	$(CC) $(CFLAGS) /Object=$(MMS$TARGET) $(MMS$SOURCE)
+
+[.ext.Socket]Socket.c : [.ext.Socket]Socket.xs $(MINIPERL_EXE)
+	$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
+.endif # !LINK_ONLY
+
+vmsish.h : $(SOCKH)
+
+$(SOCKC) : [.vms]$(SOCKC)
+	Copy/Log/NoConfirm [.vms]$(SOCKC) []$(SOCKC)
+
+$(SOCKH) : [.vms]$(SOCKH)
+	Copy/Log/NoConfirm [.vms]$(SOCKH) []$(SOCKH)
+
+[.lib]Socket.pm : [.ext.Socket]Socket.pm
+	Copy/Log/NoConfirm $(MMS$SOURCE) $(MMS$TARGET)
+.endif
+
+# The following three header files are generated automatically
+#	keywords.h :	keywords.pl
+#	opcode.h :	opcode.pl
+#	embed.h :	embed.pl global.sym interp.sym
+# The correct versions should be already supplied with the perl kit,
+# in case you don't have perl available.
+# To force them to run, type
+#	MMS regen_headers
+regen_headers :
+	$(INSTPERL) keywords.pl
+	$(INSTPERL) opcode.pl
+	$(INSTPERL) embed.pl
+
+# VMS uses modified perly.[ch] with tags for globaldefs if using DEC compiler
+perly.c : [.vms]perly_c.vms
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+perly.h : [.vms]perly_h.vms
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+
+# I now supply perly.c with the kits, so the following section is
+# commented out if you don't have byacc.
+# Altered for VMS by Charles Bailey  bailey@genetics.upenn.edu
+# perly.c:
+# 	@ Write Sys$Output "Expect 80 shift/reduce and 62 reduce/reduce conflicts"
+# 	\$(BYACC) -d perly.y
+# Has to be done by hand or by POSIX shell under VMS
+# 	sh \$(shellflags) ./perly.fixer y.tab.c perly.c
+# 	rename y.tab.h perly.h
+# 	$(INSTPERL) [.vms]vms_yfix.pl perly.c perly.h [.vms]perly_c.vms [.vms]perly_h.vms
+
+.ifdef LINK_ONLY
+.else
+perly$(O) : perly.c, perly.h, $(h)
+	$(CC) $(CFLAGS) $(MMS$SOURCE)
+.endif
+
+test : all
+	- @[.VMS]Test.Com
+
+# CORE subset for MakeMaker, so we can build Perl without sources
+# Should move to VMS installperl when we get one
+$(ARCHCORE)EXTERN.h : EXTERN.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)INTERN.h : INTERN.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)XSUB.h : XSUB.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)av.h : av.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)config.h : config.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)cop.h : cop.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)cv.h : cv.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)embed.h : embed.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)form.h : form.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)gv.h : gv.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)handy.h : handy.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)hv.h : hv.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)keywords.h : keywords.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)mg.h : mg.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)op.h : op.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)opcode.h : opcode.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)patchlevel.h : patchlevel.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perl.h : perl.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perly.h : perly.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)pp.h : pp.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)proto.h : proto.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)regcomp.h : regcomp.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)regexp.h : regexp.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)scope.h : scope.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)sv.h : sv.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)util.h : util.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)vmsish.h : vmsish.h
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+.ifdef SOCKET
+$(ARCHCORE)$(SOCKH) : $(SOCKH)
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+.endif
+$(ARCHCORE)$(DBG)libperl$(OLB) : $(DBG)libperl$(OLB) $(DBG)perlshr_xtras.ts
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+$(ARCHCORE)perlshr_attr.opt : $(DBG)perlshr_xtras.ts
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log perlshr_attr.opt $(MMS$TARGET)
+$(ARCHCORE)$(DBG)perlshr_bld.opt : $(DBG)perlshr_xtras.ts
+	@ If F$Search("$(ARCHDIR)CORE.dir").eqs."" Then Create/Directory $(ARCHCORE)
+	Copy/Log $(DBG)perlshr_bld.opt $(MMS$TARGET)
+$(ARCHAUTO)time.stamp :
+	@ If F$Search("$(ARCHDIR)auto.dir").eqs."" Then Create/Directory $(ARCHAUTO)
+	@ If F$Search("$(MMS$TARGET)").eqs."" Then Copy/NoConfirm _NLA0: $(MMS$TARGET)
+
+.ifdef LINK_ONLY
+.else
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+av$(O) : EXTERN.h
+av$(O) : av.c
+av$(O) : av.h
+av$(O) : config.h
+av$(O) : cop.h
+av$(O) : cv.h
+av$(O) : embed.h
+av$(O) : form.h
+av$(O) : gv.h
+av$(O) : handy.h
+av$(O) : hv.h
+av$(O) : mg.h
+av$(O) : op.h
+av$(O) : opcode.h
+av$(O) : perl.h
+av$(O) : perly.h
+av$(O) : pp.h
+av$(O) : proto.h
+av$(O) : regexp.h
+av$(O) : scope.h
+av$(O) : sv.h
+av$(O) : vmsish.h
+av$(O) : util.h
+scope$(O) : EXTERN.h
+scope$(O) : av.h
+scope$(O) : config.h
+scope$(O) : cop.h
+scope$(O) : cv.h
+scope$(O) : embed.h
+scope$(O) : form.h
+scope$(O) : gv.h
+scope$(O) : handy.h
+scope$(O) : hv.h
+scope$(O) : mg.h
+scope$(O) : op.h
+scope$(O) : opcode.h
+scope$(O) : perl.h
+scope$(O) : perly.h
+scope$(O) : pp.h
+scope$(O) : proto.h
+scope$(O) : regexp.h
+scope$(O) : scope.c
+scope$(O) : scope.h
+scope$(O) : sv.h
+scope$(O) : vmsish.h
+scope$(O) : util.h
+op$(O) : EXTERN.h
+op$(O) : av.h
+op$(O) : config.h
+op$(O) : cop.h
+op$(O) : cv.h
+op$(O) : embed.h
+op$(O) : form.h
+op$(O) : gv.h
+op$(O) : handy.h
+op$(O) : hv.h
+op$(O) : mg.h
+op$(O) : op.c
+op$(O) : op.h
+op$(O) : opcode.h
+op$(O) : perl.h
+op$(O) : perly.h
+op$(O) : pp.h
+op$(O) : proto.h
+op$(O) : regexp.h
+op$(O) : scope.h
+op$(O) : sv.h
+op$(O) : vmsish.h
+op$(O) : util.h
+doop$(O) : EXTERN.h
+doop$(O) : av.h
+doop$(O) : config.h
+doop$(O) : cop.h
+doop$(O) : cv.h
+doop$(O) : doop.c
+doop$(O) : embed.h
+doop$(O) : form.h
+doop$(O) : gv.h
+doop$(O) : handy.h
+doop$(O) : hv.h
+doop$(O) : mg.h
+doop$(O) : op.h
+doop$(O) : opcode.h
+doop$(O) : perl.h
+doop$(O) : perly.h
+doop$(O) : pp.h
+doop$(O) : proto.h
+doop$(O) : regexp.h
+doop$(O) : scope.h
+doop$(O) : sv.h
+doop$(O) : vmsish.h
+doop$(O) : util.h
+doio$(O) : EXTERN.h
+doio$(O) : av.h
+doio$(O) : config.h
+doio$(O) : cop.h
+doio$(O) : cv.h
+doio$(O) : doio.c
+doio$(O) : embed.h
+doio$(O) : form.h
+doio$(O) : gv.h
+doio$(O) : handy.h
+doio$(O) : hv.h
+doio$(O) : mg.h
+doio$(O) : op.h
+doio$(O) : opcode.h
+doio$(O) : perl.h
+doio$(O) : perly.h
+doio$(O) : pp.h
+doio$(O) : proto.h
+doio$(O) : regexp.h
+doio$(O) : scope.h
+doio$(O) : sv.h
+doio$(O) : vmsish.h
+doio$(O) : util.h
+dump$(O) : EXTERN.h
+dump$(O) : av.h
+dump$(O) : config.h
+dump$(O) : cop.h
+dump$(O) : cv.h
+dump$(O) : dump.c
+dump$(O) : embed.h
+dump$(O) : form.h
+dump$(O) : gv.h
+dump$(O) : handy.h
+dump$(O) : hv.h
+dump$(O) : mg.h
+dump$(O) : op.h
+dump$(O) : opcode.h
+dump$(O) : perl.h
+dump$(O) : perly.h
+dump$(O) : pp.h
+dump$(O) : proto.h
+dump$(O) : regexp.h
+dump$(O) : scope.h
+dump$(O) : sv.h
+dump$(O) : vmsish.h
+dump$(O) : util.h
+hv$(O) : EXTERN.h
+hv$(O) : av.h
+hv$(O) : config.h
+hv$(O) : cop.h
+hv$(O) : cv.h
+hv$(O) : embed.h
+hv$(O) : form.h
+hv$(O) : gv.h
+hv$(O) : handy.h
+hv$(O) : hv.c
+hv$(O) : hv.h
+hv$(O) : mg.h
+hv$(O) : op.h
+hv$(O) : opcode.h
+hv$(O) : perl.h
+hv$(O) : perly.h
+hv$(O) : pp.h
+hv$(O) : proto.h
+hv$(O) : regexp.h
+hv$(O) : scope.h
+hv$(O) : sv.h
+hv$(O) : vmsish.h
+hv$(O) : util.h
+mg$(O) : EXTERN.h
+mg$(O) : av.h
+mg$(O) : config.h
+mg$(O) : cop.h
+mg$(O) : cv.h
+mg$(O) : embed.h
+mg$(O) : form.h
+mg$(O) : gv.h
+mg$(O) : handy.h
+mg$(O) : hv.h
+mg$(O) : mg.c
+mg$(O) : mg.h
+mg$(O) : op.h
+mg$(O) : opcode.h
+mg$(O) : perl.h
+mg$(O) : perly.h
+mg$(O) : pp.h
+mg$(O) : proto.h
+mg$(O) : regexp.h
+mg$(O) : scope.h
+mg$(O) : sv.h
+mg$(O) : vmsish.h
+mg$(O) : util.h
+perl$(O) : EXTERN.h
+perl$(O) : av.h
+perl$(O) : config.h
+perl$(O) : cop.h
+perl$(O) : cv.h
+perl$(O) : embed.h
+perl$(O) : form.h
+perl$(O) : gv.h
+perl$(O) : handy.h
+perl$(O) : hv.h
+perl$(O) : mg.h
+perl$(O) : op.h
+perl$(O) : opcode.h
+perl$(O) : perl.c
+perl$(O) : perl.h
+perl$(O) : perly.h
+perl$(O) : pp.h
+perl$(O) : proto.h
+perl$(O) : regexp.h
+perl$(O) : scope.h
+perl$(O) : sv.h
+perl$(O) : vmsish.h
+perl$(O) : util.h
+perly$(O) : EXTERN.h
+perly$(O) : av.h
+perly$(O) : config.h
+perly$(O) : cop.h
+perly$(O) : cv.h
+perly$(O) : embed.h
+perly$(O) : form.h
+perly$(O) : gv.h
+perly$(O) : handy.h
+perly$(O) : hv.h
+perly$(O) : mg.h
+perly$(O) : op.h
+perly$(O) : opcode.h
+perly$(O) : perl.h
+perly$(O) : perly.h
+perly$(O) : perly.c
+perly$(O) : pp.h
+perly$(O) : proto.h
+perly$(O) : regexp.h
+perly$(O) : scope.h
+perly$(O) : sv.h
+perly$(O) : vmsish.h
+perly$(O) : util.h
+pp$(O) : EXTERN.h
+pp$(O) : av.h
+pp$(O) : config.h
+pp$(O) : cop.h
+pp$(O) : cv.h
+pp$(O) : embed.h
+pp$(O) : form.h
+pp$(O) : gv.h
+pp$(O) : handy.h
+pp$(O) : hv.h
+pp$(O) : mg.h
+pp$(O) : op.h
+pp$(O) : opcode.h
+pp$(O) : perl.h
+pp$(O) : perly.h
+pp$(O) : pp.c
+pp$(O) : pp.h
+pp$(O) : proto.h
+pp$(O) : regexp.h
+pp$(O) : scope.h
+pp$(O) : sv.h
+pp$(O) : vmsish.h
+pp$(O) : util.h
+pp_ctl$(O) : EXTERN.h
+pp_ctl$(O) : av.h
+pp_ctl$(O) : config.h
+pp_ctl$(O) : cop.h
+pp_ctl$(O) : cv.h
+pp_ctl$(O) : embed.h
+pp_ctl$(O) : form.h
+pp_ctl$(O) : gv.h
+pp_ctl$(O) : handy.h
+pp_ctl$(O) : hv.h
+pp_ctl$(O) : mg.h
+pp_ctl$(O) : op.h
+pp_ctl$(O) : opcode.h
+pp_ctl$(O) : perl.h
+pp_ctl$(O) : perly.h
+pp_ctl$(O) : pp_ctl.c
+pp_ctl$(O) : pp.h
+pp_ctl$(O) : proto.h
+pp_ctl$(O) : regexp.h
+pp_ctl$(O) : scope.h
+pp_ctl$(O) : sv.h
+pp_ctl$(O) : vmsish.h
+pp_ctl$(O) : util.h
+pp_hot$(O) : EXTERN.h
+pp_hot$(O) : av.h
+pp_hot$(O) : config.h
+pp_hot$(O) : cop.h
+pp_hot$(O) : cv.h
+pp_hot$(O) : embed.h
+pp_hot$(O) : form.h
+pp_hot$(O) : gv.h
+pp_hot$(O) : handy.h
+pp_hot$(O) : hv.h
+pp_hot$(O) : mg.h
+pp_hot$(O) : op.h
+pp_hot$(O) : opcode.h
+pp_hot$(O) : perl.h
+pp_hot$(O) : perly.h
+pp_hot$(O) : pp_hot.c
+pp_hot$(O) : pp.h
+pp_hot$(O) : proto.h
+pp_hot$(O) : regexp.h
+pp_hot$(O) : scope.h
+pp_hot$(O) : sv.h
+pp_hot$(O) : vmsish.h
+pp_hot$(O) : util.h
+pp_sys$(O) : EXTERN.h
+pp_sys$(O) : av.h
+pp_sys$(O) : config.h
+pp_sys$(O) : cop.h
+pp_sys$(O) : cv.h
+pp_sys$(O) : embed.h
+pp_sys$(O) : form.h
+pp_sys$(O) : gv.h
+pp_sys$(O) : handy.h
+pp_sys$(O) : hv.h
+pp_sys$(O) : mg.h
+pp_sys$(O) : op.h
+pp_sys$(O) : opcode.h
+pp_sys$(O) : perl.h
+pp_sys$(O) : perly.h
+pp_sys$(O) : pp_sys.c
+pp_sys$(O) : pp.h
+pp_sys$(O) : proto.h
+pp_sys$(O) : regexp.h
+pp_sys$(O) : scope.h
+pp_sys$(O) : sv.h
+pp_sys$(O) : vmsish.h
+pp_sys$(O) : util.h
+regcomp$(O) : EXTERN.h
+regcomp$(O) : INTERN.h
+regcomp$(O) : av.h
+regcomp$(O) : config.h
+regcomp$(O) : cop.h
+regcomp$(O) : cv.h
+regcomp$(O) : embed.h
+regcomp$(O) : form.h
+regcomp$(O) : gv.h
+regcomp$(O) : handy.h
+regcomp$(O) : hv.h
+regcomp$(O) : mg.h
+regcomp$(O) : op.h
+regcomp$(O) : opcode.h
+regcomp$(O) : perl.h
+regcomp$(O) : perly.h
+regcomp$(O) : pp.h
+regcomp$(O) : proto.h
+regcomp$(O) : regcomp.c
+regcomp$(O) : regcomp.h
+regcomp$(O) : regexp.h
+regcomp$(O) : scope.h
+regcomp$(O) : sv.h
+regcomp$(O) : vmsish.h
+regcomp$(O) : util.h
+regexec$(O) : EXTERN.h
+regexec$(O) : av.h
+regexec$(O) : config.h
+regexec$(O) : cop.h
+regexec$(O) : cv.h
+regexec$(O) : embed.h
+regexec$(O) : form.h
+regexec$(O) : gv.h
+regexec$(O) : handy.h
+regexec$(O) : hv.h
+regexec$(O) : mg.h
+regexec$(O) : op.h
+regexec$(O) : opcode.h
+regexec$(O) : perl.h
+regexec$(O) : perly.h
+regexec$(O) : pp.h
+regexec$(O) : proto.h
+regexec$(O) : regcomp.h
+regexec$(O) : regexec.c
+regexec$(O) : regexp.h
+regexec$(O) : scope.h
+regexec$(O) : sv.h
+regexec$(O) : vmsish.h
+regexec$(O) : util.h
+gv$(O) : EXTERN.h
+gv$(O) : av.h
+gv$(O) : config.h
+gv$(O) : cop.h
+gv$(O) : cv.h
+gv$(O) : embed.h
+gv$(O) : form.h
+gv$(O) : gv.c
+gv$(O) : gv.h
+gv$(O) : handy.h
+gv$(O) : hv.h
+gv$(O) : mg.h
+gv$(O) : op.h
+gv$(O) : opcode.h
+gv$(O) : perl.h
+gv$(O) : perly.h
+gv$(O) : pp.h
+gv$(O) : proto.h
+gv$(O) : regexp.h
+gv$(O) : scope.h
+gv$(O) : sv.h
+gv$(O) : vmsish.h
+gv$(O) : util.h
+sv$(O) : EXTERN.h
+sv$(O) : av.h
+sv$(O) : config.h
+sv$(O) : cop.h
+sv$(O) : cv.h
+sv$(O) : embed.h
+sv$(O) : form.h
+sv$(O) : gv.h
+sv$(O) : handy.h
+sv$(O) : hv.h
+sv$(O) : mg.h
+sv$(O) : op.h
+sv$(O) : opcode.h
+sv$(O) : perl.h
+sv$(O) : perly.h
+sv$(O) : pp.h
+sv$(O) : proto.h
+sv$(O) : regexp.h
+sv$(O) : scope.h
+sv$(O) : sv.c
+sv$(O) : sv.h
+sv$(O) : vmsish.h
+sv$(O) : util.h
+taint$(O) : EXTERN.h
+taint$(O) : av.h
+taint$(O) : config.h
+taint$(O) : cop.h
+taint$(O) : cv.h
+taint$(O) : embed.h
+taint$(O) : form.h
+taint$(O) : gv.h
+taint$(O) : handy.h
+taint$(O) : hv.h
+taint$(O) : mg.h
+taint$(O) : op.h
+taint$(O) : opcode.h
+taint$(O) : perl.h
+taint$(O) : perly.h
+taint$(O) : pp.h
+taint$(O) : proto.h
+taint$(O) : regexp.h
+taint$(O) : scope.h
+taint$(O) : sv.h
+taint$(O) : taint.c
+taint$(O) : vmsish.h
+taint$(O) : util.h
+toke$(O) : EXTERN.h
+toke$(O) : av.h
+toke$(O) : config.h
+toke$(O) : cop.h
+toke$(O) : cv.h
+toke$(O) : embed.h
+toke$(O) : form.h
+toke$(O) : gv.h
+toke$(O) : handy.h
+toke$(O) : hv.h
+toke$(O) : keywords.h
+toke$(O) : mg.h
+toke$(O) : op.h
+toke$(O) : opcode.h
+toke$(O) : perl.h
+toke$(O) : perly.h
+toke$(O) : pp.h
+toke$(O) : proto.h
+toke$(O) : regexp.h
+toke$(O) : scope.h
+toke$(O) : sv.h
+toke$(O) : toke.c
+toke$(O) : vmsish.h
+toke$(O) : util.h
+util$(O) : EXTERN.h
+util$(O) : av.h
+util$(O) : config.h
+util$(O) : cop.h
+util$(O) : cv.h
+util$(O) : embed.h
+util$(O) : form.h
+util$(O) : gv.h
+util$(O) : handy.h
+util$(O) : hv.h
+util$(O) : mg.h
+util$(O) : op.h
+util$(O) : opcode.h
+util$(O) : perl.h
+util$(O) : perly.h
+util$(O) : pp.h
+util$(O) : proto.h
+util$(O) : regexp.h
+util$(O) : scope.h
+util$(O) : sv.h
+util$(O) : vmsish.h
+util$(O) : util.c
+util$(O) : util.h
+deb$(O) : EXTERN.h
+deb$(O) : av.h
+deb$(O) : config.h
+deb$(O) : cop.h
+deb$(O) : cv.h
+deb$(O) : deb.c
+deb$(O) : embed.h
+deb$(O) : form.h
+deb$(O) : gv.h
+deb$(O) : handy.h
+deb$(O) : hv.h
+deb$(O) : mg.h
+deb$(O) : op.h
+deb$(O) : opcode.h
+deb$(O) : perl.h
+deb$(O) : perly.h
+deb$(O) : pp.h
+deb$(O) : proto.h
+deb$(O) : regexp.h
+deb$(O) : scope.h
+deb$(O) : sv.h
+deb$(O) : vmsish.h
+deb$(O) : util.h
+run$(O) : EXTERN.h
+run$(O) : av.h
+run$(O) : config.h
+run$(O) : cop.h
+run$(O) : cv.h
+run$(O) : embed.h
+run$(O) : form.h
+run$(O) : gv.h
+run$(O) : handy.h
+run$(O) : hv.h
+run$(O) : mg.h
+run$(O) : op.h
+run$(O) : opcode.h
+run$(O) : perl.h
+run$(O) : perly.h
+run$(O) : pp.h
+run$(O) : proto.h
+run$(O) : regexp.h
+run$(O) : run.c
+run$(O) : scope.h
+run$(O) : sv.h
+run$(O) : vmsish.h
+run$(O) : util.h
+vms$(O) : EXTERN.h
+vms$(O) : av.h
+vms$(O) : config.h
+vms$(O) : cop.h
+vms$(O) : cv.h
+vms$(O) : embed.h
+vms$(O) : form.h
+vms$(O) : gv.h
+vms$(O) : handy.h
+vms$(O) : hv.h
+vms$(O) : mg.h
+vms$(O) : op.h
+vms$(O) : opcode.h
+vms$(O) : perl.h
+vms$(O) : perly.h
+vms$(O) : pp.h
+vms$(O) : proto.h
+vms$(O) : regexp.h
+vms$(O) : vms.c
+vms$(O) : scope.h
+vms$(O) : sv.h
+vms$(O) : vmsish.h
+vms$(O) : util.h
+miniperlmain$(O) : EXTERN.h
+miniperlmain$(O) : av.h
+miniperlmain$(O) : config.h
+miniperlmain$(O) : cop.h
+miniperlmain$(O) : cv.h
+miniperlmain$(O) : embed.h
+miniperlmain$(O) : form.h
+miniperlmain$(O) : gv.h
+miniperlmain$(O) : handy.h
+miniperlmain$(O) : hv.h
+miniperlmain$(O) : mg.h
+miniperlmain$(O) : miniperlmain.c
+miniperlmain$(O) : op.h
+miniperlmain$(O) : opcode.h
+miniperlmain$(O) : perl.h
+miniperlmain$(O) : perly.h
+miniperlmain$(O) : pp.h
+miniperlmain$(O) : proto.h
+miniperlmain$(O) : regexp.h
+miniperlmain$(O) : scope.h
+miniperlmain$(O) : sv.h
+miniperlmain$(O) : vmsish.h
+miniperlmain$(O) : util.h
+perlmain$(O) : EXTERN.h
+perlmain$(O) : av.h
+perlmain$(O) : config.h
+perlmain$(O) : cop.h
+perlmain$(O) : cv.h
+perlmain$(O) : embed.h
+perlmain$(O) : form.h
+perlmain$(O) : gv.h
+perlmain$(O) : handy.h
+perlmain$(O) : hv.h
+perlmain$(O) : mg.h
+perlmain$(O) : op.h
+perlmain$(O) : opcode.h
+perlmain$(O) : perl.h
+perlmain$(O) : perly.h
+perlmain$(O) : perlmain.c
+perlmain$(O) : pp.h
+perlmain$(O) : proto.h
+perlmain$(O) : regexp.h
+perlmain$(O) : scope.h
+perlmain$(O) : sv.h
+perlmain$(O) : vmsish.h
+perlmain$(O) : util.h
+globals$(O) : INTERN.h
+globals$(O) : av.h
+globals$(O) : config.h
+globals$(O) : cop.h
+globals$(O) : cv.h
+globals$(O) : embed.h
+globals$(O) : form.h
+globals$(O) : gv.h
+globals$(O) : handy.h
+globals$(O) : hv.h
+globals$(O) : mg.h
+globals$(O) : op.h
+globals$(O) : opcode.h
+globals$(O) : perl.h
+globals$(O) : perly.h
+globals$(O) : globals.c
+globals$(O) : pp.h
+globals$(O) : proto.h
+globals$(O) : regexp.h
+globals$(O) : scope.h
+globals$(O) : sv.h
+globals$(O) : vmsish.h
+globals$(O) : util.h
+.endif # !LINK_ONLY
+
+config.h : [.vms]config.vms
+	Copy/Log/NoConfirm [.vms]config.vms []config.h
+
+vmsish.h : [.vms]vmsish.h
+	Copy/Log/NoConfirm [.vms]vmsish.h []vmsish.h
+
+vms.c : [.vms]vms.c
+	Copy/Log/Noconfirm [.vms]vms.c []
+
+$(CRTL) : $(MAKEFILE)
+	@ @[.vms]genopt "$(CRTL)/Write" "|" "$(LIBS1)|$(LIBS2)|$(SOCKLIB)"
+
+
+cleanlis :
+	- If F$Search("*.Lis").nes."" Then Delete/NoConfirm/Log *.Lis;*
+	- If F$Search("*.CPP").nes."" Then Delete/NoConfirm/Log *.CPP;*
+	- If F$Search("*.Map").nes."" Then Delete/NoConfirm/Log *.Map;*
+
+tidy : cleanlis
+	- If F$Search("*.Opt;-1").nes."" Then Purge/NoConfirm/Log *.Opt
+	- If F$Search("*$(O);-1").nes."" Then Purge/NoConfirm/Log *$(O)
+	- If F$Search("*$(E);-1").nes."" Then Purge/NoConfirm/Log *$(E)
+	- If F$Search("Config.H;-1").nes."" Then Purge/NoConfirm/Log Config.H
+	- If F$Search("Config.SH;-1").nes."" Then Purge/NoConfirm/Log Config.SH
+	- If F$Search("perly.c;-1").nes."" Then Purge/NoConfirm/Log perly.c
+	- If F$Search("perly.h;-1").nes."" Then Purge/NoConfirm/Log perly.h
+	- If F$Search("VMSish.H;-1").nes."" Then Purge/NoConfirm/Log VMSish.H
+	- If F$Search("VMS.C;-1")   .nes."" Then Purge/NoConfirm/Log VMS.C
+	- If F$Search("Perlmain.C;-1")   .nes."" Then Purge/NoConfirm/Log Perlmain.C
+	- If F$Search("Perlshr_Gbl*.Mar;-1")   .nes."" Then Purge/NoConfirm/Log Perlshr_Gbl*.Mar
+	- If F$Search("[.Ext.DynaLoader]DL_VMS$(O);-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O)
+	- If F$Search("[.Ext.DynaLoader]DL_VMS.C;-1").nes."" Then Purge/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C
+	- If F$Search("[.Ext.Safe...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.Safe]
+	- If F$Search("[.Ext.FileHandle...];-1").nes."" Then Purge/NoConfirm/Log [.Ext.FileHandle]
+	- If F$Search("[.VMS.Ext...]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*.C
+	- If F$Search("[.VMS.Ext...]*$(O);-1").nes."" Then Purge/NoConfirm/Log [.VMS.Ext...]*$(O)
+	- If F$Search("[.Lib.Auto...]*.al;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]*.al
+	- If F$Search("[.Lib.Auto...]autosplit.ix;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Auto...]autosplit.ix
+	- If F$Search("[.Lib]DynaLoader.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]DynaLoader.pm
+	- If F$Search("[.Lib]Socket.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Socket.pm
+	- If F$Search("[.Lib]Config.pm;-1").nes."" Then Purge/NoConfirm/Log [.Lib]Config.pm
+	- If F$Search("$(ARCHDIR)Config.pm;-1").nes."" Then Purge/NoConfirm/Log $(ARCHDIR)Config.pm
+	- If F$Search("[.Lib.VMS]*.*;-1").nes."" Then Purge/NoConfirm/Log [.Lib.VMS]*.*
+	- If F$Search("[.Lib.Pod]*.Pod;-1").nes."" Then Purge/NoConfirm/Log [.Lib.Pod]*.Pod
+	- If F$Search("$(ARCHCORE)*.*").nes."" Then Purge/NoConfirm/Log $(ARCHCORE)*.*
+	- If F$Search("[.utils]*.;-1").nes."" Then Purge/NoConfirm/Log [.utils]*.
+	- If F$Search("[.lib.pod]*.;-1").nes."" Then Purge/NoConfirm/Log [.lib.pod]*.
+
+clean : tidy
+	Set Default [.ext.Fcntl]
+	- $(MMS) clean
+	Set Default [--]
+	Set Default [.ext.FileHandle]
+	- $(MMS) clean
+	Set Default [--]
+	Set Default [.ext.Safe]
+	- $(MMS) clean
+	Set Default [--]
+	- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*/Exclude=PerlShr_*.Opt
+	- If F$Search("*$(O);*") .nes."" Then Delete/NoConfirm/Log *$(O);*
+	- If F$Search("Config.H").nes."" Then Delete/NoConfirm/Log Config.H;*
+	- If F$Search("Config.SH").nes."" Then Delete/NoConfirm/Log Config.SH;*
+	- If F$Search(F$Parse("Sys$Disk:[]","$(SOCKH)")).nes."" Then Delete/NoConfirm/Log $(SOCKH);*
+	- If F$Search(F$Parse("Sys$Disk:[]","$(SOCKC)")).nes."" Then Delete/NoConfirm/Log $(SOCKC);*
+	- If F$Search("perly.c").nes."" Then Delete/NoConfirm/Log perly.c;*
+	- If F$Search("perly.h").nes."" Then Delete/NoConfirm/Log perly.h;*
+	- If F$Search("VMSish.H").nes."" Then Delete/NoConfirm/Log VMSish.H;*
+	- If F$Search("VMS.C")   .nes."" Then Delete/NoConfirm/Log VMS.C;*
+	- If F$Search("Perlmain.C")   .nes."" Then Delete/NoConfirm/Log Perlmain.C;*
+	- If F$Search("Perlshr_Gbl*.Mar")   .nes."" Then Delete/NoConfirm/Log Perlshr_Gbl*.Mar;*
+	- If F$Search("*.TS").nes."" Then Delete/NoConfirm/Log *.TS;*
+	- If F$Search("[.Ext.DynaLoader]DL_VMS$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS$(O);*
+	- If F$Search("[.Ext.DynaLoader]DL_VMS.C").nes."" Then Delete/NoConfirm/Log [.Ext.DynaLoader]DL_VMS.C;*
+	- If F$Search("[.Ext.Socket]Socket$(O)").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket$(O);*
+	- If F$Search("[.Ext.Socket]Socket.C").nes."" Then Delete/NoConfirm/Log [.Ext.Socket]Socket.C;*
+	- If F$Search("[.VMS.Ext...]*.C").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*.C;*
+	- If F$Search("[.VMS.Ext...]*$(O)").nes."" Then Delete/NoConfirm/Log [.VMS.Ext...]*$(O);*
+
+realclean : clean
+	Set Default [.ext.Fcntl]
+	- $(MMS) realclean
+	Set Default [--]
+	Set Default [.ext.FileHandle]
+	- $(MMS) realclean
+	Set Default [--]
+	Set Default [.ext.Safe]
+	- $(MMS) realclean
+	Set Default [--]
+	- If F$Search("*$(OLB)").nes."" Then Delete/NoConfirm/Log *$(OLB);*
+	- If F$Search("*.Opt").nes."" Then Delete/NoConfirm/Log *.Opt;*
+	- $(MINIPERL) -e "use File::Path; rmtree(['lib/auto','lib/VMS','lib/$(ARCH)'],1,0);"
+	- If F$Search("[.Lib]DynaLoader.pm").nes."" Then Delete/NoConfirm/Log [.Lib]DynaLoader.pm;*
+	- If F$Search("[.Lib]Config.pm").nes."" Then Delete/NoConfirm/Log [.Lib]Config.pm;*
+	- If F$Search("[.Lib]perlbug.").nes."" Then Delete/NoConfirm/Log [.Lib]perlbug.;*
+	- If F$Search("$(ARCHDIR)Config.pm").nes."" Then Delete/NoConfirm/Log $(ARCHDIR)Config.pm;*
+	- If F$Search("[.lib.ExtUtils]Miniperl.pm").nes."" Then Delete/NoConfirm/Log [.lib.ExtUtils]Miniperl.pm;*
+	- If F$Search("[.utils]*.").nes."" Then Delete/NoConfirm/Log [.utils]*.;*
+	- If F$Search("[.lib.pod]*.pod").nes."" Then Delete/NoConfirm/Log [.lib.pod]*.pod;*
+	- If F$Search("[.lib.pod]perldoc.").nes."" Then Delete/NoConfirm/Log [.lib.pod]perldoc.;*
+	- If F$Search("[.lib.pod]pod2*.").nes."" Then Delete/NoConfirm/Log [.lib.pod]pod2*.;*
+	- If F$Search("*$(E)").nes."" Then Delete/NoConfirm/Log *$(E);*
+
+cleansrc : clean
+	- If F$Search("*.C;-1").nes."" Then Purge/NoConfirm/Log *.C
+	- If F$Search("*.H;-1").nes."" Then Purge/NoConfirm/Log *.H
+	- If F$Search("*.VMS;-1").nes."" Then Purge/NoConfirm/Log *.VMS
+	- If F$Search("[.VMS]$(MAKEFILE);-1").nes."" Then Purge/NoConfirm/Log [.VMS]$(MAKEFILE)
+	- If F$Search("[.VMS]*.C;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.C
+	- If F$Search("[.VMS]*.H;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.H
+	- If F$Search("[.VMS]*.Pl;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.Pl
+	- If F$Search("[.VMS]*.VMS;-1").nes."" Then Purge/NoConfirm/Log [.VMS]*.VMS
+	- If F$Search("[.VMS...]*.pm;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.pm
+	- If F$Search("[.VMS...]*.xs;-1").nes."" Then Purge/NoConfirm/Log [.VMS...]*.xs
diff --git a/gnu/usr.bin/perl/vms/ext/Filespec.pm b/gnu/usr.bin/perl/vms/ext/Filespec.pm
new file mode 100644
index 00000000000..3ce67aafdab
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Filespec.pm
@@ -0,0 +1,338 @@
+#   Perl hooks into the routines in vms.c for interconversion
+#   of VMS and Unix file specification syntax.
+#
+#   Version:  1.1
+#   Author:   Charles Bailey  bailey@genetics.upenn.edu
+#   Revised:  08-Mar-1995
+
+=head1 NAME
+
+VMS::Filespec - convert between VMS and Unix file specification syntax
+
+=head1 SYNOPSIS
+
+use VMS::Filespec;
+$vmsspec = vmsify('/my/Unix/file/specification');
+$unixspec = unixify('my:[VMS]file.specification');
+$path = pathify('my:[VMS.or.Unix.directory]specification.dir');
+$dirfile = fileify('my:[VMS.or.Unix.directory.specification]');
+$vmsdir = vmspath('my/VMS/or/Unix/directory/specification.dir');
+$unixdir = unixpath('my:[VMS.or.Unix.directory]specification.dir');
+candelete('my:[VMS.or.Unix]file.specification');
+
+=head1 DESCRIPTION
+
+This package provides routines to simplify conversion between VMS and
+Unix syntax when processing file specifications.  This is useful when
+porting scripts designed to run under either OS, and also allows you
+to take advantage of conveniences provided by either syntax (I<e.g.>
+ability to easily concatenate Unix-style specifications).  In
+addition, it provides an additional file test routine, C<candelete>,
+which determines whether you have delete access to a file.
+
+If you're running under VMS, the routines in this package are special,
+in that they're automatically made available to any Perl script,
+whether you're running F<miniperl> or the full F<perl>.  The C<use
+VMS::Filespec> or C<require VMS::Filespec; import VMS::Filespec ...>
+statement can be used to import the function names into the current
+package, but they're always available if you use the fully qualified
+name, whether or not you've mentioned the F<.pm> file in your script. 
+If you're running under another OS and have installed this package, it
+behaves like a normal Perl extension (in fact, you're using Perl
+substitutes to emulate the necessary VMS system calls).
+
+Each of these routines accepts a file specification in either VMS or
+Unix syntax, and returns the converted file specification, or C<undef>
+if an error occurs.  The conversions are, for the most part, simply
+string manipulations; the routines do not check the details of syntax
+(e.g. that only legal characters are used).  There is one exception:
+when running under VMS, conversions from VMS syntax use the $PARSE
+service to expand specifications, so illegal syntax, or a relative
+directory specification which extends above the tope of the current
+directory path (e.g [---.foo] when in dev:[dir.sub]) will cause
+errors.  In general, any legal file specification will be converted
+properly, but garbage input tends to produce garbage output.  
+
+Each of these routines is prototyped as taking a single scalar
+argument, so you can use them as unary operators in complex
+expressions (as long as you don't use the C<&> form of
+subroutine call, which bypasses prototype checking).
+
+
+The routines provided are:
+
+=head2 vmsify
+
+Converts a file specification to VMS syntax.
+
+=head2 unixify
+
+Converts a file specification to Unix syntax.
+
+=head2 pathify
+
+Converts a directory specification to a path - that is, a string you
+can prepend to a file name to form a valid file specification.  If the
+input file specification uses VMS syntax, the returned path does, too;
+likewise for Unix syntax (Unix paths are guaranteed to end with '/').
+Note that this routine will insist that the input be a legal directory
+file specification; the file type and version, if specified, must be
+F<.DIR;1>.  For compatibility with Unix usage, the type and version
+may also be omitted.
+
+=head2 fileify
+
+Converts a directory specification to the file specification of the
+directory file - that is, a string you can pass to functions like
+C<stat> or C<rmdir> to manipulate the directory file.  If the
+input directory specification uses VMS syntax, the returned file
+specification does, too; likewise for Unix syntax.  As with
+C<pathify>, the input file specification must have a type and
+version of F<.DIR;1>, or the type and version must be omitted.
+
+=head2 vmspath
+
+Acts like C<pathify>, but insures the returned path uses VMS syntax.
+
+=head2 unixpath
+
+Acts like C<pathify>, but insures the returned path uses Unix syntax.
+
+=head2 candelete
+
+Determines whether you have delete access to a file.  If you do, C<candelete>
+returns true.  If you don't, or its argument isn't a legal file specification,
+C<candelete> returns FALSE.  Unlike other file tests, the argument to
+C<candelete> must be a file name (not a FileHandle), and, since it's an XSUB,
+it's a list operator, so you need to be careful about parentheses.  Both of
+these restrictions may be removed in the future if the functionality of
+C<candelete> becomes part of the Perl core.
+
+=head1 REVISION
+
+This document was last revised 22-Feb-1996, for Perl 5.002.
+
+=cut
+
+package VMS::Filespec;
+require 5.002;
+
+
+# If you want to use this package on a non-VMS system,
+# uncomment the following line.
+# use AutoLoader;
+require Exporter;
+
+@ISA = qw( Exporter );
+@EXPORT = qw( &vmsify &unixify &pathify  &fileify
+              &vmspath &unixpath &candelete);
+
+@EXPORT_OK = qw( &rmsexpand );
+1;
+
+
+__END__
+
+
+# The autosplit routines here are provided for use by non-VMS systems
+# They are not guaranteed to function identically to the XSUBs of the
+# same name, since they do not have access to the RMS system routine
+# sys$parse() (in particular, no real provision is made for handling
+# of complex DECnet node specifications).  However, these routines
+# should be adequate for most purposes.
+
+# A sort-of sys$parse() replacement
+sub rmsexpand {
+  my($fspec,$defaults) = @_;
+  if (!$fspec) { return undef }
+  my($node,$dev,$dir,$name,$type,$ver,$dnode,$ddev,$ddir,$dname,$dtype,$dver);
+
+  $fspec =~ s/:$//;
+  $defaults = [] unless $defaults;
+  $defaults = [ $defaults ] unless ref($defaults) && ref($defaults) eq 'ARRAY';
+
+  while ($fspec !~ m#[:>\]]# && $ENV{$fspec}) { $fspec = $ENV{$fspec} }
+
+  if ($fspec =~ /:/) {
+    my($dev,$devtrn,$base);
+    ($dev,$base) = split(/:/,$fspec);
+    $devtrn = $dev;
+    while ($devtrn = $ENV{$devtrn}) {
+      if ($devtrn =~ /(.)([:>\]])$/) {
+        $dev .= ':', last if $1 eq '.';
+        $dev = $devtrn, last;
+      }
+    }
+    $fspec = $dev . $base;
+  }
+
+  ($node,$dev,$dir,$name,$type,$ver) = $fspec =~
+     /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
+  foreach ((@$defaults,$ENV{'DEFAULT'})) {
+    last if $node && $ver && $type && $dev && $dir && $name;
+    ($dnode,$ddev,$ddir,$dname,$dtype,$dver) =
+       /([^:]*::)?([^:]*:)?([^>\]]*[>\]])?([^.;]*)(\.?[^.;]*)([.;]?\d*)/;
+    $node = $dnode if $dnode && !$node;
+    $dev = $ddev if $ddev && !$dev;
+    $dir = $ddir if $ddir && !$dir;
+    $name = $dname if $dname && !$name;
+    $type = $dtype if $dtype && !$type;
+    $ver = $dver if $dver && !$ver;
+  }
+  # do this the long way to keep -w happy
+  $fspec = '';
+  $fspec .= $node if $node;
+  $fspec .= $dev if $dev;
+  $fspec .= $dir if $dir;
+  $fspec .= $name if $name;
+  $fspec .= $type if $type;
+  $fspec .= $ver if $ver;
+  $fspec;
+}  
+
+sub vmsify ($) {
+  my($fspec) = @_;
+  my($hasdev,$dev,$defdirs,$dir,$base,@dirs,@realdirs);
+
+  if ($fspec =~ m#^\.(\.?)/?$#) { return $1 ? '[-]' : '[]'; }
+  return $fspec if $fspec !~ m#/#;
+  ($hasdev,$dir,$base) = $fspec =~ m#(/?)(.*)/(.*)#;
+  @dirs = split(m#/#,$dir);
+  if ($base eq '.') { $base = ''; }
+  elsif ($base eq '..') {
+    push @dirs,$base;
+    $base = '';
+  }
+  foreach (@dirs) {
+    next unless $_;  # protect against // in input
+    next if $_ eq '.';
+    if ($_ eq '..') {
+      if (@realdirs && $realdirs[$#realdirs] ne '-') { pop @realdirs }
+      else                                           { push @realdirs, '-' }
+    }
+    else { push @realdirs, $_; }
+  }
+  if ($hasdev) {
+    $dev = shift @realdirs;
+    @realdirs = ('000000') unless @realdirs;
+    $base = '' unless $base;  # keep -w happy
+    $dev . ':[' . join('.',@realdirs) . "]$base";
+  }
+  else {
+    '[' . join('',map($_ eq '-' ? $_ : ".$_",@realdirs)) . "]$base";
+  }
+}
+
+sub unixify ($) {
+  my($fspec) = @_;
+
+  return $fspec if $fspec !~ m#[:>\]]#;
+  return '.' if ($fspec eq '[]' || $fspec eq '<>');
+  if ($fspec =~ m#^[<\[](\.|-+)(.*)# ) {
+    $fspec = ($1 eq '.' ? '' : "$1.") . $2;
+    my($dir,$base) = split(/[\]>]/,$fspec);
+    my(@dirs) = grep($_,split(m#\.#,$dir));
+    if ($dirs[0] =~ /^-/) {
+      my($steps) = shift @dirs;
+      for (1..length($steps)) { unshift @dirs, '..'; }
+    }
+    join('/',@dirs) . "/$base";
+  }
+  else {
+    $fspec = rmsexpand($fspec,'_N_O_T_:[_R_E_A_L_]');
+    $fspec =~ s/.*_N_O_T_:(?:\[_R_E_A_L_\])?//;
+    my($dev,$dir,$base) = $fspec =~ m#([^:<\[]*):?[<\[](.*)[>\]](.*)#;
+    my(@dirs) = split(m#\.#,$dir);
+    if ($dirs[0] && $dirs[0] =~ /^-/) {
+      my($steps) = shift @dirs;
+      for (1..length($steps)) { unshift @dirs, '..'; }
+    }
+    "/$dev/" . join('/',@dirs) . "/$base";
+  }
+}
+
+
+sub fileify ($) {
+  my($path) = @_;
+
+  if (!$path) { return undef }
+  if ($path =~ /(.+)\.([^:>\]]*)$/) {
+    $path = $1;
+    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
+  }
+
+  if ($path !~ m#[/>\]]#) {
+    $path =~ s/:$//;
+    while ($ENV{$path}) {
+      ($path = $ENV{$path}) =~ s/:$//;
+      last if $path =~ m#[/>\]]#;
+    }
+  }
+  if ($path =~ m#[>\]]#) {
+    my($dir,$sep,$base) = $path =~ /(.*)([>\]])(.*)/;
+    $sep =~ tr/<[/>]/;
+    if ($base) {
+      "$dir$sep$base.dir;1";
+    }
+    else {
+      if ($dir !~ /\./) { $dir =~ s/([<\[])/${1}000000./; }
+      $dir =~ s#\.(\w+)$#$sep$1#;
+      $dir =~ s/^.$sep//;
+      "$dir.dir;1";
+    }
+  }
+  else {
+    $path =~ s#/$##;
+    "$path.dir;1";
+  }
+}
+
+sub pathify ($) {
+  my($fspec) = @_;
+
+  if (!$fspec) { return undef }
+  if ($fspec =~ m#[/>\]]$#) { return $fspec; }
+  if ($fspec =~ m#(.+)\.([^/>\]]*)$# && $2 && $2 ne '.') {
+    $fspec = $1;
+    if ($2 !~ /^dir(?:;1)?$/i) { return undef }
+  }
+
+  if ($fspec !~ m#[/>\]]#) {
+    $fspec =~ s/:$//;
+    while ($ENV{$fspec}) {
+      if ($ENV{$fspec} =~ m#[>\]]$#) { return $ENV{$fspec} }
+      else { $fspec = $ENV{$fspec} =~ s/:$// }
+    }
+  }
+  
+  if ($fspec !~ m#[>\]]#) { "$fspec/"; }
+  else {
+    if ($fspec =~ /([^>\]]+)([>\]])(.+)/) { "$1.$3$2"; }
+    else { $fspec; }
+  }
+}
+
+sub vmspath ($) {
+  pathify(vmsify($_[0]));
+}
+
+sub unixpath ($) {
+  pathify(unixify($_[0]));
+}
+
+sub candelete ($) {
+  my($fspec) = @_;
+  my($parent);
+
+  return '' unless -w $fspec;
+  $fspec =~ s#/$##;
+  if ($fspec =~ m#/#) {
+    ($parent = $fspec) =~ s#/[^/]+$#;
+    return (-w $parent);
+  }
+  elsif ($parent = fileify($fspec)) { # fileify() here to expand lnms
+    $parent =~ s/[>\]][^>\]]+//;
+    return (-w fileify($parent));
+  }
+  else { return (-w '[-]'); }
+}
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt b/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt
new file mode 100644
index 00000000000..28f82b3a145
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/0README.txt
@@ -0,0 +1,47 @@
+This directory contains the source code for the Perl extension
+VMS::Stdio, which provides access from Perl to VMS-specific
+stdio functions.  For more specific documentation of its
+function, please see the pod section of Stdio.pm.
+
+                       *** Please Note ***
+
+This package is the direct descendant of VMS::stdio, but as of Perl
+5.002, the name has been changed to VMS::Stdio, in order to conform
+to the Perl naming convention that extensions whose name begins
+with a lowercase letter represent compile-time "pragmas", while
+extensions which provide added functionality have names whose parts
+begin with uppercase letters.  In addition, the functions
+vmsfopen and fgetname have been renamed vmsopen and getname,
+respectively, in order to more closely resemble related Perl
+I/O operators, which do not retain the 'f' from corresponding
+C routine names.
+
+A transitional interface to the old routine names has been
+provided, so that calls to these routines will generate a
+warning, and be routed to the corresponding VMS::Stdio
+routine.  This interface will be removed in a future release,
+so please update your code to use the new names.
+
+
+===> Installation
+
+This extension, like most Perl extensions, should be installed
+by copying the files in this directory to a location *outside*
+the Perl distribution tree, and then saying
+
+    $ perl Makefile.PL  ! Build Descrip.MMS for this extension
+    $ MMK               ! Build the extension
+    $ MMK test          ! Run its regression tests
+    $ MMK install       ! Install required files in public Perl tree
+
+
+===> Revision History
+
+1.0  29-Nov-1994  Charles Bailey  bailey@genetics.upenn.edu
+     original version - vmsfopen
+1.1  09-Mar-1995  Charles Bailey  bailey@genetics.upenn.edu
+     changed calling sequence to return FH/undef - like POSIX::open
+     added fgetname and tmpnam
+2.0  28-Feb-1996  Charles Bailey  bailey@genetics.upenn.edu
+     major rewrite for Perl 5.002: name changed to VMS::Stdio,
+     new functions added, and prototypes incorporated
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL b/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL
new file mode 100644
index 00000000000..e5ea988818b
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Makefile.PL
@@ -0,0 +1,3 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile( 'VERSION_FROM' => 'Stdio.pm' );
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
new file mode 100644
index 00000000000..f87631a32aa
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.pm
@@ -0,0 +1,235 @@
+#   VMS::Stdio - VMS extensions to Perl's stdio calls
+#
+#   Author:  Charles Bailey  bailey@genetics.upenn.edu
+#   Version: 2.0
+#   Revised: 28-Feb-1996
+
+package VMS::Stdio;
+
+require 5.002;
+use vars qw( $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA );
+use Carp '&croak';
+use DynaLoader ();
+use Exporter ();
+ 
+$VERSION = '2.0';
+@ISA = qw( Exporter DynaLoader FileHandle );
+@EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY &O_NOWAIT
+              &O_RDONLY &O_RDWR  &O_TRUNC &O_WRONLY );
+@EXPORT_OK = qw( &flush &getname &remove &rewind &sync &tmpnam
+                 &vmsopen &vmssysopen &waitfh );
+%EXPORT_TAGS = ( CONSTANTS => [ qw( &O_APPEND &O_CREAT &O_EXCL  &O_NDELAY
+                                    &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC
+                                    &O_WRONLY ) ],
+                 FUNCTIONS => [ qw( &flush &getname &remove &rewind &sync
+                                     &tmpnam &vmsopen &vmssysopen &waitfh ) ] );
+
+bootstrap VMS::Stdio $VERSION;
+
+sub AUTOLOAD {
+    my($constname) = $AUTOLOAD;
+    $constname =~ s/.*:://;
+    if ($constname =~ /^O_/) {
+      my($val) = constant($constname);
+      defined $val or croak("Unknown VMS::Stdio constant $constname");
+      *$AUTOLOAD = sub { $val };
+    }
+    else { # We don't know about it; hand off to FileHandle
+      require FileHandle;
+      my($obj) = shift(@_);
+      $obj->FileHandle::$constname(@_);
+    }
+    goto &$AUTOLOAD;
+}
+
+sub DESTROY { close($_[0]); }
+
+
+################################################################################
+# Intercept calls to old VMS::stdio package, complain, and hand off
+# This will be removed in a future version of VMS::Stdio
+
+package VMS::stdio;
+
+sub AUTOLOAD {
+  my($func) = $AUTOLOAD;
+  $func =~ s/.*:://;
+  # Cheap trick: we know DynaLoader has required Carp.pm
+  Carp::carp("Old package VMS::stdio is now VMS::Stdio; please update your code");
+  if ($func eq 'vmsfopen') {
+    Carp::carp("Old function &vmsfopen is now &vmsopen");
+    goto &VMS::Stdio::vmsopen;
+  }
+  elsif ($func eq 'fgetname') {
+    Carp::carp("Old function &fgetname is now &getname");
+    goto &VMS::Stdio::getname;
+  }
+  else { goto &{"VMS::Stdio::$func"}; }
+}
+
+package VMS::Stdio;  # in case we ever use AutoLoader
+
+1;
+
+__END__
+
+=head1 NAME
+
+VMS::Stdio
+
+=head1 SYNOPSIS
+
+use VMS::Stdio qw( &flush &getname &remove &rewind &sync &tmpnam
+                   &vmsopen &vmssysopen &waitfh );
+$uniquename = tmpnam;
+$fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
+$name = getname($fh);
+print $fh "Hello, world!\n";
+flush($fh);
+sync($fh);
+rewind($fh);
+$line = <$fh>;
+undef $fh;  # closes file
+$fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin");
+sysread($fh,$data,128);
+waitfh($fh);
+close($fh);
+remove("another.file");
+
+=head1 DESCRIPTION
+
+This package gives Perl scripts access to VMS extensions to several
+C stdio operations not available through Perl's CORE I/O functions.
+The specific routines are described below.  These functions are
+prototyped as unary operators, with the exception of C<vmsopen>
+and C<vmssysopen>, which can take any number of arguments, and
+C<tmpnam>, which takes none.
+
+All of the routines are available for export, though none are
+exported by default.  All of the constants used by C<vmssysopen>
+to specify access modes are exported by default.  The routines
+are associated with the Exporter tag FUNCTIONS, and the constants
+are associated with the Exporter tag CONSTANTS, so you can more
+easily choose what you'd like to import:
+
+    # import constants, but not functions
+    use VMS::Stdio;  # same as use VMS::Stdio qw( :DEFAULT );
+    # import functions, but not constants
+    use VMS::Stdio qw( !:CONSTANTS :FUNCTIONS ); 
+    # import both
+    use VMS::Stdio qw( :CONSTANTS :FUNCTIONS ); 
+    # import neither
+    use VMS::Stdio ();
+
+Of course, you can also choose to import specific functions by
+name, as usual.
+
+This package C<ISA> FileHandle, so that you can call FileHandle
+methods on the handles returned by C<vmsopen> and C<vmssysopen>.
+The FileHandle package is not initialized, however, until you
+actually call a method that VMS::Stdio doesn't provide.  This
+is doen to save startup time for users who don't wish to use
+the FileHandle methods.
+
+B<Note:>  In order to conform to naming conventions for Perl
+extensions and functions, the name of this package has been
+changed to VMS::Stdio as of Perl 5.002, and the names of some
+routines have been changed.  Calls to the old VMS::stdio routines
+will generate a warning, and will be routed to the equivalent
+VMS::Stdio function.  This compatibility interface will be
+removed in a future release of this extension, so please
+update your code to use the new routines.
+
+=item flush
+
+This function causes the contents of stdio buffers for the specified
+file handle to be flushed.  If C<undef> is used as the argument to
+C<flush>, all currently open file handles are flushed.  Like the CRTL
+fflush() routine, it does not flush any underlying RMS buffers for the
+file, so the data may not be flushed all the way to the disk.  C<flush>
+returns a true value if successful, and C<undef> if not.
+
+=item getname
+
+The C<getname> function returns the file specification associated
+with a Perl FileHandle.  If an error occurs, it returns C<undef>.
+
+=item remove
+
+This function deletes the file named in its argument, returning
+a true value if successful and C<undef> if not.  It differs from
+the CORE Perl function C<unlink> in that it does not try to
+reset file protection if the original protection does not give
+you delete access to the file (cf. L<perlvms>).  In other words,
+C<remove> is equivalent to
+
+  unlink($file) if VMS::Filespec::candelete($file);
+
+=item rewind
+
+C<rewind> resets the current position of the specified file handle
+to the beginning of the file.  It's really just a convenience
+method equivalent in effect to C<seek($fh,0,0)>.  It returns a
+true value if successful, and C<undef> if it fails.
+
+=item sync
+
+This function flushes buffered data for the specified file handle
+from stdio and RMS buffers all the way to disk.  If successful, it
+returns a true value; otherwise, it returns C<undef>.
+
+=item tmpnam
+
+The C<tmpnam> function returns a unique string which can be used
+as a filename when creating temporary files.  If, for some
+reason, it is unable to generate a name, it returns C<undef>.
+
+=item vmsopen
+
+The C<vmsopen> function enables you to specify optional RMS arguments
+to the VMS CRTL when opening a file.  It is similar to the built-in
+Perl C<open> function (see L<perlfunc> for a complete description),
+but will only open normal files; it cannot open pipes or duplicate
+existing FileHandles.  Up to 8 optional arguments may follow the
+file name.  These arguments should be strings which specify
+optional file characteristics as allowed by the CRTL. (See the
+CRTL reference manual description of creat() and fopen() for details.)
+If successful, C<vmsopen> returns a VMS::Stdio file handle; if an
+error occurs, it returns C<undef>.
+
+You can use the file handle returned by C<vmsfopen> just as you
+would any other Perl file handle.  The class VMS::Stdio ISA
+FileHandle, so you can call FileHandle methods using the handle
+returned by C<vmsopen>.  However, C<use>ing VMS::Stdio does not
+automatically C<use> FileHandle; you must do so explicitly in
+your program if you want to call FileHandle methods.  This is
+done to avoid the overhead of initializing the FileHandle package
+in programs which intend to use the handle returned by C<vmsopen>
+as a normal Perl file handle only.  When the scalar containing
+a VMS::Stdio file handle is overwritten, C<undef>d, or goes
+out of scope, the associated file is closed automatically.
+
+=item vmssysopen
+
+This function bears the same relationship to the CORE function
+C<sysopen> as C<vmsopen> does to C<open>.  Its first three arguments
+are the name, access flags, and permissions for the file.  Like
+C<vmsopen>, it takes up to 8 additional string arguments which
+specify file characteristics.  Its return value is identical to
+that of C<vmsopen>.
+
+The symbolic constants for the mode argument are exported by
+VMS::Stdio by default, and are also exported by the Fcntl package.
+
+=item waitfh
+
+This function causes Perl to wait for the completion of an I/O
+operation on the file handle specified as its argument.  It is
+used with handles opened for asynchronous I/O, and performs its
+task by calling the CRTL routine fwait().
+
+=head1 REVISION
+
+This document was last revised on 28-Jan-1996, for Perl 5.002.
+
+=cut
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
new file mode 100644
index 00000000000..79eb95335e4
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/Stdio.xs
@@ -0,0 +1,295 @@
+/* VMS::Stdio - VMS extensions to stdio routines 
+ *
+ * Version:  2.0
+ * Author:   Charles Bailey  bailey@genetics.upenn.edu
+ * Revised:  28-Feb-1996
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <file.h>
+
+static bool
+constant(name, pval)
+char *name;
+IV *pval;
+{
+    if (strnNE(name, "O_", 2)) return FALSE;
+
+    if (strEQ(name, "O_APPEND"))
+#ifdef O_APPEND
+	{ *pval = O_APPEND; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_CREAT"))
+#ifdef O_CREAT
+	{ *pval = O_CREAT; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_EXCL"))
+#ifdef O_EXCL
+	{ *pval = O_EXCL; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_NDELAY"))
+#ifdef O_NDELAY
+	{ *pval = O_NDELAY; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_NOWAIT"))
+#ifdef O_NOWAIT
+	{ *pval = O_NOWAIT; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_RDONLY"))
+#ifdef O_RDONLY
+	{ *pval = O_RDONLY; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_RDWR"))
+#ifdef O_RDWR
+	{ *pval = O_RDWR; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_TRUNC"))
+#ifdef O_TRUNC
+	{ *pval = O_TRUNC; return TRUE; }
+#else
+	return FALSE;
+#endif
+    if (strEQ(name, "O_WRONLY"))
+#ifdef O_WRONLY
+	{ *pval = O_WRONLY; return TRUE; }
+#else
+	return FALSE;
+#endif
+
+    return FALSE;
+}
+
+
+static SV *
+newFH(FILE *fp, char type) {
+    SV *rv, *gv = NEWSV(0,0);
+    GV **stashp;
+    HV *stash;
+    IO *io;
+
+    /* Find stash for VMS::Stdio.  We don't do this once at boot
+     * to allow for possibility of threaded Perl with per-thread
+     * symbol tables.  This code (through io = ...) is really
+     * equivalent to gv_fetchpv("VMS::Stdio::__FH__",TRUE,SVt_PVIO),
+     * with a little less overhead, and good exercise for me. :-) */
+    stashp = (GV **)hv_fetch(defstash,"VMS::",5,TRUE);
+    if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+    if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
+    stashp = (GV **)hv_fetch(GvHV(*stashp),"Stdio::",7,TRUE);
+    if (!stashp || *stashp == (GV *)&sv_undef) return Nullsv;
+    if (!(stash = GvHV(*stashp))) stash = GvHV(*stashp) = newHV();
+
+    /* Set up GV to point to IO, and then take reference */
+    gv_init(gv,stash,"__FH__",6,0);
+    io = GvIOp(gv) = newIO();
+    IoIFP(io) = fp;
+    if (type != '>') IoOFP(io) = fp;
+    IoTYPE(io) = type;
+    rv = newRV(gv);
+    SvREFCNT_dec(gv);
+    return sv_bless(rv,stash);
+}
+
+MODULE = VMS::Stdio  PACKAGE = VMS::Stdio
+
+void
+constant(name)
+	char *	name
+	PROTOTYPE: $
+	CODE:
+	IV i;
+	if (constant(name, &i))
+	    ST(0) = sv_2mortal(newSViv(i));
+	else
+	    ST(0) = &sv_undef;
+
+void
+flush(sv)
+	SV *	sv
+	PROTOTYPE: $
+	CODE:
+	    FILE *fp = Nullfp;
+	    if (SvOK(sv)) fp = IoIFP(sv_2io(sv));
+	    ST(0) = fflush(fp) ? &sv_undef : &sv_yes;
+
+char *
+getname(fp)
+	FILE *	fp
+	PROTOTYPE: $
+	CODE:
+	    char fname[257];
+	    ST(0) = sv_newmortal();
+	    if (fgetname(fp,fname) != NULL) sv_setpv(ST(0),fname);
+
+void
+rewind(fp)
+	FILE *	fp
+	PROTOTYPE: $
+	CODE:
+	    ST(0) = rewind(fp) ? &sv_undef : &sv_yes;
+
+void
+remove(name)
+	char *name
+	PROTOTYPE: $
+	CODE:
+	    ST(0) = remove(name) ? &sv_undef : &sv_yes;
+
+void
+sync(fp)
+	FILE *	fp
+	PROTOTYPE: $
+	CODE:
+	    ST(0) = fsync(fileno(fp)) ? &sv_undef : &sv_yes;
+
+char *
+tmpnam()
+	PROTOTYPE:
+	CODE:
+	    char fname[L_tmpnam];
+	    ST(0) = sv_newmortal();
+	    if (tmpnam(fname) != NULL) sv_setpv(ST(0),fname);
+
+void
+vmsopen(spec,...)
+	char *	spec
+	PROTOTYPE: @
+	CODE:
+	    char *args[8],mode[3] = {'r','\0','\0'}, type = '<';
+	    register int i, myargc;
+	    FILE *fp;
+	
+	    if (!spec || !*spec) {
+	       SETERRNO(EINVAL,LIB$_INVARG);
+	       XSRETURN_UNDEF;
+	    }
+	    if (items > 9) croak("too many args");
+	
+	    /* First, set up name and mode args from perl's string */
+	    if (*spec == '+') {
+	      mode[1] = '+';
+	      spec++;
+	    }
+	    if (*spec == '>') {
+	      if (*(spec+1) == '>') *mode = 'a', spec += 2;
+	      else *mode = 'w',  spec++;
+	    }
+	    else if (*spec == '<') spec++;
+	    myargc = items - 1;
+	    for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),na);
+	    /* This hack brought to you by C's opaque arglist management */
+	    switch (myargc) {
+	      case 0:
+	        fp = fopen(spec,mode);
+	        break;
+	      case 1:
+	        fp = fopen(spec,mode,args[0]);
+	        break;
+	      case 2:
+	        fp = fopen(spec,mode,args[0],args[1]);
+	        break;
+	      case 3:
+	        fp = fopen(spec,mode,args[0],args[1],args[2]);
+	        break;
+	      case 4:
+	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3]);
+	        break;
+	      case 5:
+	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4]);
+	        break;
+	      case 6:
+	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5]);
+	        break;
+	      case 7:
+	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
+	        break;
+	      case 8:
+	        fp = fopen(spec,mode,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
+	        break;
+	    }
+	    if (fp != Nullfp) {
+	      SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : '>')));
+	      ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+	    }
+	    else { ST(0) = &sv_undef; }
+
+void
+vmssysopen(spec,mode,perm,...)
+	char *	spec
+	int	mode
+	int	perm
+	PROTOTYPE: @
+	CODE:
+	    char *args[8];
+	    int i, myargc, fd;
+	    FILE *fp;
+	    SV *fh;
+	    if (!spec || !*spec) {
+	       SETERRNO(EINVAL,LIB$_INVARG);
+	       XSRETURN_UNDEF;
+	    }
+	    if (items > 11) croak("too many args");
+	    myargc = items - 3;
+	    for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),na);
+	    /* More fun with C calls; can't combine with above because
+	       args 2,3 of different types in fopen() and open() */
+	    switch (myargc) {
+	      case 0:
+	        fd = open(spec,mode,perm);
+	        break;
+	      case 1:
+	        fd = open(spec,mode,perm,args[0]);
+	        break;
+	      case 2:
+	        fd = open(spec,mode,perm,args[0],args[1]);
+	        break;
+	      case 3:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2]);
+	        break;
+	      case 4:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2],args[3]);
+	        break;
+	      case 5:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4]);
+	        break;
+	      case 6:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5]);
+	        break;
+	      case 7:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6]);
+	        break;
+	      case 8:
+	        fd = open(spec,mode,perm,args[0],args[1],args[2],args[3],args[4],args[5],args[6],args[7]);
+	        break;
+	    }
+	    i = mode & 3;
+	    if (fd >= 0 &&
+	       ((fp = fdopen(fd, &("r\000w\000r+"[2*i]))) != Nullfp)) {
+	      SV *fh = newFH(fp,"<>++"[i]);
+	      ST(0) = (fh ? sv_2mortal(fh) : &sv_undef);
+	    }
+	    else { ST(0) = &sv_undef; }
+
+void
+waitfh(fp)
+	FILE *	fp
+	PROTOTYPE: $
+	CODE:
+	    ST(0) = fwait(fp) ? &sv_undef : &sv_yes;
diff --git a/gnu/usr.bin/perl/vms/ext/Stdio/test.pl b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
new file mode 100644
index 00000000000..12e508aa1f7
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/ext/Stdio/test.pl
@@ -0,0 +1,41 @@
+# Tests for VMS::Stdio v2.0
+use VMS::Stdio;
+import VMS::Stdio qw(&flush &getname &rewind &sync);
+
+print "1..13\n";
+print +(defined(&getname) ? '' : 'not '), "ok 1\n";
+
+$name = "test$$";
+$name++ while -e "$name.tmp";
+$fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp');
+print +($fh ? '' : 'not '), "ok 2\n";
+
+print +(flush($fh) ? '' : 'not '),"ok 3\n";
+print +(sync($fh) ? '' : 'not '),"ok 4\n";
+
+$time = (stat("$name.tmp"))[9];
+print +($time ? '' : 'not '), "ok 5\n";
+
+print 'not ' unless print $fh scalar(localtime($time)),"\n";
+print "ok 6\n";
+
+print +(rewind($fh) ? '' : 'not '),"ok 7\n";
+
+chop($line = <$fh>);
+print +($line eq localtime($time) ? '' : 'not '), "ok 8\n";
+
+($gotname) = (getname($fh) =~/\](.*);/);
+print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 9\n";
+
+$sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0,
+                              'ctx=rec', 'shr=put', 'dna=.tmp');
+print +($sfh ? '' : 'not ($!) '), "ok 10\n";
+
+close($fh);
+sysread($sfh,$line,24);
+print +($line eq localtime($time) ? '' : 'not '), "ok 11\n";
+
+undef $sfh;
+print +(stat("$name.tmp") ? 'not ' : ''),"ok 12\n";
+
+print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 13\n";
diff --git a/gnu/usr.bin/perl/vms/fndvers.com b/gnu/usr.bin/perl/vms/fndvers.com
new file mode 100644
index 00000000000..f1ddc03eca9
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/fndvers.com
@@ -0,0 +1,113 @@
+$! Brief DCL procedure to parse current Perl version out of
+$! patchlevel.h, and update the version token for ARCHLIB
+$! config.vms and descrip.mms if necessary.
+$ err = "Write Sys$Error"
+$
+$ If p1.eqs."" Then p1 = "patchlevel.h"
+$ If p2.eqs."" Then p2 = F$Parse("config.vms",p1,"[.vms]")
+$ If p3.eqs."" Then p3 = F$Parse("descrip.mms",p1,"[.vms]")
+$
+$ If F$Search(p1).eqs.""
+$ Then
+$   err "Can't find ''p1' - exiting"
+$   Exit 98962  ! RMS$_FNF
+$ EndIf
+$ plevel = ""
+$ sublevel = ""
+$ Open/Read patchlevel_h &p1
+$
+$ pread:
+$ Read/End_Of_File=pdone patchlevel_h line
+$ If F$Locate("#define PATCHLEVEL",line).ne.F$Length(line)
+$ Then
+$    plevel = F$Element(2," ",line)
+$    If F$Length(plevel).lt.3 Then -
+       plevel = F$Extract(0,3 - F$Length(plevel),"000") + plevel
+$ EndIf
+$ If F$Locate("#define SUBVERSION",line).ne.F$Length(line)
+$ Then
+$    sublevel = F$Element(2," ",line)
+$    If F$Length(sublevel).lt.2 Then -
+       sublevel = F$Extract(0,2 - F$Length(sublevel),"00") + sublevel
+$ EndIf
+$ If .not.(plevel.nes."" .and. sublevel.nes."") Then Goto pread
+$
+$ pdone:
+$ Close patchlevel_h
+$!
+$ If sublevel.eq.0 Then sublevel = ""
+$ perl_version = "5_" + plevel + sublevel
+$ If F$GetSyi("HW_MODEL").gt.1024
+$ Then
+$   arch = "AXP"
+$ Else
+$   arch = "VAX"
+$ EndIf
+$ If p2.eqs."#NOFILE#"
+$ Then
+$   Write Sys$Output "Perl version directory name is ""''perl_version'"""
+$   Exit
+$ EndIf
+$!
+$ token = """""""""/perl_root/lib/VMS_''arch'/''perl_version'"""""""""
+$ If sublevel.eqs."" Then token = token + "  "
+$ token = token + "  /**/"
+$ Call update_file "''p2'" "#define ARCHLIB_EXP" "''token'"
+$ teststs = $Status
+$ If .not.teststs Then Exit teststs
+$!
+$ If teststs.ne.1 ! current values in config.vms are appropriate
+$ Then
+$   token = """""""""/perl_root/lib/VMS_''arch'""""""""  /**/"
+$   Call update_file "''p2'" "#define OLDARCHLIB_EXP" "''token'"
+$   If .not.$Status Then Exit $Status
+$!
+$   token = """""""""/perl_root/lib/site_perl/VMS_''arch'""""""""  /**/"
+$   Call update_file "''p2'" "#define SITEARCH_EXP" "''token'"
+$   If .not.$Status Then Exit $Status
+$EndIf
+$!
+$ token = "''perl_version'"
+$ If sublevel.eqs."" Then token = token + "  "
+$ token = token + "#"
+$ Call update_file "''p3'" "PERL_VERSION =" "''token'"
+$ If .not.$Status Then Exit $Status
+$ If $Status.eq.3
+$ Then
+$   cmd = "MM[SK]"
+$   If F$Locate("MMS",p3).eqs."" Then cmd = "make"
+$   err "The PERL_VERSION macro was out of date in the file"
+$   err "    ''p3'"
+$   err "The file has been corrected, but you must restart the build process"
+$   err "by reinvoking ''cmd' to incorporate the new value."
+$   Exit 44  ! SS$_ABORT
+$ EndIf
+$!
+$ update_file: Subroutine
+$
+$ If F$Search(p1).nes.""
+$ Then
+$   Search/Exact/Output=_NLA0: 'p1' "''p2' ''p3'"
+$   If $Status.eq.%X08D78053  ! SEARCH$_NOMATCHES
+$   Then
+$     Open/Read/Write/Error=done  file &p1
+$
+$     nextline:
+$     Read/End_of_File=done file line
+$     If F$Locate(p2,line).ne.F$Length(line)
+$     Then
+$       Write/Update file "''p2' ''p3'"
+$       Goto done
+$     EndIf
+$     Goto nextline
+$
+$     done:
+$     Close file
+$     Exit 3  ! Unused success status
+$   EndIf
+$   Exit 1  ! SS$_NORMAL
+$ Else
+$   err "Can't find ''p1'"
+$   Exit 98962  ! RMS$_FNF
+$ EndIf
+$ EndSubroutine
diff --git a/gnu/usr.bin/perl/vms/gen_shrfls.pl b/gnu/usr.bin/perl/vms/gen_shrfls.pl
new file mode 100644
index 00000000000..256cdb51720
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/gen_shrfls.pl
@@ -0,0 +1,379 @@
+# Create global symbol declarations, transfer vector, and
+# linker options files for PerlShr.
+#
+# Input:
+#    $cflags - command line qualifiers passed to cc when preprocesing perl.h
+#        Note: A rather simple-minded attempt is made to restore quotes to
+#        a /Define clause - use with care.
+#    $objsuffix - file type (including '.') used for object files.
+#    $libperl - Perl object library.
+#    $extnames - package names for static extensions (used to generate
+#        linker options file entries for boot functions)
+#    $rtlopt - name of options file specifying RTLs to which PerlShr.Exe
+#        must be linked
+#
+# Output:
+#    PerlShr_Attr.Opt - linker options file which speficies that global vars
+#        be placed in NOSHR,WRT psects.  Use when linking any object files
+#        against PerlShr.Exe, since cc places global vars in SHR,WRT psects
+#        by default.
+#    PerlShr_Bld.Opt - declares universal symbols for PerlShr.Exe
+#    Perlshr_Gbl*.Mar, Perlshr_Gbl*.Obj (VAX  only) - declares global symbols
+#        for global vars (done here because gcc can't globaldef) and creates
+#        transfer vectors for routines on a VAX.
+#    PerlShr_Gbl.Opt (VAX only) - list of PerlShr_Gbl*.Obj, used for input
+#        to the linker when building PerlShr.Exe.
+#
+# To do:
+#   - figure out a good way to collect global vars in one psect, given that
+#     we can't use globaldef because of gcc.
+#   - then, check for existing files and preserve symbol and transfer vector
+#     order for upward compatibility
+#   - then, add GSMATCH to options file - but how do we insure that new
+#     library has everything old one did
+#     (i.e. /Define=DEBUGGING,EMBED,MULTIPLICITY)?
+#
+# Author: Charles Bailey  bailey@genetics.upenn.edu
+# Revised: 20-Feb-1996
+
+require 5.000;
+
+$debug = $ENV{'GEN_SHRFLS_DEBUG'};
+
+if ($ARGV[0] eq '-f') {
+  open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n";
+  print "Input taken from file $ARGV[1]\n" if $debug;
+  @ARGV = ();
+  while (<INP>) {
+    chomp;
+    push(@ARGV,split(/\|/,$_));
+  }
+  close INP;
+  print "Read input data | ",join(' | ',@ARGV)," |\n" if $debug > 1;
+}
+
+$cc_cmd = shift @ARGV;
+
+# Someday, we'll have $GetSyI built into perl . . .
+$isvax = `\$ Write Sys\$Output F\$GetSyI(\"HW_MODEL\")` <= 1024;
+print "\$isvax: \\$isvax\\\n" if $debug;
+
+print "Input \$cc_cmd: \\$cc_cmd\\\n" if $debug;
+$docc = ($cc_cmd !~ /^~~/);
+print "\$docc = $docc\n" if $debug;
+
+if ($docc) {
+  # put quotes back onto defines - they were removed by DCL on the way in
+  if (($prefix,$defines,$suffix) =
+         ($cc_cmd =~ m#(.*)/Define=(.*?)([/\s].*)#i)) {
+    $defines =~ s/^\((.*)\)$/$1/;
+    @defines = split(/,/,$defines);
+    $cc_cmd = "$prefix/Define=(" . join(',',grep($_ = "\"$_\"",@defines)) 
+              . ')' . $suffix;
+  }
+  print "Filtered \$cc_cmd: \\$cc_cmd\\\n" if $debug;
+
+  # check for gcc - if present, we'll need to use MACRO hack to
+  # define global symbols for shared variables
+  $isvaxc = 0;
+  $isgcc = `$cc_cmd _nla0:/Version` =~ /GNU/
+           or 0; # make debug output nice
+  $isvaxc = (!$isgcc && $isvax && `$cc_cmd /prefix=all _nla0:` =~ /IVQUAL/)
+            or 0; # again, make debug output nice
+  print "\$isgcc: $isgcc\n" if $debug;
+  print "\$isvaxc: $isvaxc\n" if $debug;
+
+  if (-f 'perl.h') { $dir = '[]'; }
+  elsif (-f '[-]perl.h') { $dir = '[-]'; }
+  else { die "$0: Can't find perl.h\n"; }
+}
+else { 
+  ($junk,$junk,$cpp_file,$cc_cmd) = split(/~~/,$cc_cmd,4);
+  $isgcc = $cc_cmd =~ /case_hack/i
+           or 0;  # for nice debug output
+  $isvaxc = (!$isgcc && $cc_cmd !~ /standard=/i)
+            or 0;  # again, for nice debug output
+  print "\$isgcc: \\$isgcc\\\n" if $debug;
+  print "\$isvaxc: \\$isvaxc\\\n" if $debug;
+  print "Not running cc, preprocesor output in \\$cpp_file\\\n" if $debug;
+}
+
+$objsuffix = shift @ARGV;
+print "\$objsuffix: \\$objsuffix\\\n" if $debug;
+$dbgprefix = shift @ARGV;
+print "\$dbgprefix: \\$dbgprefix\\\n" if $debug;
+$olbsuffix = shift @ARGV;
+print "\$olbsuffix: \\$olbsuffix\\\n" if $debug;
+$libperl = "${dbgprefix}libperl$olbsuffix";
+$extnames = shift @ARGV;
+print "\$extnames: \\$extnames\\\n" if $debug;
+$rtlopt = shift @ARGV;
+print "\$rtlopt: \\$rtlopt\\\n" if $debug;
+
+# This part gets tricky.  VAXC creates global symbols for each of the
+# constants in an enum if that enum is ever used as the data type of a
+# global[dr]ef.  We have to detect enums which are used in this way, so we
+# can set up the constants as universal symbols, since anything which
+# #includes perl.h will want to resolve these global symbols.
+# We're using a weak test here - we basically know that the only enums
+# we need to handle now are the big one in opcode.h, and the
+# "typedef enum { ... } expectation" in perl.h, so we hard code
+# appropriate tests below. Since we can't know in general whether a given
+# enum will be used elsewhere in a globaldef, it's hard to decide a
+# priori whether its constants need to be treated as global symbols.
+sub scan_enum {
+  my($line) = @_;
+
+  return unless $isvaxc;
+
+  return unless /^\s+(OP|X)/;  # we only want opcode and expectation enums
+  print "\tchecking for enum constant\n" if $debug > 1;
+  $line =~ s#/\*.+##;
+  $line =~ s/,?\s*\n?$//;
+  print "\tfiltered to \\$line\\\n" if $debug > 1;
+  if ($line =~ /(\w+)$/) {
+    print "\tconstant name is \\$1\\\n" if $debug > 1;
+    $enums{$1}++;
+  }
+}
+
+sub scan_var {
+  my($line) = @_;
+
+  print "\tchecking for global variable\n" if $debug > 1;
+  $line =~ s/INIT\(.*\)//;
+  $line =~ s/\[.*//;
+  $line =~ s/=.*//;
+  $line =~ s/\W*;?\s*$//;
+  print "\tfiltered to \\$line\\\n" if $debug > 1;
+  if ($line =~ /(\w+)$/) {
+    print "\tvar name is \\$1\\\n" if $debug > 1;
+   $vars{$1}++;
+  }
+}
+
+sub scan_func {
+  my($line) = @_;
+
+  print "\tchecking for global routine\n" if $debug > 1;
+  if ( $line =~ /(\w+)\s+\(/ ) {
+    print "\troutine name is \\$1\\\n" if $debug > 1;
+    if ($1 eq 'main' || $1 eq 'perl_init_ext') {
+      print "\tskipped\n" if $debug > 1;
+    }
+    else { $fcns{$1}++ }
+  }
+}
+
+$used_expectation_enum = $used_opcode_enum = 0; # avoid warnings
+if ($docc) {
+  open(CPP,"${cc_cmd}/NoObj/PreProc=Sys\$Output ${dir}perl.h|")
+    or die "$0: Can't preprocess ${dir}perl.h: $!\n";
+}
+else {
+  open(CPP,"$cpp_file") or die "$0: Can't read preprocessed file $cpp_file: $!\n";
+}
+LINE: while (<CPP>) {
+  while (/^#.*vmsish\.h/i .. /^#.*perl\.h/i) {
+    while (/__VMS_PROTOTYPES__/i .. /__VMS_SEPYTOTORP__/i) {
+      print "vms_proto>> $_" if $debug > 2;
+      if (/^EXT/) { &scan_var($_);  }
+      else        { &scan_func($_); }
+      last LINE unless $_ = <CPP>;
+    }
+    print "vmsish.h>> $_" if $debug > 2;
+    if (/^EXT/) { &scan_var($_); }
+    last LINE unless $_ = <CPP>;
+  }    
+  while (/^#.*opcode\.h/i .. /^#.*perl\.h/i) {
+    print "opcode.h>> $_" if $debug > 2;
+    if (/^OP \*\s/) { &scan_func($_); }
+    if (/^EXT/) { &scan_var($_); }
+    if (/^\s+OP_/) { &scan_enum($_); }
+    last LINE unless $_ = <CPP>;
+  }
+  while (/^typedef enum/ .. /^\}/) {
+    print "global enum>> $_" if $debug > 2;
+    &scan_enum($_);
+    last LINE unless $_ = <CPP>;
+  }
+  while (/^#.*proto\.h/i .. /^#.*perl\.h/i) {
+    print "proto.h>> $_" if $debug > 2;
+    if (/^EXT/) { &scan_var($_);  }
+    else        { &scan_func($_); }
+    last LINE unless $_ = <CPP>;
+  }
+  print $_ if $debug > 3;
+  if (($type) = /^EXT\s+(\w+)/) {
+    if ($isvaxc) {
+      if ($type eq 'expectation') {
+        $used_expectation_enum++;
+        print "\tsaw global use of enum \"expectation\"\n" if $debug > 1;
+      }
+      if ($type eq 'opcode') {
+        $used_opcode_enum++;
+        print "\tsaw global use of enum \"opcode\"\n" if $debug > 1;
+      }
+    }
+    &scan_var($_);
+  }
+}
+close CPP;
+
+
+# Kluge to determine whether we need to add EMBED prefix to
+# symbols read from local list.  init_os_extras() is a VMS-
+# specific function whose Perl_ prefix is added in vmsish.h
+# if EMBED is #defined.
+$embed = exists($fcns{'Perl_init_os_extras'}) ? 'Perl_' : '';
+while (<DATA>) {
+  next if /^#/;
+  s/\s+#.*\n//;
+  next if /^\s*$/;
+  ($key,$array) = split('=',$_);
+  $key = "$embed$key";
+  print "Adding $key to \%$array list\n" if $debug > 1;
+  ${$array}{$key}++;
+}
+foreach (split /\s+/, $extnames) {
+  my($pkgname) = $_;
+  $pkgname =~ s/::/__/g;
+  $fcns{"boot_$pkgname"}++;
+  print "Adding boot_$pkgname to \%fcns (for extension $_)\n" if $debug;
+}
+
+# If we're using VAXC, fold in the names of the constants for enums
+# we've seen as the type of global vars.
+if ($isvaxc) {
+  foreach (keys %enums) {
+    if (/^OP/) {
+      $vars{$_}++ if $used_opcode_enum;
+      next;
+    }
+    if (/^X/) {
+      $vars{$_}++ if $used_expectation_enum;
+      next;
+    }
+    print STDERR "Unrecognized enum constant \"$_\" ignored\n";
+  }
+}
+
+# Eventually, we'll check against existing copies here, so we can add new
+# symbols to an existing options file in an upwardly-compatible manner.
+
+$marord++;
+open(OPTBLD,">${dir}${dbgprefix}perlshr_bld.opt")
+  or die "$0: Can't write to ${dir}${dbgprefix}perlshr_bld.opt: $!\n";
+if ($isvax) {
+  open(MAR,">${dir}perlshr_gbl${marord}.mar")
+    or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
+  print MAR "\t.title perlshr_gbl$marord\n";
+}
+foreach $var (sort keys %vars) {
+  if ($isvax) { print OPTBLD "UNIVERSAL=$var\n"; }
+  else { print OPTBLD "SYMBOL_VECTOR=($var=DATA)\n"; }
+  # This hack brought to you by the lack of a globaldef in gcc.
+  if ($isgcc) {
+    if ($count++ > 200) {  # max 254 psects/file
+      print MAR "\t.end\n";
+      close MAR;
+      $marord++;
+      open(MAR,">${dir}perlshr_gbl${marord}.mar")
+        or die "$0: Can't write to ${dir}perlshr_gbl${marord}.mar: $!\n";
+      print MAR "\t.title perlshr_gbl$marord\n";
+      $count = 0;
+    }
+    print MAR "\t.psect ${var},long,pic,ovr,rd,wrt,noexe,noshr\n";
+    print MAR "\t${var}::	.blkl 1\n";
+  }
+}
+
+print MAR "\t.psect \$transfer_vec,pic,rd,nowrt,exe,shr\n" if ($isvax);
+foreach $func (sort keys %fcns) {
+  if ($isvax) {
+    print MAR "\t.transfer $func\n";
+    print MAR "\t.mask $func\n";
+    print MAR "\tjmp G\^${func}+2\n";
+  }
+  else { print OPTBLD "SYMBOL_VECTOR=($func=PROCEDURE)\n"; }
+}
+if ($isvax) {
+  print MAR "\t.end\n";
+  close MAR;
+}
+
+open(OPTATTR,">${dir}perlshr_attr.opt")
+  or die "$0: Can't write to ${dir}perlshr_attr.opt: $!\n";
+print OPTATTR "PSECT_ATTR=\$CHAR_STRING_CONSTANTS,PIC,SHR,NOEXE,RD,NOWRT\n";
+foreach $var (sort keys %vars) {
+  print OPTATTR "PSECT_ATTR=${var},PIC,OVR,RD,NOEXE,WRT,NOSHR\n";
+}
+close OPTATTR;
+
+$incstr = 'perl,globals';
+if ($isvax) {
+  $drvrname = "Compile_shrmars.tmp_".time;
+  open (DRVR,">$drvrname") or die "$0: Can't write to $drvrname: $!\n";
+  print DRVR "\$ Set NoOn\n";  
+  print DRVR "\$ Delete/NoLog/NoConfirm $drvrname;\n";
+  print DRVR "\$ old_proc_vfy = F\$Environment(\"VERIFY_PROCEDURE\")\n";
+  print DRVR "\$ old_img_vfy = F\$Environment(\"VERIFY_IMAGE\")\n";
+  print DRVR "\$ MCR $^X -e \"\$ENV{'LIBPERL_RDT'} = (stat('$libperl'))[9]\"\n";
+  print DRVR "\$ Set Verify\n";
+  print DRVR "\$ If F\$Search(\"$libperl\").eqs.\"\" Then Library/Object/Create $libperl\n";
+  do {
+    $incstr .= ",perlshr_gbl$marord";
+    print DRVR "\$ Macro/NoDebug/Object=PerlShr_Gbl${marord}$objsuffix PerlShr_Gbl$marord.Mar\n";
+    print DRVR "\$ Library/Object/Replace/Log $libperl PerlShr_Gbl${marord}$objsuffix\n";
+  } while (--$marord); 
+  # We had to have a working miniperl to run this program; it's probably the
+  # one we just built.  It depended on LibPerl, which will be changed when
+  # the PerlShr_Gbl* modules get inserted, so miniperl will be out of date,
+  # and so, therefore, will all of its dependents . . .
+  # We touch LibPerl here so it'll be back 'in date', and we won't rebuild
+  # miniperl etc., and therefore LibPerl, the next time we invoke MM[KS].
+  print DRVR "\$ old_proc_vfy = F\$Verify(old_proc_vfy,old_img_vfy)\n";
+  print DRVR "\$ MCR $^X -e \"utime 0, \$ENV{'LIBPERL_RDT'}, '$libperl'\"\n";
+  close DRVR;
+}
+
+# Include object modules and RTLs in options file
+# Linker wants /Include and /Library on different lines
+print OPTBLD "$libperl/Include=($incstr)\n";
+print OPTBLD "$libperl/Library\n";
+open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n";
+while (<RTLOPT>) { print OPTBLD; }
+close RTLOPT;
+close OPTBLD;
+
+exec "\$ \@$drvrname" if $isvax;
+
+
+__END__
+
+# Oddball cases, so we can keep the perl.h scan above simple
+rcsid=vars      # declared in perl.c
+regarglen=vars  # declared in regcomp.h
+regdummy=vars   # declared in regcomp.h
+regkind=vars    # declared in regcomp.h
+simple=vars     # declared in regcomp.h
+varies=vars     # declared in regcomp.h
+watchaddr=vars  # declared in run.c
+watchok=vars    # declared in run.c
+yychar=vars     # generated by byacc in perly.c
+yycheck=vars    # generated by byacc in perly.c
+yydebug=vars    # generated by byacc in perly.c
+yydefred=vars   # generated by byacc in perly.c
+yydgoto=vars    # generated by byacc in perly.c
+yyerrflag=vars  # generated by byacc in perly.c
+yygindex=vars   # generated by byacc in perly.c
+yylen=vars      # generated by byacc in perly.c
+yylhs=vars      # generated by byacc in perly.c
+yylval=vars     # generated by byacc in perly.c
+yyname=vars     # generated by byacc in perly.c
+yynerrs=vars    # generated by byacc in perly.c
+yyrindex=vars   # generated by byacc in perly.c
+yyrule=vars     # generated by byacc in perly.c
+yysindex=vars   # generated by byacc in perly.c
+yytable=vars    # generated by byacc in perly.c
+yyval=vars      # generated by byacc in perly.c
diff --git a/gnu/usr.bin/perl/vms/genconfig.pl b/gnu/usr.bin/perl/vms/genconfig.pl
new file mode 100644
index 00000000000..336c24b8da4
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/genconfig.pl
@@ -0,0 +1,281 @@
+#!/usr/bin/perl
+# Habit . . .
+#
+# Extract info from Config.VMS, and add extra data here, to generate Config.sh
+# Edit the static information after __END__ to reflect your site and options
+# that went into your perl binary.  In addition, values which change from run
+# to run may be supplied on the command line as key=val pairs.
+#
+# Rev. 13-Dec-1995  Charles Bailey  bailey@genetics.upenn.edu
+#
+
+unshift(@INC,'lib');  # In case someone didn't define Perl_Root
+                      # before the build
+
+if ($ARGV[0] eq '-f') {
+  open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n";
+  @ARGV = ();
+  while (<ARGS>) {
+    push(@ARGV,split(/\|/,$_));
+  }
+  close ARGS;
+}
+
+if (-f "config.vms") { $infile = "config.vms"; $outdir = "[-]"; }
+elsif (-f "[.vms]config.vms") { $infile = "[.vms]config.vms"; $outdir = "[]"; }
+elsif (-f "config.h") { $infile = "config.h"; $outdir = "[]";}
+
+if ($infile) { print "Generating Config.sh from $infile . . .\n"; }
+else { die <<EndOfGasp;
+Can't find config.vms or config.h to read!
+	Please run this script from the perl source directory or
+	the VMS subdirectory in the distribution.
+EndOfGasp
+}
+$outdir = '';
+open(IN,"$infile") || die "Can't open $infile: $!\n";
+open(OUT,">${outdir}Config.sh") || die "Can't open ${outdir}Config.sh: $!\n";
+
+$time = localtime;
+print OUT <<EndOfIntro;
+# This file generated by GenConfig.pl on a VMS system.
+# Input obtained from:
+#     $infile
+#     $0
+# Time: $time
+
+package='perl5'
+CONFIG='true'
+cf_time='$time'
+ld='Link'
+lddlflags='/Share'
+ranlib=''
+ar=''
+eunicefix=':'
+hint='none'
+hintfile=''
+intsize='4'
+alignbytes='8'
+shrplib='define'
+usemymalloc='n'
+spitshell='write sys\$output '
+EndOfIntro
+
+$cf_by = (getpwuid($<))[0];
+print OUT "cf_by='$cf_by'\n";
+
+$hw_model = `Write Sys\$Output F\$GetSyi("HW_MODEL")`;
+chomp $hw_model;
+if ($hw_model > 1024) {
+  print OUT "arch='VMS_AXP'\n";
+  print OUT "archname='VMS_AXP'\n";
+  $archsufx = "AXP";
+}
+else {
+  print OUT "arch='VMS_VAX'\n";
+  print OUT "archname='VMS_VAX'\n";
+  $archsufx = 'VAX';
+}
+$osvers = `Write Sys\$Output F\$GetSyi("VERSION")`;
+$osvers =~ s/^V?(\S+)\s*\n?$/$1/;
+print OUT "osvers='$osvers'\n";
+foreach (@ARGV) {
+  ($key,$val) = split('=',$_,2);
+  if ($key eq 'cc') {  # Figure out which C compiler we're using
+    my($cc,$ccflags) = split('/',$val,2);
+    my($d_attr);
+    $ccflags = "/$ccflags";
+    if ($ccflags =~s!/DECC!!ig) { 
+      $cc .= '/DECC';
+      $cctype = 'decc';
+      $d_attr = 'undef';
+    }
+    elsif ($ccflags =~s!/VAXC!!ig) {
+      $cc .= '/VAXC';
+      $cctype = 'vaxc';
+      $d_attr = 'undef';
+    }
+    elsif (`$val/NoObject/NoList _nla0:/Version` =~ /GNU/) {
+      $cctype = 'gcc';
+      $d_attr = 'define';
+    }
+    elsif ($archsufx eq 'VAX' &&
+           `$val/NoObject/NoList /prefix=all _nla0:` =~ /IVQUAL/) {
+      $cctype = 'vaxc';
+      $d_attr = 'undef';
+    }
+    else {
+      $cctype = 'decc';
+      $d_attr = 'undef';
+    }
+    print OUT "vms_cc_type='$cctype'\n";
+    print OUT "d_attribut='$d_attr'\n";
+    print OUT "cc='$cc'\n";
+    if ( ($cctype eq 'decc' and $archsufx eq 'VAX') || $cctype eq 'gcc') {
+      # gcc and DECC for VAX requires filename in /object qualifier, so we
+      # have to remove it here.  Alas, this means we lose the user's
+      # object file suffix if it's not .obj.
+      $ccflags =~ s#/obj(?:ect)?=[^/\s]+##i;
+    }
+    print OUT "ccflags='$ccflags'\n";
+    $dosock = ($ccflags =~ m!/DEF[^/]+VMS_DO_SOCKETS!i and
+               $ccflags !~ m!/UND[^/]+VMS_DO_SOCKETS!i);
+    next;
+  }
+  print OUT "$key=\'$val\'\n";
+}
+
+# Are there any other logicals which TCP/IP stacks use for the host name?
+$myname = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
+          $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
+          $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
+if (!$myname) {
+  ($myname) = `hostname` =~ /^(\S+)/;
+  if ($myname =~ /IVVERB/) {
+    warn "Can't determine TCP/IP hostname" if $dosock;
+    $myname = '';
+  }
+}
+$myname = $ENV{'SYS$NODE'} unless $myname;
+($myhostname,$mydomain) = split(/\./,$myname,2);
+print OUT "myhostname='$myhostname'\n" if $myhostname;
+if ($mydomain) {
+  print OUT "mydomain='.$mydomain'\n";
+  print OUT "perladmin='$cf_by\@$myhostname.$mydomain'\n";
+  print OUT "cf_email='$cf_by\@$myhostname.$mydomain'\n";
+}
+else {
+  print OUT "perladmin='$cf_by'\n";
+  print OUT "cf_email='$cf_by'\n";
+}
+chomp($hwname = `Write Sys\$Output F\$GetSyi("HW_NAME")`);
+$hwname = $archsufx if $hwname =~ /IVKEYW/;  # *really* old VMS version
+print OUT "myuname='VMS $myname $osvers $hwname'\n";
+
+while (<IN>) {  # roll through the comment header in Config.VMS
+  last if /config-start/;
+}
+
+while (<IN>) {
+  chop;
+  while (/\\\s*$/) {  # pick up contination lines
+    my $line = $_;
+    $line =~ s/\\\s*$//;
+    $_ = <IN>;
+    s/^\s*//;
+    $_ = $line . $_;
+  }              
+  next unless my ($blocked,$un,$token,$val) = m%^(\/\*)?\s*\#\s*(un)?def\w*\s*([A-za-z0-9]\w+)\S*\s*(.*)%;
+  next if /config-skip/;
+  $state = ($blocked || $un) ? 'undef' : 'define';
+  $token =~ tr/A-Z/a-z/;
+  $token =~ s/_exp$/exp/;  # Config.pm has 'privlibexp' etc. where config.h
+                           # has 'privlib_exp' etc.
+  # Fixup differences between Configure vars and config.h manifests
+  # This isn't comprehensize; we fix 'em as we need 'em.
+  $token = 'castneg'   if $token eq 'castnegfloat';
+  $token = 'dlsymun'   if $token eq 'dlsym_needs_underscore';
+  $token = 'stdstdio'  if $token eq 'use_stdio_ptr';
+  $token = 'stdiobase'  if $token eq 'use_stdio_base';
+  $val =~ s%/\*.*\*/\s*%%g;  $val =~ s/\s*$//;  # strip off trailing comment
+  $val =~ s/^"//; $val =~ s/"$//;               # remove end quotes
+  $val =~ s/","/ /g;                            # make signal list look nice
+  if ($val) { print OUT "$token=\'$val\'\n"; }
+  else {
+    $token = "d_$token" unless $token =~ /^i_/;
+    print OUT "$token='$state'\n";
+  }
+}
+close IN;
+
+while (<DATA>) {
+  next if /^\s*#/ or /^\s*$/;
+  s/#.*$//;  s/\s*$//;
+  ($key,$val) = split('=',$_,2);
+  print OUT "$key='$val'\n";
+  eval "\$$key = '$val'";
+}
+# Add in some of the architecture-dependent stuff which has to be consistent
+print OUT "d_vms_do_sockets=",$dosock ? "'define'\n" : "'undef'\n";
+print OUT "d_has_sockets=",$dosock ? "'define'\n" : "'undef'\n";
+$archlib = &VMS::Filespec::vmspath($privlib);
+$installarchlib = &VMS::Filespec::vmspath($installprivlib);
+$sitearch = &VMS::Filespec::vmspath($sitelib);
+$archlib =~ s#\]#.VMS_$archsufx\]#;
+$sitearch =~ s#\]#.VMS_$archsufx\]#;
+print OUT "oldarchlib='$archlib'\n";
+print OUT "oldarchlibexp='$archlib'\n";
+($vers = $]) =~ tr/./_/;
+$archlib =~ s#\]#.$vers\]#;
+$installarchlib =~ s#\]#.VMS_$archsufx.$vers\]#;
+print OUT "archlib='$archlib'\n";
+print OUT "archlibexp='$archlib'\n";
+print OUT "installarchlib='$installarchlib'\n";
+print OUT "sitearch='$sitearch'\n";
+print OUT "sitearchexp='$sitearch'\n";
+
+if (open(OPT,"${outdir}crtl.opt")) {
+  while (<OPT>) {
+    next unless m#/(sha|lib)#i;
+    chomp;
+    if (/crtl/i || /gcclib/i) { push(@crtls,$_); }
+    else                      { push(@libs,$_);  }
+  }
+  close OPT;
+  print OUT "libs='",join(' ',@libs),"'\n";
+  push(@crtls,'(DECCRTL)') if $cctype eq 'decc';
+  print OUT "libc='",join(' ',@crtls),"'\n";
+}
+else { warn "Can't read ${outdir}crtl.opt - skipping 'libs' & 'libc'"; }
+
+if (open(PL,"${outdir}patchlevel.h")) {
+  while (<PL>) {
+    if    (/^#define PATCHLEVEL\s+(\S+)/) { print OUT "PATCHLEVEL='$1'\n"; }
+    elsif (/^#define SUBVERSION\s+(\S+)/) { print OUT "SUBVERSION='$1'\n"; }
+  }
+  close PL;
+}
+else { warn "Can't read ${outdir}patchlevel.h - skipping 'PATCHLEVEL'"; }
+
+# simple pager support for perldoc
+if    (`most` =~ /IVVERB/) {
+  $pager = 'more';
+  if (`more nl:` =~ /IVVERB/) { $pager = 'type/page'; }
+}
+else { $pager = 'most'; }
+print OUT "pager='$pager'\n";
+
+close OUT;
+__END__
+
+# This list is incomplete in comparison to what ends up in config.sh, but
+# should contain the essentials.  Some of these definitions reflect
+# options chosen when building perl or site-specific data; these should
+# be hand-edited appropriately.  Someday, perhaps, we'll get this automated.
+
+# The definitions in this block are constant across most systems, and
+# should only rarely need to be changed.
+ccdlflags=
+cccdlflags=
+usedl=true
+dlobj=dl_vms.obj
+dlsrc=dl_vms.c
+so=exe
+dlext=exe
+libpth=/sys$share /sys$library
+usevfork=false
+castflags=0
+signal_t=void
+timetype=long
+builddir=perl_root:[000000]
+prefix=perl_root
+installprivlib=perl_root:[lib]     # The *lib constants should match the
+privlib=perl_root:[lib]            # equivalent *(?:ARCH)LIB_EXP constants
+sitelib=perl_root:[lib.site_perl]  # in config.h
+installbin=perl_root:[000000]
+installman1dir=perl_root:[man.man1]
+installman3dir=perl_root:[man.man3]
+man1ext=rno
+man3ext=rno
+binexp=perl_root:[000000]  # should be same as installbin
+useposix=false
diff --git a/gnu/usr.bin/perl/vms/genopt.com b/gnu/usr.bin/perl/vms/genopt.com
new file mode 100644
index 00000000000..70013aec425
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/genopt.com
@@ -0,0 +1,18 @@
+$! generates options file for vms link
+$! p1 is filename and mode to open file (filename/write or filename/append)
+$! p2 is delimiter separating elements of list in p3
+$! p3 is list of items to be written, one per line, into options file
+$
+$ open file 'p1'
+$ element=0
+$loop:
+$ x=f$element(element,p2,p3)
+$ if x .eqs. p2 then goto out
+$ y=f$edit(x,"COLLAPSE")  ! lose spaces
+$ if y .nes. "" then write file y
+$ element=element+1
+$ goto loop
+$
+$out:
+$ close file
+$ exit
diff --git a/gnu/usr.bin/perl/vms/make_command.com b/gnu/usr.bin/perl/vms/make_command.com
new file mode 100644
index 00000000000..c3a9da8b804
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/make_command.com
@@ -0,0 +1,21 @@
+$! MAKE_COMMAND.COM
+$! Record MM[SK]/Make parameters in configuration report
+$!
+$! Author:  Peter Prymmer <pvhp@lns62.lns.cornell.edu>
+$! Version: 1.0  18-Jan-1996
+$!
+$! DCL usage (choose one):
+$!      @MAKE_COMMAND                      !or
+$!      @MAKE_COMMAND/OUTPUT=MYCONFIG.OUT
+$!------------------------------------------------
+$ $mms = "'"+p1
+$ $makeline = p2+" "+p3+" "+p4+" "+p5+" "+p6+" "+p7+" "+p8
+$quotable:
+$ if f$locate("""",$makeline).lt.f$length($makeline)
+$   then
+$   $makeline = $makeline - """"
+$   goto quotable
+$ endif
+$ $makeline = f$edit($makeline,"COMPRESS,TRIM")
+$ write sys$output " make_cmd=''$mms'"+" ''$makeline''"
+$!------------------------------------------------
diff --git a/gnu/usr.bin/perl/vms/mms2make.pl b/gnu/usr.bin/perl/vms/mms2make.pl
new file mode 100644
index 00000000000..6b35e75ffbd
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/mms2make.pl
@@ -0,0 +1,122 @@
+#!/usr/bin/perl
+#
+#  mms2make.pl - convert Descrip.MMS file to Makefile
+#  Version 2.2 29-Jan-1996
+#  David Denholm <denholm@conmat.phys.soton.ac.uk>
+#
+#  1.0  06-Aug-1994  Charles Bailey  bailey@genetics.upenn.edu
+#    - original version
+#  2.0  29-Sep-1994  David Denholm <denholm@conmat.phys.soton.ac.uk>
+#    - take action based on MMS .if / .else / .endif
+#      any command line options after filenames are set in an assoc array %macros
+#      maintain "@condition as a stack of current conditions
+#      we unshift a 0 or 1 to front of @conditions at an .ifdef
+#      we invert top of stack at a .else
+#      we pop at a .endif
+#      we deselect any other line if $conditions[0] is 0
+#      I'm being very lazy - push a 1 at start, then dont need to check for
+#      an empty @conditions [assume nesting in descrip.mms is correct] 
+#  2.1  26-Feb-1995  Charles Bailey  bailey@genetics.upenn.edu
+#    - handle MMS macros generated by MakeMaker
+#  2.2  29-Jan-1996  Charles Bailey  bailey@genetics.upenn.edu
+#    - Fix output file name to work under Unix
+
+if ($#ARGV > -1 && $ARGV[0] =~ /^[\-\/]trim/i) {
+  $do_trim = 1;
+  shift @ARGV;
+}
+$infile  = $#ARGV > -1 ? shift(@ARGV) : "Descrip.MMS";
+$outfile = $#ARGV > -1 ? shift(@ARGV) : "Makefile";
+
+# set any other args in %macros - set VAXC by default
+foreach (@ARGV) { $macros{"\U$_"}=1 }
+
+# consistency check
+$macros{"DECC"} = 1 if $macros{"__AXP__"};
+
+# set conditions as if there was a .if 1  around whole file
+# [lazy - saves having to check for empty array - just test [0]==1]
+@conditions = (1);
+
+open(INFIL,$infile) || die "Can't open $infile: $!\n"; 
+open(OUTFIL,">$outfile") || die "Can't open $outfile: $!\n"; 
+
+print OUTFIL "#> This file produced from $infile by $0\n";
+print OUTFIL "#> Lines beginning with \"#>\" were commented out during the\n";
+print OUTFIL "#> conversion process.  For more information, see $0\n";
+print OUTFIL "#>\n";
+
+while (<INFIL>) {
+  s/$infile/$outfile/eoi;
+  if (/^\#/) { 
+    if (!/^\#\:/) {print OUTFIL;}
+    next;
+  }
+
+# look for ".ifdef macro" and push 1 or 0 to head of @conditions
+# push 0 if we are in false branch of another if
+  if (/^\.ifdef\s*(.+)/i)
+  {
+     print OUTFIL "#> ",$_ unless $do_trim;
+     unshift @conditions, ($macros{"\U$1"} ? $conditions[0] : 0);
+     next;
+  }
+
+# reverse $conditions[0] for .else provided surrounding if is active
+  if (/^\.else/i)
+  {
+      print OUTFIL "#> ",$_ unless $do_trim;
+      $conditions[0] = $conditions[1] && !$conditions[0];
+      next;
+  }
+
+# pop top condition for .endif
+  if (/^\.endif/i)
+  {
+     print OUTFIL "#> ",$_ unless $do_trim;
+     shift @conditions;
+     next;
+  }
+
+  next if ($do_trim && !$conditions[0]);
+
+# spot new rule and pick up first source file, since some versions of
+# Make don't provide a macro for this
+  if (/[^#!]*:\s+/) {
+    if (/:\s+([^\s,]+)/) { $firstsrc = $1 }
+    else { $firstsrc = "\$<" }
+  }
+
+#convert macros we expect to see in MakeMaker-generated Descrip.MMSs
+  s#/Descrip=\s*\n#-f \nMMS = make\n#;
+  s#/Macro=\(# #;
+  s#MACROEND = \)#MACROEND = #;
+  if (m#\$\(USEMACROS\)(.*)(\$\(MACROEND\))?#) {
+    while (1) {
+      my($macros,$end) = ($1,$2);
+      $macros =~ s/,/ /g;  # We're hosed if there're commas within a macro -
+                           # someday, check for "" and skip contents
+      last if $end;
+      print OUTFIL $conditions[0] ? "#> " : "",$_;
+      $_ = <INFIL>;
+      m#(.*)(\$\(MACROEND\))?#;
+    }
+  }
+
+  s/^ +/\t/;
+  s/^\.first/\.first:/i;
+  s/^\.suffixes/\.suffixes:/i;
+  s/\@\[\.vms\]/\$\$\@\[\.vms\]/;
+  s/f\$/f\$\$/goi;
+  s/\$\(mms\$source\)/$firstsrc/i;
+  s/\$\(mms\$target\)/\$\@/i;
+  s/\$\(mms\$target_name\)\$\(O\)/\$\@/i;
+  s/\$\(mms\$target_name\)/\$\*/i;
+  s/sys\$([^\(])/sys\$\$$1/gi;
+  print OUTFIL "#> " unless $conditions[0];
+  print OUTFIL $_;
+}
+
+close INFIL;
+close OUTFIL;
+
diff --git a/gnu/usr.bin/perl/vms/myconfig.com b/gnu/usr.bin/perl/vms/myconfig.com
new file mode 100644
index 00000000000..7fb728eb62b
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/myconfig.com
@@ -0,0 +1,325 @@
+$! #!/bin/sh  ---> MYCONFIG.COM
+
+$! # This script is designed to provide a handy summary of the configuration
+$! # information being used to build perl. This is especially useful if you
+$! # are requesting help from comp.lang.perl.misc on usenet or via mail.
+
+$! DCL-ified by Peter Prymmer <pvhp@lns62.lns.cornell.edu> 22-DEC-1995
+$! DCL usage (choose one):
+$!      @MYCONFIG                                                       !or
+$!      @MYCONFIG/OUTPUT=MYCONFIG.OUT                                   !or
+$!      @MYCONFIG [node::][which$disk:][[dir.subdir]]CONFIG.SH          !or
+$!      @MYCONFIG/OUTPUT=MYCONFIG.OUT [node::][w$disk:][[dir]]CONFIG.SH
+$!  version 2:
+$! Incorporates Charles Bailey's ideas about bootstrapping system info - 
+$! myconfig.com is now callable as a "myconfig" target in your maker and
+$! may even work if miniperl.exe and config.sh files fail to be made.
+$! Thus if: 
+$!      MMK/DESCRIP=[.VMS]                             !(or MMS or MAKE)
+$! does not work then try:
+$!      MMK/DESCRIP=[.VMS]/OUTPUT=MYPERLBUILD.PROBLEM  !(or MMS or MAKE)
+$! Then discuss the MYPERLBUILD.PROBLEM file with a local expert.
+$! If that still does not work then try:
+$!      MMK/DESCRIP=[.VMS]/OUT=MYNONFIG.OUT MYCONFIG   !(or MMS or MAKE)
+$! send output (MYNONFIG.OUT) to an outside expert and ask politely for help.
+
+$ ECHO = "WRITE SYS$OUTPUT " 
+$ RATHER_LONG_DEFAULT_DIRECTORY_NAME = F$ENVIRONMENT("DEFAULT")
+
+$ if (p1.nes."").and.(p2.eqs."")
+$   then RATHER_LONG_FILENAME_TO_FIND = p1 !no typo-checking (experts only)
+$   else RATHER_LONG_FILENAME_TO_FIND = "CONFIG.SH"
+$ endif
+$Research:
+$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND)
+$ if RATHER_LONG_FILENAME_SEARCH.EQS."" 
+$   then
+$     if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]"
+$       then 
+$         set default [-]
+$         goto Research
+$       else
+$ 	  ECHO "Can't find the perl config.sh file produced by Configure"
+$         set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME'
+$!         exit 3
+$         goto cannot_find_config_sh
+$     endif
+$ endif
+
+$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' 
+$Loop:
+$  read/end_of_file = Done RATHER_LONG_CONFIG_FILE_HANDLE  line
+$  name = f$extract(0,f$locate("=",line),line)
+$  start = f$locate("'",line)+1
+$  stop = f$locate("'",line)
+$  value = f$extract(start,stop-start,line)
+$  if (f$locate("#",name).eqs.f$length(name)).and. -
+      (name.nes."").and. -
+      (name.nes."'") -               !bug in genconfig.pl (vms) for osvers='' ?
+        then $$'name' = "'" + value  !$ not necessary but looks more sh-ish
+$ goto Loop
+
+$Done:
+$ close RATHER_LONG_CONFIG_FILE_HANDLE 
+$ goto spit_it_out
+
+$cannot_find_config_sh:
+$! these parameters are assumed to be passed from make/mm[s|k]:
+$!   p1=$(CC),    p2=$(CFLAGS), p3=$(LINKFLAGS), 
+$!   p4=$(LIBS1), p5=$(LIBS2),  p6=$(SOCKLIB),
+$!   p7=$(EXT),   p8=$(DBG)
+$! so assign to appropriate $var:
+$ $cc = "'"+p1+"'"            ! p1=$(CC) from make
+$ $ccflags = "'"+p2+"'"       ! p2=$(CFLAGS) from make
+$ $ldflags = "'"+p3+"'"       ! p3=$(LINKFLAGS) from make 
+$ $libs = "'"+p4+" "+p5+" "+p6+"'" ! p4$(LIBS1),p5$(LIBS2),p6$(SOCKLIB)frm make
+$ $staticexts = "'"+p7+"'"         ! p7=$(EXT) from make
+
+$!  hard-coded stuff (for now): 
+$ $cppflags = "'"+"'"  !(vestigal)
+$ $optimize = "'"+"'"  !descrip.mms has /Optimize=2 in $(XTRACCFLAGS)
+
+$!  following assigns done via `dcl` calls in genconfig.pl anyway:
+$ $osname = "'"+f$edit(f$getsyi("NODE_SWTYPE"),"COLLAPSE") !genconfig.pl has "osname='VMS'"
+$ $osvers = f$edit(f$getsyi("VERSION")-"V","COLLAPSE")
+$ if f$getsyi("HW_MODEL").GT.1024
+$   then $$archname = "'VMS_AXP'"  !string from descrip.mms vmsperl 12-21-95
+$   else $$archname = "'VMS_VAX'"  !string from descrip.mms vmsperl 12-21-95
+$ endif
+$ $myname = ""
+$  if $myname.eqs."" then $$myname = f$trnlnm("ARPANET_HOST_NAME")
+$  if $myname.eqs."" then $$myname = f$trnlnm("INTERNET_HOST_NAME")
+$  if $myname.eqs."" then $$myname = f$trnlnm("MULTINET_HOST_NAME")
+$  if $myname.eqs."" then $$myname = f$trnlnm("UCX$INET_HOST_NAME")
+$  if $myname.eqs."" then $$myname = f$trnlnm("TCPWARE_DOMAINNAME")
+$  if $myname.eqs."" then $$myname = f$trnlnm("NEWS_ADDRESS")
+$  if $myname.eqs."" then $$myname = f$trnlnm("SYS$NODE")
+$!  Is this same as genconfig.pl ? (spacing/order unknown):
+$ $myuname=$osname+" "+$myname+" "+$osvers+" "+F$GetSyi("HW_NAME")+"'"
+$ $osname = $osname+"'"
+$ $osvers = "'"+$osvers+"'"
+
+$look_for_patchlevel_h:
+$!
+$ RATHER_LONG_FILENAME_TO_FIND = "PATCHLEVEL.H"
+$Research_patchlevel_h:
+$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND)
+$ if RATHER_LONG_FILENAME_SEARCH.EQS."" 
+$   then
+$     if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]"
+$       then 
+$         set default [-]
+$         goto Research_patchlevel_h
+$       else
+$ 	  ECHO "Can't find the header file patchlevel.h used to make config.sh"
+$         set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME'
+$         goto look_for_genconfig.pl
+$     endif
+$ endif
+
+$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' 
+$read_patchlevel_h:
+$ read/end_of_file = patchlevel_h_Done RATHER_LONG_CONFIG_FILE_HANDLE  line
+$ if f$locate("PATCHLEVEL",line).ne.f$length(line)
+$   then
+$     line = f$edit(line,"TRIM,COMPRESS")
+$     $PATCHLEVEL = f$element(2," ",line)
+$     if f$type($SUBVERSION).nes."" then goto patchlevel_h_Done
+$ endif
+$ if f$locate("SUBVERSION",line).ne.f$length(line)
+$   then
+$     line = f$edit(line,"TRIM,COMPRESS")
+$     $SUBVERSION = f$element(2," ",line)
+$     if f$type($PATCHLEVEL).nes."" then goto patchlevel_h_Done
+$ endif
+$ goto read_patchlevel_h
+
+$patchlevel_h_Done:
+$ close RATHER_LONG_CONFIG_FILE_HANDLE 
+$ if $PATCHLEVEL.eqs.""
+$   then
+$     echo "warning: PATCHLEVEL was not found in ''RATHER_LONG_FILENAME_TO_FIND':" 
+$ endif
+
+$look_for_genconfig_pl:
+$!
+$ if f$search("VMS.DIR").nes."" then set default [.vms]
+$ RATHER_LONG_FILENAME_TO_FIND = "GENCONFIG.PL"
+$ genconfig_pl_dir = ""
+$Research_genconfig_pl:
+$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND)
+$ if RATHER_LONG_FILENAME_SEARCH.EQS."" 
+$   then
+$     if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]"
+$       then 
+$         set default [-]
+$         goto Research_genconfig_pl
+$       else
+$ 	  ECHO "Can't find the perl genconfig.pl used to make config.sh"
+$         set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME'
+$         goto look_for_config_vms
+$     endif
+$   else    !genconfig.pl has been found
+$     genconfig_pl_dir = f$parse(f$environment("DEFAULT"),,,"DIRECTORY",)
+$ endif
+
+$ cnfg_keys = "package/hintfile/ld/dlext/d_stdstdio/"
+$ cnfg_keys = cnfg_keys + "usevfork/usemymalloc/so/libpth/"
+$ cnfg_keys = cnfg_keys + "dlsrc/cccdlflags/ccdlflags/lddlflags/"
+
+$ cnfg_vars = "$package/$hint/$ld/$dlext/$d_stdstdio/"
+$ cnfg_vars = cnfg_vars + "$usevfork/$usemymalloc/$so/$libpth/"
+$ cnfg_vars = cnfg_vars + "$dlsrc/$cccdlflags/$ccdlflags/$lddlflags/" 
+
+$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' 
+$read_genconfig_pl:
+$ read/end_of_file = Genconfig_pl_Done RATHER_LONG_CONFIG_FILE_HANDLE  line
+$ if f$locate("=",line).ne.f$length(line)   !then may be an assigment
+$   then
+$     name = f$edit( f$extract(0,f$locate("=",line),line), "COLLAPSE")
+$     num = 0
+$key_genconfig_pl:
+$     key = f$element(num,"/",cnfg_keys)
+$     if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys
+$       then
+$         if key.eqs.name  !then is key
+$           then
+$             start = f$locate("=",line)+1
+$             stop = f$length(line)
+$             value = f$extract(start,stop-start,line)
+$             var = f$element(num,"/",cnfg_vars)
+$             'var' = value  
+$             cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches
+$             cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches
+$         endif
+$         num = num + 1
+$         goto key_genconfig_pl
+$     endif ! not end of cnfg_keys
+$ endif ! then may be an assigment
+$ goto read_genconfig_pl
+
+$Genconfig_pl_Done:
+$ close RATHER_LONG_CONFIG_FILE_HANDLE 
+$ if cnfg_vars.nes.""
+$   then
+$     echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" 
+$     echo "''cnfg_vars'"
+$ endif
+
+$ if (p8.nes."").and.($ld.nes."") then $ld = $ld + " DBG='"+p8+"'" 
+
+$look_for_config_vms:
+$ RATHER_LONG_FILENAME_TO_FIND = "''genconfig_pl_dir'CONFIG.VMS"
+
+$Research_config_vms:
+$ RATHER_LONG_FILENAME_SEARCH = F$Search(RATHER_LONG_FILENAME_TO_FIND)
+$ if RATHER_LONG_FILENAME_SEARCH.EQS."" 
+$   then
+$     if f$parse(f$environment("DEFAULT"),,,"DIRECTORY",).NES."[000000]"
+$       then 
+$         set default [-]
+$         goto Research_config_vms
+$       else
+$ 	  ECHO "Can't find the perl config.vms used to make config.sh"
+$         set default 'RATHER_LONG_DEFAULT_DIRECTORY_NAME'
+$         stop
+$         exit 3 
+$     endif
+$ endif
+
+$ cnfg_keys = "MEM_ALIGNBYTES/CASTNEGFLOAT/CASTFLAGS/RANDBITS/STDCHAR/"
+$ cnfg_keys = cnfg_keys+"CASTI32/INTSIZE/VOIDFLAGS/DLSYM_NEEDS_UNDERSCORE"
+
+$ cnfg_vars = "$alignbytes/$d_castneg/$castflags/$randbits/$stdchar/"
+$ cnfg_vars = cnfg_vars+"$d_casti32/$intsize/$voidflags/$d_dlsymun/"
+
+$ open/read RATHER_LONG_CONFIG_FILE_HANDLE 'RATHER_LONG_FILENAME_SEARCH' 
+$read_config_vms:
+$ read/end_of_file = config_vms_Done RATHER_LONG_CONFIG_FILE_HANDLE  line
+$! look for "#define" or "#undef"
+$ if (f$length(line).ne.0).and.-
+   ((f$locate("#define",line).eq.0).or.(f$locate("#undef",line).eq.0)) 
+$   then
+$     line = f$edit(line,"COMPRESS, TRIM")
+$     name = f$element(1," ",line) !macro
+$     num = 0
+$key_config_vms:
+$     key = f$element(num,"/",cnfg_keys)
+$     if (key .nes. "/").and.(key .nes. "") !not end of cnfg_keys
+$       then
+$         if key.eqs.name  !then is key
+$           then
+$             var = f$element(num,"/",cnfg_vars)
+$             cnfg_keys = cnfg_keys - ("''name'/" ) !trim to shorten future matches
+$             cnfg_vars = cnfg_vars - ("''var'/" ) !trim to shorten future matches
+$             if (f$locate("#undef",line).eq.0)
+$               then
+$                 'var' = "'undef'"
+$               else                  !is a #define
+$strip_comment:
+$                 start = f$locate("/*",line)
+$                 if start.ne.f$length(line) !comment started
+$                   then
+$                     if f$locate("*/",line).ne.f$length(line) !comment stopped
+$                       then stop = f$locate("*/",line)+2
+$                       else stop = f$locate("*/",line)
+$                     endif
+$                     comment = f$extract(start,stop-start,line)
+$                     line = line - comment
+$                     goto strip_comment
+$                 endif
+$                 line = f$edit(line,"TRIM")
+$                 start = f$locate(key,line)+f$length(key)
+$                 stop = f$length(line)
+$                 value = f$edit(f$extract(start,stop-start,line),"TRIM")
+$                 if (value.nes."") 
+$                   then 
+$                     'var' = "'"+value+"'"
+$                   else 
+$                     'var' = "'define'"
+$                 endif
+$             endif            !#define
+$         endif                ! is key of interest
+$         num = num + 1
+$         goto key_config_vms
+$     endif ! not end of cnfg_keys
+$ endif ! then may be #define or #undef of interest
+$ goto read_config_vms
+
+$config_vms_Done:
+$ close RATHER_LONG_CONFIG_FILE_HANDLE 
+$ if cnfg_vars.nes.""
+$   then
+$     echo "warning: the following variables were not found in ''RATHER_LONG_FILENAME_TO_FIND':" 
+$     echo "''cnfg_vars'"
+$ endif
+
+$spit_it_out:
+$! $spitshell = ECHO !<<!GROK!THIS! 
+$ ECHO " "
+$ ECHO "Summary of my ''$package' (patchlevel ''$PATCHLEVEL' subversion ''$SUBVERSION') configuration:"
+$ ECHO "  Platform:"
+$ ECHO "    osname=''$osname', osver=''$osvers', archname=''$archname'"
+$ ECHO "     uname=''$myuname'"                             !->d_has_uname?
+$ ECHO "     hint=''$hint' d_sigaction='undef'"             !->hintfile?
+$ ECHO "     static exts=''$staticexts'"                    ! added for VMS
+$ ECHO "   Compiler:"
+$ ECHO "     cc=''$cc', optimize=''$optimize', ld=''$ld'"
+$ ECHO "     cppflags=''$cppflags'"
+$ ECHO "     ccflags =''$ccflags'"                          !->vms_cc_type?
+$ ECHO "     ldflags =''$ldflags'"
+$ ECHO "     stdchar=''$stdchar', d_stdstdio=''$d_stdstdio', usevfork=''$usevfork'"
+$ ECHO "     voidflags=''$voidflags', castflags=''$castflags', d_casti32=''$d_casti32', d_castneg=''$d_castneg'"
+$ ECHO "     intsize=''$intsize', alignbytes=''$alignbytes', usemymalloc=''$usemymalloc', randbits=''$randbits'"
+$ ECHO "   Libraries:"
+$ ECHO "     so=''$so'"
+$ ECHO "     libpth=''$libpth'"
+$ ECHO "     libs=''$libs'"
+$ ECHO "     libc=''$libc'"
+$ ECHO "   Dynamic Linking:"
+$ ECHO "     dlsrc=''$dlsrc', dlext=''$dlext', d_dlsymun=''$d_dlsymun'"
+$ ECHO "     cccdlflags=''$cccdlflags', ccdlflags=''$ccdlflags', lddlflags=''$lddlflags'"
+$ ECHO " " 
+$ !GROK!THIS!
+$ SET DEFAULT 'RATHER_LONG_DEFAULT_DIRECTORY_NAME'
+$ EXIT
diff --git a/gnu/usr.bin/perl/vms/perlvms.pod b/gnu/usr.bin/perl/vms/perlvms.pod
new file mode 100644
index 00000000000..a66df9c8df2
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/perlvms.pod
@@ -0,0 +1,662 @@
+=head1 NAME
+
+perlvms - VMS-specific documentation for Perl
+
+=head1 DESCRIPTION
+
+Gathered below are notes describing details of Perl 5's 
+behavior on VMS.  They are a supplement to the regular Perl 5 
+documentation, so we have focussed on the ways in which Perl 
+5 functions differently under VMS than it does under Unix, 
+and on the interactions between Perl and the rest of the 
+operating system.  We haven't tried to duplicate complete 
+descriptions of Perl features from the main Perl 
+documentation, which can be found in the F<[.pod]> 
+subdirectory of the Perl distribution.
+
+We hope these notes will save you from confusion and lost 
+sleep when writing Perl scripts on VMS.  If you find we've 
+missed something you think should appear here, please don't 
+hesitate to drop a line to vmsperl@genetics.upenn.edu.
+
+=head1 Installation
+
+Directions for building and installing Perl 5 can be found in 
+the file F<README.vms> in the main source directory of the 
+Perl distribution..
+
+=head1 Organization of Perl Images
+
+=head2 Core Images
+
+During the installation process, three Perl images are produced.
+F<Miniperl.Exe> is an executable image which contains all of
+the basic functionality of Perl, but cannot take advantage of
+Perl extensions.  It is used to generate several files needed
+to build the complete Perl and various extensions.  Once you've
+finished installing Perl, you can delete this image.
+
+Most of the complete Perl resides in the shareable image
+F<PerlShr.Exe>, which provides a core to which the Perl executable
+image and all Perl extensions are linked.  You should place this
+image in F<Sys$Share>, or define the logical name F<PerlShr> to
+translate to the full file specification of this image.  It should
+be world readable.  (Remember that if a user has execute only access
+to F<PerlShr>, VMS will treat it as if it were a privileged shareable
+image, and will therefore require all downstream shareable images to be
+INSTALLed, etc.)
+
+
+Finally, F<Perl.Exe> is an executable image containing the main
+entry point for Perl, as well as some initialization code.  It
+should be placed in a public directory, and made world executable.
+In order to run Perl with command line arguments, you should
+define a foreign command to invoke this image.
+
+=head2 Perl Extensions
+
+Perl extensions are packages which provide both XS and Perl code
+to add new functionality to perl.  (XS is a meta-language which
+simplifies writing C code which interacts with Perl, see
+L<perlapi> for more details.)  The Perl code for an
+extension is treated like any other library module - it's
+made available in your script through the appropriate
+C<use> or C<require> statement, and usually defines a Perl
+package containing the extension.
+
+The portion of the extension provided by the XS code may be
+connected to the rest of Perl in either of two ways.  In the
+B<static> configuration, the object code for the extension is
+linked directly into F<PerlShr.Exe>, and is initialized whenever
+Perl is invoked.  In the B<dynamic> configuration, the extension's
+machine code is placed into a separate shareable image, which is
+mapped by Perl's DynaLoader when the extension is C<use>d or
+C<require>d in your script.  This allows you to maintain the
+extension as a separate entity, at the cost of keeping track of the
+additional shareable image.  Most extensions can be set up as either
+static or dynamic.
+
+The source code for an extension usually resides in its own
+directory.  At least three files are generally provided:
+I<Extshortname>F<.xs> (where I<Extshortname> is the portion of
+the extension's name following the last C<::>), containing
+the XS code, I<Extshortname>F<.pm>, the Perl library module
+for the extension, and F<Makefile.PL>, a Perl script which uses
+the C<MakeMaker> library modules supplied with Perl to generate
+a F<Descrip.MMS> file for the extension.
+
+=head2 Installing static extensions
+
+Since static extensions are incorporated directly into
+F<PerlShr.Exe>, you'll have to rebuild Perl to incorporate a
+new extension.  You should edit the main F<Descrip.MMS> or F<Makefile>
+you use to build Perl, adding the extension's name to the C<ext>
+macro, and the extension's object file to the C<extobj> macro.
+You'll also need to build the extension's object file, either
+by adding dependencies to the main F<Descrip.MMS>, or using a
+separate F<Descrip.MMS> for the extension.  Then, rebuild
+F<PerlShr.Exe> to incorporate the new code.
+
+Finally, you'll need to copy the extension's Perl library
+module to the F<[.>I<Extname>F<]> subdirectory under one
+of the directories in C<@INC>, where I<Extname> is the name
+of the extension, with all C<::> replaced by C<.> (e.g.
+the library module for extension Foo::Bar would be copied
+to a F<[.Foo.Bar]> subdirectory).
+
+=head2 Installing dynamic extensions
+
+In general, the distributed kit for a Perl extension includes
+a file named Makefile.PL, which is a Perl program which is used
+to create a F<Descrip.MMS> file which can be used to build and
+install the files required by the extension.  The kit should be
+unpacked into a directory tree B<not> under the main Perl source
+directory, and the procedure for building the extension is simply
+
+    $ perl Makefile.PL  ! Create Descrip.MMS
+    $ mmk               ! Build necessary files
+    $ mmk test          ! Run test code, if supplied
+    $ mmk install       ! Install into public Perl tree
+
+I<N.B.> The procedure by which extensions are built and
+tested creates several levels (at least 4) under the
+directory in which the extension's source files live.
+For this reason, you shouldn't nest the source directory
+too deeply in your directory structure, lest you eccedd RMS'
+maximum of 8 levels of subdirectory in a filespec.  (You
+can use rooted logical names to get another 8 levels of
+nesting, if you can't place the files near the top of
+the physical directory structure.)
+
+VMS support for this process in the current release of Perl
+is sufficient to handle most extensions.  However, it does
+not yet recognize extra libraries required to build shareable
+images which are part of an extension, so these must be added
+to the linker options file for the extension by hand.  For
+instance, if the F<PGPLOT> extension to Perl requires the
+F<PGPLOTSHR.EXE> shareable image in order to properly link
+the Perl extension, then the line C<PGPLOTSHR/Share> must
+be added to the linker options file F<PGPLOT.Opt> produced
+during the build process for the Perl extension.
+
+By default, the shareable image for an extension is placed
+in the F<[.Lib.Auto.>I<Arch>.I<Extname>F<]> directory of the
+installed Perl directory tree (where I<Arch> is F<VMS_VAX> or
+F<VMS_AXP>, followed by the Perl version number, and I<Extname>
+is the name of the extension, with each C<::> translated to C<.>).
+However, it can be manually placed in any of several locations:
+   - the F<[.Lib.Auto.>I<Extname>F<]> subdirectory of one of
+     the directories in C<@INC>, or
+   - one of the directories in C<@INC>, or
+   - a directory which the extensions Perl library module
+     passes to the DynaLoader when asking it to map
+     the shareable image, or
+   - F<Sys$Share> or F<Sys$Library>.
+If the shareable image isn't in any of these places, you'll need
+to define a logical name I<Extshortname>, where I<Extshortname>
+is the portion of the extension's name after the last C<::>, which
+translates to the full file specification of the shareable image.
+
+=head1 File specifications
+
+=head2 Syntax
+
+We have tried to make Perl aware of both VMS-style and Unix-
+style file specifications wherever possible.  You may use 
+either style, or both, on the command line and in scripts, 
+but you may not combine the two styles within a single fle 
+specification.  Filenames are, of course, still case-
+insensitive.  For consistency, most Perl routines return 
+filespecs using lower case letters only, regardless of the 
+case used in the arguments passed to them.  (This is true 
+only when running under VMS; Perl respects the case-
+sensitivity of OSs like Unix.)
+
+We've tried to minimize the dependence of Perl library 
+modules on Unix syntax, but you may find that some of these, 
+as well as some scripts written for Unix systems, will 
+require that you use Unix syntax, since they will assume that 
+'/' is the directory separator, I<etc.>  If you find instances 
+of this in the Perl distribution itself, please let us know, 
+so we can try to work around them. 
+
+=head2 Wildcard expansion
+
+File specifications containing wildcards are allowed both on 
+the command line and within Perl globs (e.g. <CE<lt>*.cE<gt>>).  If 
+the wildcard filespec uses VMS syntax, the resultant 
+filespecs will follow VMS syntax; if a Unix-style filespec is 
+passed in, Unix-style filespecs will be returned.
+
+If the wildcard filespec contains a device or directory 
+specification, then the resultant filespecs will also contain 
+a device and directory; otherwise, device and directory 
+information are removed.  VMS-style resultant filespecs will 
+contain a full device and directory, while Unix-style 
+resultant filespecs will contain only as much of a directory 
+path as was present in the input filespec.  For example, if 
+your default directory is Perl_Root:[000000], the expansion 
+of C<[.t]*.*> will yield filespecs  like 
+"perl_root:[t]base.dir", while the expansion of C<t/*/*> will 
+yield filespecs like "t/base.dir".  (This is done to match 
+the behavior of glob expansion performed by Unix shells.) 
+
+Similarly, the resultant filespec will contain the file version
+only if one was present in the input filespec.
+
+=head2 Pipes
+
+Input and output pipes to Perl filehandles are supported; the 
+"file name" is passed to lib$spawn() for asynchronous 
+execution.  You should be careful to close any pipes you have 
+opened in a Perl script, lest you leave any "orphaned" 
+subprocesses around when Perl exits. 
+
+You may also use backticks to invoke a DCL subprocess, whose 
+output is used as the return value of the expression.  The 
+string between the backticks is passed directly to lib$spawn 
+as the command to execute.  In this case, Perl will wait for 
+the subprocess to complete before continuing. 
+
+=head1 PERL5LIB and PERLLIB
+
+The PERL5LIB and PERLLIB logical names work as documented L<perl>,
+except that the element separator is '|' instead of ':'.  The
+directory specifications may use either VMS or Unix syntax.
+
+=head1 Command line
+
+=head2 I/O redirection and backgrounding
+
+Perl for VMS supports redirection of input and output on the 
+command line, using a subset of Bourne shell syntax:
+    <F<file> reads stdin from F<file>,
+    >F<file> writes stdout to F<file>,
+    >>F<file> appends stdout to F<file>,
+    2>F<file> writes stderr to F<file>, and
+    2>>F<file> appends stderr to F<file>. 
+
+In addition, output may be piped to a subprocess, using the  
+character '|'.  Anything after this character on the command 
+line is passed to a subprocess for execution; the subprocess 
+takes the output of Perl as its input.
+
+Finally, if the command line ends with '&', the entire 
+command is run in the background as an asynchronous 
+subprocess.
+
+=head2 Command line switches
+
+The following command line switches behave differently under
+VMS than described in L<perlrun>.  Note also that in order
+to pass uppercase switches to Perl, you need to enclose
+them in double-quotes on the command line, since the CRTL
+downcases all unquoted strings.
+
+=item -S
+
+If the C<-S> switch is present I<and> the script name does
+not contain a directory, then Perl translates the logical
+name DCL$PATH as a searchlist, using each translation as
+a directory in which to look for the script.  In addition,
+if no file type is specified, Perl looks in each directory
+for a file matching the name specified, with a blank type,
+a type of F<.pl>, and a type of F<.com>, in that order.
+
+=item -u
+
+The C<-u> switch causes the VMS debugger to be invoked
+after the Perl program is compiled, but before it has
+run.  It does not create a core dump file.
+
+=head1 Perl functions
+
+As of the time this document was last revised, the following 
+Perl functions were implemented in the VMS port of Perl 
+(functions marked with * are discussed in more detail below):
+
+    file tests*, abs, alarm, atan, binmode*, bless,
+    caller, chdir, chmod, chown, chomp, chop, chr,
+    close, closedir, cos, crypt*, defined, delete,
+    die, do, dump*, each, endpwent, eof, eval, exec*,
+    exists, exit, exp, fileno, fork*, getc, getlogin,
+    getpwent*, getpwnam*, getpwuid*, glob, gmtime*, goto,
+    grep, hex, import, index, int, join, keys, kill*,
+    last, lc, lcfirst, length, local, localtime, log, m//,
+    map, mkdir, my, next, no, oct, open, opendir, ord, pack,
+    pipe, pop, pos, print, printf, push, q//, qq//, qw//,
+    qx//, quotemeta, rand, read, readdir, redo, ref, rename,
+    require, reset, return, reverse, rewinddir, rindex,
+    rmdir, s///, scalar, seek, seekdir, select(internal),
+    select (system call)*, setpwent, shift, sin, sleep,
+    sort, splice, split, sprintf, sqrt, srand, stat,
+    study, substr, sysread, system*, syswrite, tell,
+    telldir, tie, time, times*, tr///, uc, ucfirst, umask,
+    undef, unlink*, unpack, untie, unshift, use, utime*,
+    values, vec, wait, waitpid*, wantarray, warn, write, y///
+
+The following functions were not implemented in the VMS port, 
+and calling them produces a fatal error (usually) or 
+undefined behavior (rarely, we hope):
+
+    chroot, dbmclose, dbmopen, fcntl, flock,
+    getpgrp, getppid, getpriority, getgrent, getgrgid,
+    getgrnam, setgrent, endgrent, ioctl, link, lstat,
+    msgctl, msgget, msgsend, msgrcv, readlink, semctl,
+    semget, semop, setpgrp, setpriority, shmctl, shmget,
+    shmread, shmwrite, socketpair, symlink, syscall, truncate
+
+The following functions may or may not be implemented, 
+depending on what type of socket support you've built into 
+your copy of Perl:
+
+    accept, bind, connect, getpeername,
+    gethostbyname, getnetbyname, getprotobyname,
+    getservbyname, gethostbyaddr, getnetbyaddr,
+    getprotobynumber, getservbyport, gethostent,
+    getnetent, getprotoent, getservent, sethostent,
+    setnetent, setprotoent, setservent, endhostent,
+    endnetent, endprotoent, endservent, getsockname,
+    getsockopt, listen, recv, select(system call)*,
+    send, setsockopt, shutdown, socket
+
+
+=item File tests
+
+The tests C<-b>, C<-B>, C<-c>, C<-C>, C<-d>, C<-e>, C<-f>,
+C<-o>, C<-M>, C<-s>, C<-S>, C<-t>, C<-T>, and C<-z> work as
+advertised.  The return values for C<-r>, C<-w>, and C<-x>
+tell you whether you can actually access the file; this may
+not reflect the UIC-based file protections.  Since real and
+effective UIC don't differ under VMS, C<-O>, C<-R>, C<-W>,
+and C<-X> are equivalent to C<-o>, C<-r>, C<-w>, and C<-x>.
+Similarly, several other tests, including C<-A>, C<-g>, C<-k>,
+C<-l>, C<-p>, and C<-u>, aren't particularly meaningful under
+VMS, and the values returned by these tests reflect whatever
+your CRTL C<stat()> routine does to the equivalent bits in the
+st_mode field.  Finally, C<-d> returns true if passed a device
+specification without an explicit directory (e.g. C<DUA1:>), as
+well as if passed a directory.
+
+Note: Some sites have reported problems when using the file-access
+tests (C<-r>, C<-w>, and C<-x>) on files accessed via DEC's DFS.
+Specifically, since DFS does not currently provide access to the
+extended file header of files on remote volumes, attempts to
+examine the ACL fail, and the file tests will return false,
+with C<$!> indicating that the file does not exist.  You can
+use C<stat> on these files, since that checks UIC-based protection
+only, and then manually check the appropriate bits, as defined by
+your C compiler's F<stat.h>, in the mode value it returns, if you
+need an approximation of the file's protections.
+
+=item binmode FILEHANDLE
+
+The C<binmode> operator has no effect under VMS.  It will 
+return TRUE whenever called, but will not affect I/O 
+operations on the filehandle given as its argument.
+
+=item crypt PLAINTEXT, USER
+
+The C<crypt> operator uses the C<sys$hash_password> system
+service to generate the hashed representation of PLAINTEXT.
+If USER is a valid username, the algorithm and salt values
+are taken from that user's UAF record.  If it is not, then
+the preferred algorithm and a salt of 0 are used.  The
+quadword encrypted value is returned as an 8-character string.
+
+The value returned by C<crypt> may be compared against
+the encrypted password from the UAF returned by the C<getpw*>
+functions, in order to authenticate users.  If you're
+going to do this, remember that the encrypted password in
+the UAF was generated using uppercase username and
+password strings; you'll have to upcase the arguments to
+C<crypt> to insure that you'll get the proper value:
+
+  sub validate_passwd {
+    my($user,$passwd) = @_;
+    my($pwdhash);
+    if ( !($pwdhash = (getpwnam($user))[1]) ||
+         $pwdhash ne crypt("\U$passwd","\U$name") ) {
+      intruder_alert($name);
+    }
+    return 1;
+  }
+
+=item dump
+
+Rather than causing Perl to abort and dump core, the C<dump>
+operator invokes the VMS debugger.  If you continue to
+execute the Perl program under the debugger, control will
+be transferred to the label specified as the argument to
+C<dump>, or, if no label was specified, back to the
+beginning of the program.  All other state of the program
+(I<e.g.> values of variables, open file handles) are not
+affected by calling C<dump>.
+
+=item exec LIST
+
+The C<exec> operator behaves in one of two different ways.  
+If called after a call to C<fork>, it will invoke the CRTL 
+C<execv()> routine, passing its arguments to the subprocess 
+created by C<fork> for execution.  In this case, it is 
+subject to all limitations that affect C<execv()>.  (In 
+particular, this usually means that the command executed in 
+the subprocess must be an image compiled from C source code, 
+and that your options for passing file descriptors and signal 
+handlers to the subprocess are limited.)
+
+If the call to C<exec> does not follow a call to C<fork>, it 
+will cause Perl to exit, and to invoke the command given as 
+an argument to C<exec> via C<lib$do_command>.  If the argument 
+begins with a '$' (other than as part of a filespec), then it 
+is executed as a DCL command.  Otherwise, the first token on 
+the command line is treated as the filespec of an image to 
+run, and an attempt is made to invoke it (using F<.Exe> and 
+the process defaults to expand the filespec) and pass the 
+rest of C<exec>'s argument to it as parameters.
+
+You can use C<exec> in both ways within the same script, as 
+long as you call C<fork> and C<exec> in pairs.  Perl
+keeps track of how many times C<fork> and C<exec> have been
+called, and will call the CRTL C<execv()> routine if there have
+previously been more calls to C<fork> than to C<exec>.
+
+=item fork
+
+The C<fork> operator works in the same way as the CRTL 
+C<vfork()> routine, which is quite different under VMS than 
+under Unix.  Specifically, while C<fork> returns 0 after it 
+is called and the subprocess PID after C<exec> is called, in 
+both cases the thread of execution is within the parent 
+process, so there is no opportunity to perform operations in 
+the subprocess before calling C<exec>.
+
+In general, the use of C<fork> and C<exec> to create 
+subprocess is not recommended under VMS; wherever possible, 
+use the C<system> operator or piped filehandles instead.
+
+=item getpwent
+
+=item getpwnam
+
+=item getpwuid
+
+These operators obtain the information described in L<perlfunc>,
+if you have the privileges necessary to retrieve the named user's
+UAF information via C<sys$getuai>.  If not, then only the C<$name>,
+C<$uid>, and C<$gid> items are returned.  The C<$dir> item contains
+the login directory in VMS syntax, while the C<$comment> item
+contains the login directory in Unix syntax. The C<$gcos> item
+contains the owner field from the UAF record.  The C<$quota>
+item is not used.
+
+=item gmtime
+
+The C<gmtime> operator will function properly if you have a
+working CRTL C<gmtime()> routine, or if the logical name
+SYS$TIMEZONE_DIFFERENTIAL is defined as the number of seconds
+which must be added to UTC to yield local time.  (This logical
+name is defined automatically if you are running a version of
+VMS with built-in UTC support.)  If neither of these cases is
+true, a warning message is printed, and C<undef> is returned.
+
+=item kill
+
+In most cases, C<kill> kill is implemented via the CRTL's C<kill()>
+function, so it will behave according to that function's
+documentation.  If you send a SIGKILL, however, the $DELPRC system
+service is is called directly.  This insures that the target
+process is actually deleted, if at all possible.  (The CRTL's C<kill()>
+function is presently implemented via $FORCEX, which is ignored by
+supervisor-mode images like DCL.)
+
+Also, negative signal values don't do anything special under
+VMS; they're just converted to the corresponding positive value.
+
+=item select (system call)
+
+If Perl was not built with socket support, the system call
+version of C<select> is not available at all.  If socket
+support is present, then the system call version of
+C<select> functions only for file descriptors attached
+to sockets.  It will not provide information about regular
+files or pipes, since the CRTL C<select()> routine does not
+provide this functionality.
+
+=item stat EXPR
+
+Since VMS keeps track of files according to a different scheme
+than Unix, it's not really possible to represent the file's ID
+in the C<st_dev> and C<st_ino> fields of a C<struct stat>.  Perl
+tries its best, though, and the values it uses are pretty unlikely
+to be the same for two different files.  We can't guarantee this,
+though, so caveat scriptor.
+
+=item system LIST
+
+The C<system> operator creates a subprocess, and passes its 
+arguments to the subprocess for execution as a DCL command.  
+Since the subprocess is created directly via C<lib$spawn()>, any 
+valid DCL command string may be specified.  If LIST consists
+of the empty string, C<system> spawns an interactive DCL subprocess,
+in the same fashion as typiing B<SPAWN> at the DCL prompt.
+Perl waits for the subprocess to complete before continuing
+execution in the current process.
+
+=item times
+
+The array returned by the C<times> operator is divided up 
+according to the same rules the CRTL C<times()> routine.  
+Therefore, the "system time" elements will always be 0, since 
+there is no difference between "user time" and "system" time 
+under VMS, and the time accumulated by subprocess may or may 
+not appear separately in the "child time" field, depending on 
+whether L<times> keeps track of subprocesses separately.  Note
+especially that the VAXCRTL (at least) keeps track only of
+subprocesses spawned using L<fork> and L<exec>; it will not
+accumulate the times of suprocesses spawned via pipes, L<system>,
+or backticks.
+
+=item unlink LIST
+
+C<unlink> will delete the highest version of a file only; in
+order to delete all versions, you need to say
+    1 while (unlink LIST);
+You may need to make this change to scripts written for a
+Unix system which expect that after a call to C<unlink>,
+no files with the names passed to C<unlink> will exist.
+(Note: This can be changed at compile time; if you
+C<use Config> and C<$Config{'d_unlink_all_versions'}> is
+C<define>, then C<unlink> will delete all versions of a
+file on the first call.)
+
+C<unlink> will delete a file if at all possible, even if it
+requires changing file protection (though it won't try to
+change the protection of the parent directory).  You can tell
+whether you've got explicit delete access to a file by using the
+C<VMS::Filespec::candelete> operator.  For instance, in order
+to delete only files to which you have delete access, you could
+say something like
+
+    sub safe_unlink {
+        my($file,$num);
+        foreach $file (@_) {
+            next unless VMS::Filespec::candelete($file);
+            $num += unlink $file;
+        }
+        $num;
+    }
+
+(or you could just use C<VMS::Stdio::remove>, if you've installed
+the VMS::Stdio extension distributed with Perl). If C<unlink> has to
+change the file protection to delete the file, and you interrupt it
+in midstream, the file may be left intact, but with a changed ACL
+allowing you delete access.
+
+=item utime LIST
+
+Since ODS-2, the VMS file structure for disk files, does not keep
+track of access times, this operator changes only the modification
+time of the file (VMS revision date).
+
+=item waitpid PID,FLAGS
+
+If PID is a subprocess started by a piped L<open>, C<waitpid>
+will wait for that subprocess, and return its final
+status value.  If PID is a subprocess created in some other way
+(e.g. SPAWNed before Perl was invoked), or is not a subprocess of
+the current process, C<waitpid> will check once per second whether
+the process has completed, and when it has, will return 0.  (If PID
+specifies a process that isn't a subprocess of the current process,
+and you invoked Perl with the C<-w> switch, a warning will be issued.)
+
+The FLAGS argument is ignored in all cases.
+
+=head1 Perl variables
+
+=item %ENV 
+
+Reading the elements of the %ENV array returns the 
+translation of the logical name specified by the key, 
+according to the normal search order of access modes and 
+logical name tables.  If you append a semicolon to the
+logical name, followed by an integer, that integer is
+used as the translation index for the logical name,
+so that you can look up successive values for search
+list logical names.  For instance, if you say
+
+   $  Define STORY  once,upon,a,time,there,was
+   $  perl -e "for ($i = 0; $i <= 6; $i++) " -
+   _$ -e "{ print $ENV{'foo'.$i},' '}"
+
+Perl will print C<ONCE UPON A TIME THERE WAS>.
+
+The %ENV keys C<home>, C<path>,C<term>, and C<user>
+return the CRTL "environment variables" of the same
+names, if these logical names are not defined.  The
+key C<default> returns the current default device
+and directory specification, regardless of whether
+there is a logical name DEFAULT defined..
+
+Setting an element of %ENV defines a supervisor-mode logical 
+name in the process logical name table.  C<Undef>ing or 
+C<delete>ing an element of %ENV deletes the equivalent user-
+mode or supervisor-mode logical name from the process logical 
+name table.  If you use C<undef>, the %ENV element remains 
+empty.  If you use C<delete>, another attempt is made at 
+logical name translation after the deletion, so an inner-mode 
+logical name or a name in another logical name table will 
+replace the logical name just deleted.  It is not possible
+at present to define a search list logical name via %ENV.
+
+In all operations on %ENV, the key string is treated as if it 
+were entirely uppercase, regardless of the case actually 
+specified in the Perl expression.
+
+=item $?
+
+Since VMS status values are 32 bits wide, the value of C<$?>
+is simply the final status value of the last subprocess to
+complete.  This differs from the behavior of C<$?> under Unix,
+and under VMS' POSIX environment, in that the low-order 8 bits
+of C<$?> do not specify whether the process terminated normally
+or due to a signal, and you do not need to shift C<$?> 8 bits
+to the right in order to find the process' exit status.
+
+=item $!
+
+The string value of C<$!> is that returned by the CRTL's
+strerror() function, so it will include the VMS message for
+VMS-specific errors.  The numeric value of C<$!> is the
+value of C<errno>, except if errno is EVMSERR, in which
+case C<$!> contains the value of vaxc$errno.  Setting C<$!>
+always sets errno to the value specified.  If this value is
+EVMSERR, it also sets vaxc$errno to 4 (NONAME-F-NOMSG), so
+that the string value of C<$!> won't reflect the VMS error
+message from before C<$!> was set.
+
+=item $^E
+
+This variable provides direct access to VMS status values
+in vaxc$errno, which are often more specific than the
+generic Unix-style error messages in C<$!>.  Its numeric value
+is the value of vaxc$errno, and its string value is the
+corresponding VMS message string, as retrieved by sys$getmsg().
+Setting C<$^E> sets vaxc$errno to the value specified.
+
+=item $|
+
+Setting C<$|> for an I/O stream causes data to be flushed
+all the way to disk on each write (I<i.e.> not just to
+the underlying RMS buffers for a file).  In other words,
+it's equivalent to calling fflush() and fsync() from C.
+
+=head1 Revision date
+
+This document was last updated on 28-Feb-1996, for Perl 5, 
+patchlevel 2.
+
+=head1 AUTHOR
+
+Charles Bailey  bailey@genetics.upenn.edu
+
diff --git a/gnu/usr.bin/perl/vms/perly_c.vms b/gnu/usr.bin/perl/vms/perly_c.vms
new file mode 100644
index 00000000000..99046823998
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/perly_c.vms
@@ -0,0 +1,2322 @@
+/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */
+#ifndef lint
+static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
+#endif
+#define YYBYACC 1
+#line 16 "perly.y"
+#include "EXTERN.h"
+#include "perl.h"
+
+static void
+dep()
+{
+    deprecate("\"do\" to call subroutines");
+}
+
+#define YYERRCODE 256
+dEXT short yylhs[] = {                                        -1,
+   31,    0,    5,    3,    6,    6,    6,    7,    7,    7,
+    7,   21,   21,   21,   21,   21,   21,   11,   11,   11,
+    9,    9,    9,    9,   30,   30,    8,    8,    8,    8,
+    8,    8,    8,    8,   10,   10,   25,   25,   29,   29,
+    1,    1,    1,    1,    2,    2,   32,   32,   28,   28,
+    4,   33,   33,   34,   13,   13,   13,   12,   12,   12,
+   26,   26,   26,   26,   26,   26,   26,   26,   27,   27,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   14,   14,   14,   14,   14,   14,
+   14,   14,   14,   14,   22,   22,   23,   23,   23,   20,
+   15,   16,   17,   18,   19,   24,   24,   24,   24,
+};
+dEXT short yylen[] = {                                         2,
+    0,    2,    4,    0,    0,    2,    2,    2,    1,    2,
+    3,    1,    1,    3,    3,    3,    3,    0,    2,    6,
+    6,    6,    4,    4,    0,    2,    7,    7,    5,    5,
+    8,    7,   10,    3,    0,    1,    0,    1,    0,    1,
+    1,    1,    1,    1,    4,    3,    5,    5,    0,    1,
+    0,    3,    2,    5,    3,    3,    1,    2,    3,    1,
+    3,    5,    6,    3,    5,    2,    4,    4,    1,    1,
+    3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+    3,    3,    5,    3,    2,    2,    2,    2,    2,    2,
+    2,    2,    2,    2,    3,    2,    3,    2,    4,    3,
+    4,    1,    5,    1,    4,    5,    4,    1,    1,    1,
+    5,    6,    5,    6,    5,    4,    5,    1,    1,    3,
+    4,    3,    2,    2,    4,    5,    4,    5,    1,    2,
+    2,    1,    2,    2,    2,    1,    3,    1,    3,    4,
+    4,    6,    1,    1,    0,    1,    0,    1,    2,    2,
+    2,    2,    2,    2,    2,    1,    1,    1,    1,
+};
+dEXT short yydefred[] = {                                      1,
+    0,    5,    0,   40,   51,   51,    0,   51,    6,   41,
+    7,    9,    0,   42,   43,   44,    0,    0,    0,   53,
+    0,   12,    4,  143,    0,    0,  118,    0,  138,    0,
+   51,   51,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   10,    0,    0,    0,
+    0,    0,    0,    0,    0,    8,    0,    0,    0,    0,
+    0,  108,  110,    0,    0,    0,  144,    0,   46,    0,
+   52,    0,    5,  156,  159,  158,  157,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  154,    0,  124,
+    0,    0,    0,    0,    0,    0,  150,    0,    0,    0,
+    0,   66,    0,  133,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   98,    0,  151,  152,  153,  155,
+    0,   34,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   90,   91,    0,    0,    0,    0,
+    0,    0,    0,    0,   11,   45,   50,    0,    0,    0,
+   64,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   36,    0,  137,  139,
+    0,    0,    0,    0,    0,    0,  100,    0,  122,    0,
+    0,    0,   97,   26,    0,    0,    0,    0,    0,    0,
+   55,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   69,    0,   70,
+    0,    0,    0,    0,    0,    0,    0,  120,    0,   48,
+   47,   54,    3,    0,  141,    0,   68,  101,    0,   29,
+    0,   30,    0,    0,    0,   23,    0,   24,    0,    0,
+    0,  140,  149,   67,    0,  125,    0,  127,    0,   99,
+    0,    0,    0,    0,    0,    0,    0,  107,    0,  105,
+    0,  116,    0,  121,   65,    0,    0,    0,    0,   19,
+    0,    0,    0,    0,    0,   62,  126,  128,  115,    0,
+  113,    0,    0,  106,    0,  111,  117,  103,  142,   27,
+   28,   21,    0,   22,    0,   32,    0,  114,  112,   63,
+    0,    0,   31,    0,    0,   20,   33,
+};
+dEXT short yydgoto[] = {                                       1,
+    9,   10,   83,   17,   86,    3,   11,   12,   66,  195,
+  266,   67,  202,   69,   70,   71,   72,   73,   74,   75,
+  197,  122,  203,   88,  187,   77,  241,  178,   13,  142,
+    2,   14,   15,   16,
+};
+dEXT short yysindex[] = {                                      0,
+    0,    0,  -82,    0,    0,    0,  -52,    0,    0,    0,
+    0,    0,  853,    0,    0,    0,  -80, -256,  -19,    0,
+ -245,    0,    0,    0,   19,   19,    0,   20,    0, 2177,
+    0,    0,   -2,    1,   28,   41,  133, 2177,   27,   33,
+   52,   19, 1028, 2177, 1303, -210,   19, 2177,  965, 1359,
+ 2177, 2177, 2177, 2177, 2177, 1415,    0, 2177, 2177, 1478,
+   19,   19,   19,   19, -225,    0,   71,  209, 1535,  -49,
+  -30,    0,    0,    8,  101,   42,    0,   30,    0, -112,
+    0, 2177,    0,    0,    0,    0,    0, 2177,  127, 2177,
+ 1535,   30, -112, 2177,   30, 2177,   30, 2177,   30, 2177,
+   30, 1712,  128, 1535,  139, 1768,  965,    0,  141,    0,
+ 1485,  -14, 1485,   65,  -42, 2177,    0,   71,    0,   71,
+  -49,    0, 2177,    0, 1485,  334,  334,  334,  -47,  -47,
+   92,  -26,  334,  334,    0,   63,    0,    0,    0,    0,
+   30,    0, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177,
+ 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177, 2177,
+ 2177, 2177, 2177, 2177,    0,    0,  -27, 2177, 2177, 2177,
+ 2177, 2177, 2177, 1824,    0,    0,    0,  -48,  137,  -92,
+    0, 2177,  221, 2177,   30, -191,  151, -225,  -22, -225,
+  -12, -147,    7, -147,  138,    5,    0, 2177,    0,    0,
+    9,  -39,  160, 2177, 1887, 2121,    0,   77,    0,   71,
+ 2177,  113,    0,    0, 1535, -191, -191, -191, -191,  -86,
+    0,  -20,  395, 1485, 1566,  461,  -88, 1535, 4122, 1064,
+  679,  364, 1120,  728,  334,  334, 2177,    0, 2177,    0,
+  174,   89,   51,   98,   55,  118,   57,    0,   11,    0,
+    0,    0,    0,  175,    0, 2177,    0,    0,   30,    0,
+   30,    0,   30,   30,  178,    0,   30,    0, 2177,   30,
+   15,    0,    0,    0,   22,    0,   25,    0,   29,    0,
+  152, 2177,   94, 2177,   59,  177, 2177,    0,   96,    0,
+   97,    0,  102,    0,    0, 1190, -225, -225, -147,    0,
+ 2177, -147,  176, -225,   30,    0,    0,    0,    0,  205,
+    0, 3039,  111,    0,  206,    0,    0,    0,    0,    0,
+    0,    0,   37,    0, 1712,    0, -225,    0,    0,    0,
+   30,  208,    0, -147,   30,    0,    0,
+};
+dEXT short yyrindex[] = {                                      0,
+    0,    0,  297,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0, 2253,  505,    0,
+    0,    0,    0,    0,    0,    0,    0,    0, 2847, 2935,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  107,    0,  -35,   10,   53, 3109,
+ 3156,    0,    0, 2298, 1976,    0,    0,    0,    0,  -23,
+    0,  230,    0,    0,    0,    0,    0, 2385,    0,    0,
+ 1004,    0,  168,  253,    0,    0,    0,    0,    0,    0,
+    0,  254,    0, 2242,    0,    0,  274,    0, 2032,    0,
+ 3844, 3109, 3902,    0,    0, 2385,    0, 2440,  452, 2554,
+  572,    0,    0,    0, 3981, 3274, 3312, 3421, 3200, 3237,
+ 2661,    0, 3560, 3596,    0,    0,    0,    0,    0,    0,
+    0,    0, 2714,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  909,
+    0,  274,    0, 2385,    0,   39,    0,  107,    0,  107,
+    0,  170,    0,  170,    0,  262,    0,    0,    0,    0,
+    0,  288,    0,    0,    0,    0,    0,    0,    0, 2805,
+    0, 2757,    0,    0, 2650,   49,   58,   61,   64,  365,
+    0,    0,  -31, 4018, 4028, 3719,  630, 2995,    0, 1623,
+ 4106, 4096, 4064, 3756, 3640, 3683,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  277,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  274,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  107,  107,  170,    0,
+    0,  170,    0,  107,    0,    0,    0,    0,    0,    0,
+    0,   13,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  300,    0,  107,    0,    0,    0,
+    0,    0,    0,  170,    0,    0,    0,
+};
+dEXT short yygindex[] = {                                      0,
+    0,    0,    0,  506,  -13,  255,    0,    0,    0,   18,
+ -180,  839,  -11, 4398, 2162,    0,    0,    0,    0,    0,
+  342,  -57, -174, 1032,   90,    0,    0,  267,    0, -172,
+    0,    0,    0,    0,
+};
+#define YYTABLESIZE 4682
+dEXT short yytable[] = {                                      65,
+   80,   68,  168,   79,  273,   57,   20,  254,   61,   80,
+  250,   82,   80,  268,  212,  260,  208,  262,  261,   95,
+   97,   99,  101,   57,  179,  206,   80,   80,  263,  110,
+  181,   80,  253,  115,  150,   49,  124,   94,  283,   81,
+   96,  170,   23,  168,  132,  270,  116,  267,  136,  272,
+   13,  294,  141,   83,   61,  305,   83,   57,  209,   90,
+  172,   80,  306,  239,  176,  307,  105,   98,   13,  308,
+   83,   83,  106,  169,   23,  150,  170,  331,  184,   38,
+  100,  188,  186,  190,  189,  192,  191,  194,  193,   16,
+  196,  107,  171,   60,  201,  237,   60,   38,   17,   49,
+  175,   14,  148,  149,   15,   83,   25,   16,  169,  289,
+   60,   60,  315,  291,  143,  293,   17,  313,  322,   14,
+   23,  324,   15,   23,  320,  321,  257,  214,  264,  265,
+  173,  326,  216,  217,  218,  219,  220,  221,  222,   25,
+  174,   23,   25,   25,   25,   60,   25,  177,   25,   25,
+   23,   25,   23,  336,  333,  213,  242,  243,  244,  245,
+  246,  247,  249,   23,  251,   25,  182,  198,   61,   18,
+   25,  258,  102,    4,    5,    6,   78,    7,    8,  199,
+  205,  288,  211,    4,    5,    6,  271,    7,    8,  207,
+  290,  259,  275,  277,  279,  252,  269,   25,  154,  281,
+  274,  280,   18,  282,   19,   18,   18,   18,  149,   18,
+  292,   18,   18,  287,   18,  295,  163,  301,  311,  164,
+  316,  317,  165,  166,  167,  285,  318,  286,   18,   25,
+  238,   25,   25,   18,  325,  329,   57,   57,   57,   57,
+   80,   80,   80,   80,  309,  297,  330,  298,  335,  299,
+  300,  148,  149,  302,  148,  149,  304,  186,   57,   57,
+   18,  255,   80,   80,  256,  167,   80,  148,  149,  314,
+  310,  148,  149,  148,  149,   84,  144,  145,  146,  147,
+   85,  148,  149,  157,   83,   83,   83,   83,  145,  323,
+   49,  327,   18,   37,   18,   18,    2,  328,  148,  149,
+  148,  149,  148,  149,  148,  149,   83,   83,  148,  149,
+   83,  168,   35,   68,  147,  148,  149,  334,  148,  149,
+   13,  337,  148,  149,   60,   60,   60,   60,  148,   39,
+  148,  149,   39,   39,   39,   37,   39,  180,   39,   39,
+   35,   39,  332,  150,  148,  149,   60,   60,  148,  149,
+  148,  149,  148,  149,   76,   39,  148,  149,  303,  185,
+   39,    0,   25,   25,   25,   25,   25,   25,    0,   25,
+   25,   25,   25,   25,   25,   25,   25,   25,   25,   25,
+   25,   25,  148,  149,    0,   25,   25,   39,   25,   25,
+   25,  148,  149,    0,    0,   25,   25,   25,   25,   25,
+    0,    0,   25,   25,    0,   56,    0,    0,   56,   25,
+    0,  148,  149,   25,    0,   25,   25,    0,    0,   39,
+    0,    0,   39,   56,  168,   18,   18,   18,   18,   18,
+   18,    0,   18,   18,   18,   18,   18,   18,   18,   18,
+   18,   18,   18,   18,   18,  148,  149,    0,   18,   18,
+    0,   18,   18,   18,  168,    0,  150,   56,   18,   18,
+   18,   18,   18,    0,    0,   18,   18,    0,    0,    0,
+  148,  149,   18,    0,    0,    0,   18,    0,   18,   18,
+  144,  145,  146,  147,  156,  168,  150,  156,  156,  156,
+    0,  156,  143,  156,  156,  143,  156,    0,  148,  149,
+    0,  151,  148,  149,    0,  152,  153,  154,  155,  143,
+  143,   18,    0,   21,  143,  156,    0,  150,  156,  158,
+  159,  160,  161,    0,  162,  163,    0,    0,  164,    0,
+    0,  165,  166,  167,    0,    0,   92,   93,    0,    0,
+    0,    0,  143,    0,  143,  136,    0,    0,  136,    0,
+    0,  168,   39,   39,   39,   39,   39,   39,    0,   39,
+   39,   39,  136,  136,    0,   39,    0,  136,   39,   39,
+   39,   39,    0,    0,  143,   39,   39,  156,   39,   39,
+   39,    0,    0,  150,    0,   39,   39,   39,   39,   39,
+    0,    0,   39,   39,    0,  136,    0,  136,    0,   39,
+    0,    0,    0,   39,  157,   39,   39,  157,  157,  157,
+    0,  157,  102,  157,  157,  102,  157,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  136,    0,  102,
+  102,    0,    0,    0,  102,  157,   56,   56,   56,   56,
+    0,  164,    0,    0,  165,  166,  167,    0,  152,  153,
+  154,  155,    0,    0,    0,    0,    0,    0,   56,    0,
+    0,    0,    0,    0,  102,  161,    0,  162,  163,    0,
+   74,  164,    0,   74,  165,  166,  167,    0,    0,  152,
+  153,  154,  155,    0,    0,    0,    0,   74,   74,    0,
+    0,    0,   74,  158,  159,  160,  161,  157,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,  156,  156,
+  156,  156,  156,    0,  156,  156,  156,    0,    0,    0,
+  156,    0,   74,  143,  143,  143,  143,    0,    0,    0,
+    0,  156,  143,  156,  156,  156,  143,  143,  143,  143,
+  156,  156,  156,  156,  156,  143,  143,  156,  156,  143,
+  143,  143,  143,  143,  156,  143,  143,    0,  156,  143,
+  156,  156,  143,  143,  143,  163,    0,    0,  164,  168,
+    0,  165,  166,  167,    0,    0,  136,  136,  136,  136,
+    0,    0,    0,    0,    0,  136,    0,    0,    0,  136,
+  136,  136,  136,    0,    0,    0,    0,    0,  136,  136,
+    0,  150,  136,  136,  136,  136,  136,    0,  136,  136,
+    0,    0,  136,    0,    0,  136,  136,  136,  168,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  157,  157,
+  157,  157,  157,    0,  157,  157,  157,    0,    0,    0,
+  157,    0,    0,  102,  102,  102,  102,    0,    0,    0,
+  150,  157,  102,  157,  157,  157,  102,  102,  102,  102,
+  157,  157,  157,  157,  157,  102,  102,  157,  157,  102,
+  102,  102,  102,  102,  157,  102,  102,    0,  157,  102,
+  157,  157,  102,  102,  102,   51,  118,  120,   61,   63,
+   47,    0,   56,    0,   64,   59,    0,   58,    0,    0,
+    0,   74,   74,   74,   74,    0,    0,    0,    0,    0,
+   74,   57,    0,    0,   74,   74,   62,   74,    0,    0,
+  120,    0,    0,   74,   74,    0,  120,   74,   74,   74,
+   74,   74,    0,   74,    0,    0,    0,    0,    0,    0,
+    0,   39,    0,   60,   39,   39,   39,    0,   39,    0,
+   39,   39,    0,   39,  120,    0,    0,    0,    0,    0,
+    0,  210,    0,  152,  153,  154,  155,   39,    0,    0,
+    0,    0,   39,    0,    0,   23,    0,    0,   52,  160,
+  161,    0,  162,  163,    0,    0,  164,    0,    0,  165,
+  166,  167,    0,    0,    0,    0,    0,   51,    0,   39,
+   61,   63,   47,    0,   56,    0,   64,   59,    0,   58,
+    0,    0,    0,    0,  154,  155,    0,    0,    0,    0,
+    0,    0,  120,    0,    0,    0,    0,    0,   62,    0,
+    0,   39,  163,    0,   39,  164,    0,    0,  165,  166,
+  167,    0,    0,    0,  135,    0,    0,  135,    0,    0,
+    0,    0,    0,    0,    0,   60,    0,   89,    0,    0,
+   51,  135,  135,   61,   63,   47,    0,   56,    0,   64,
+   59,    0,   58,  108,    0,    0,    0,    0,  117,    0,
+  123,    0,    0,    0,    0,    0,    0,   23,    0,    0,
+   52,   62,  137,  138,  139,  140,  135,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   22,   24,
+   25,   26,   27,   28,    0,   29,   30,   31,   60,    0,
+    0,   32,    0,    0,   33,   34,   35,   36,    0,    0,
+    0,   37,   38,    0,   39,   40,   41,    0,  204,    0,
+    0,   42,   43,   44,   45,   46,    0,    0,   48,   49,
+   23,    0,    0,   52,  168,   50,    0,    0,    0,   53,
+    0,   54,   55,    0,   39,   39,   39,   39,   39,   39,
+    0,   39,   39,   39,    0,    0,    0,   39,    0,    0,
+   39,   39,   39,   39,    0,    0,  150,   39,   39,    0,
+   39,   39,   39,    0,    0,    0,    0,   39,   39,   39,
+   39,   39,    0,    0,   39,   39,    0,    0,    0,    0,
+  168,   39,    0,    0,    0,   39,    0,   39,   39,    0,
+    0,  119,   25,   26,   27,   28,   85,   29,   30,   31,
+  319,    0,    0,   32,    0,    0,    0,    0,    0,    0,
+    0,    0,  150,    0,   38,    0,   39,   40,   41,    0,
+    0,    0,  157,   42,   43,   44,   45,   46,    0,    0,
+   48,   49,    0,    0,    0,    0,    0,   50,    0,    0,
+    0,   53,    0,   54,   55,  135,  135,  135,  135,    0,
+  168,    0,    0,    0,  109,   25,   26,   27,   28,    0,
+   29,   30,   31,    0,    0,    0,   32,  135,  135,    0,
+    0,    0,    0,    0,    0,    0,    0,   38,    0,   39,
+   40,   41,  150,    0,    0,    0,   42,   43,   44,   45,
+   46,    0,    0,   48,   49,    0,    0,    0,    0,    0,
+   50,    0,    0,    0,   53,   51,   54,   55,   61,   63,
+   47,    0,   56,    0,   64,   59,    0,   58,  152,  153,
+  154,  155,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  114,    0,  159,  160,  161,   62,  162,  163,    0,
+    0,  164,    0,    0,  165,  166,  167,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   51,    0,   60,   61,   63,   47,    0,   56,    0,
+   64,   59,    0,   58,  152,  153,  154,  155,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   62,  162,  163,    0,    0,  164,   52,    0,
+  165,  166,  167,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   51,    0,   60,
+   61,   63,   47,    0,   56,  131,   64,   59,    0,   58,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  151,    0,    0,    0,  152,  153,  154,  155,   62,    0,
+    0,   23,    0,    0,   52,    0,    0,  156,  158,  159,
+  160,  161,    0,  162,  163,    0,    0,  164,    0,    0,
+  165,  166,  167,    0,    0,   60,    0,    0,    0,    0,
+   51,    0,    0,   61,   63,   47,    0,   56,    0,   64,
+   59,    0,   58,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   52,   62,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   24,
+   25,   26,   27,   28,    0,   29,   30,   31,   60,    0,
+  135,   32,    0,    0,    0,  168,    0,    0,    0,    0,
+    0,    0,   38,    0,   39,   40,   41,    0,    0,    0,
+    0,   42,   43,   44,   45,   46,    0,  157,   48,   49,
+    0,    0,    0,   52,    0,   50,    0,  150,    0,   53,
+    0,   54,   55,    0,    0,   24,   25,   26,   27,   28,
+    0,   29,   30,   31,    0,  168,    0,   32,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   38,    0,
+   39,   40,   41,    0,    0,    0,    0,   42,   43,   44,
+   45,   46,    0,    0,   48,   49,  168,  150,    0,    0,
+    0,   50,    0,   82,    0,   53,   82,   54,   55,    0,
+    0,   24,   25,   26,   27,   28,    0,   29,   30,   31,
+   82,   82,    0,   32,    0,   82,    0,    0,  150,    0,
+    0,    0,    0,    0,   38,    0,   39,   40,   41,    0,
+    0,    0,    0,   42,   43,   44,   45,   46,    0,    0,
+   48,   49,    0,    0,    0,   82,    0,   50,    0,    0,
+    0,   53,    0,   54,   55,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   24,   25,   26,   27,   28,    0,
+   29,   30,   31,    0,   51,    0,   32,   61,   63,   47,
+    0,   56,    0,   64,   59,    0,   58,   38,    0,   39,
+   40,   41,    0,    0,    0,    0,   42,   43,   44,   45,
+   46,  154,  155,   48,   49,   62,    0,    0,    0,    0,
+   50,    0,    0,    0,   53,    0,   54,   55,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,    0,    0,
+   51,    0,   60,   61,   63,   47,    0,   56,  200,   64,
+   59,    0,   58,    0,    0,  151,    0,    0,    0,  152,
+  153,  154,  155,    0,    0,    0,    0,    0,    0,    0,
+    0,   62,  156,  158,  159,  160,  161,   52,  162,  163,
+    0,    0,  164,    0,    0,  165,  166,  167,    0,    0,
+  152,    0,  154,  155,    0,    0,   51,    0,   60,   61,
+   63,   47,    0,   56,  248,   64,   59,    0,   58,  162,
+  163,    0,    0,  164,    0,    0,  165,  166,  167,    0,
+    0,    0,    0,    0,    0,    0,    0,   62,    0,    0,
+    0,    0,    0,   52,   82,   82,   82,   82,    0,    0,
+    0,    0,    0,   82,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   60,    0,   82,   82,    0,   51,
+   82,   82,   61,   63,   47,    0,   56,  276,   64,   59,
+    0,   58,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   52,
+   62,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   22,   24,   25,
+   26,   27,   28,    0,   29,   30,   31,   60,    0,    0,
+   32,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   38,    0,   39,   40,   41,    0,    0,    0,    0,
+   42,   43,   44,   45,   46,    0,    0,   48,   49,    0,
+    0,    0,   52,    0,   50,    0,  119,    0,   53,  119,
+   54,   55,    0,    0,   24,   25,   26,   27,   28,    0,
+   29,   30,   31,  119,  119,    0,   32,    0,  119,    0,
+    0,    0,    0,    0,    0,    0,    0,   38,    0,   39,
+   40,   41,    0,    0,    0,    0,   42,   43,   44,   45,
+   46,    0,    0,   48,   49,    0,  119,    0,  119,    0,
+   50,    0,  143,    0,   53,  143,   54,   55,    0,    0,
+   24,   25,   26,   27,   28,    0,   29,   30,   31,  143,
+  143,    0,   32,    0,  143,    0,    0,    0,  119,    0,
+    0,    0,    0,   38,    0,   39,   40,   41,    0,    0,
+    0,    0,   42,   43,   44,   45,   46,    0,    0,   48,
+   49,    0,  143,    0,  143,    0,   50,    0,    0,    0,
+   53,    0,   54,   55,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   24,   25,   26,   27,   28,    0,   29,
+   30,   31,    0,   51,  143,   32,   61,   63,   47,    0,
+   56,  278,   64,   59,    0,   58,   38,    0,   39,   40,
+   41,    0,    0,    0,    0,   42,   43,   44,   45,   46,
+    0,    0,   48,   49,   62,    0,   87,   87,    0,   50,
+    0,    0,    0,   53,    0,   54,   55,    0,  103,    0,
+    0,    0,    0,   87,  112,    0,    0,    0,   87,   51,
+  121,   60,   61,   63,   47,    0,   56,    0,   64,   59,
+    0,   58,   87,   87,   87,   87,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   62,    0,    0,    0,    0,    0,   52,  119,  119,  119,
+  119,    0,    0,    0,    0,    0,  119,    0,    0,    0,
+  119,  119,  119,  119,    0,    0,    0,   60,  121,  119,
+  119,    0,    0,  119,  119,  119,  119,  119,    0,  119,
+  119,    0,  130,  119,    0,  130,  119,  119,  119,    0,
+    0,    0,    0,  129,    0,    0,  129,    0,    0,  130,
+  130,    0,   52,  143,  143,  143,  143,    0,    0,    0,
+  129,  129,  143,    0,    0,  129,  143,  143,  143,  143,
+    0,    0,    0,    0,    0,  143,  143,    0,  240,  143,
+  143,  143,  143,  143,  130,  143,  143,    0,  104,  143,
+    0,  104,  143,  143,  143,  129,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  104,  104,    0,    0,    0,
+  104,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  129,    0,   24,   25,   26,
+   27,   28,    0,   29,   30,   31,    0,    0,  104,   32,
+  104,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   38,    0,   39,   40,   41,    0,    0,    0,    0,   42,
+   43,   44,   45,   46,    0,    0,   48,   49,    0,    0,
+    0,    0,    0,   50,    0,  145,    0,   53,  145,   54,
+   55,    0,    0,   24,   25,   26,   27,   28,    0,   29,
+   30,   31,  145,  145,    0,   32,    0,  145,    0,    0,
+    0,    0,    0,    0,    0,    0,   38,    0,   39,   40,
+   41,    0,    0,    0,    0,   42,   43,   44,   45,   46,
+    0,    0,   48,   49,    0,    0,    0,  145,    0,   50,
+  131,    0,    0,   53,    0,   54,   55,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  131,  131,    0,
+    0,    0,  131,    0,    0,    0,    0,  145,    0,    0,
+    0,    0,    0,  130,  130,  130,  130,    0,    0,    0,
+    0,    0,    0,    0,  129,  129,  129,  129,    0,    0,
+  131,    0,  131,  129,    0,  130,  130,  129,  129,  129,
+  129,    0,    0,    0,    0,    0,  129,  129,    0,    0,
+  129,  129,  129,  129,  129,    0,  129,  129,    0,    0,
+  129,    0,  131,  129,  129,  129,    0,    0,    0,  104,
+  104,  104,  104,    0,    0,    0,    0,    0,  104,    0,
+    0,    0,  104,  104,  104,  104,    0,    0,    0,    0,
+    0,  104,  104,    0,  146,  104,  104,  104,  104,  104,
+    0,  104,  104,    0,    0,  104,    0,    0,  104,  104,
+  104,  146,  146,    0,    0,    0,  146,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  146,    0,  146,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  145,  145,  145,  145,
+    0,    0,    0,    0,    0,  145,    0,    0,    0,  145,
+  145,  145,  145,    0,    0,    0,  146,    0,  145,  145,
+    0,    0,  145,  145,  145,  145,  145,    0,  145,  145,
+   59,    0,  145,   59,    0,  145,  145,  145,    0,    0,
+    0,   96,    0,    0,   96,    0,    0,   59,   59,    0,
+    0,  131,  131,  131,  131,    0,    0,    0,   96,   96,
+  131,    0,    0,   96,  131,  131,  131,  131,    0,    0,
+    0,    0,    0,  131,  131,    0,    0,  131,  131,  131,
+  131,  131,   59,  131,  131,    0,    0,  131,    0,    0,
+  131,  131,  131,   96,   58,    0,    0,   58,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   58,   58,    0,    0,    0,   58,    0,    0,    0,
+    0,    0,    0,   96,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   95,    0,    0,
+   95,    0,    0,    0,    0,    0,   58,    0,    0,    0,
+    0,    0,    0,    0,   95,   95,    0,    0,    0,   95,
+    0,    0,    0,    0,    0,  146,  146,  146,  146,    0,
+    0,    0,    0,    0,  146,    0,   58,    0,  146,  146,
+  146,  146,    0,    0,    0,   61,    0,  146,  146,   95,
+    0,  146,  146,  146,  146,  146,    0,  146,  146,    0,
+    0,  146,   61,   61,  146,  146,  146,   61,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   95,
+    0,    0,    0,    0,    0,    0,    0,  145,    0,    0,
+  145,    0,    0,    0,    0,   61,    0,   61,    0,    0,
+    0,    0,    0,    0,  145,  145,    0,    0,    0,  145,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   59,   59,   59,   59,    0,    0,   61,    0,    0,
+    0,    0,   96,   96,   96,   96,    0,    0,    0,  145,
+    0,   96,    0,   59,   59,   96,   96,   96,   96,    0,
+    0,    0,    0,    0,   96,   96,    0,    0,   96,   96,
+   96,   96,   96,    0,   96,   96,    0,    0,   96,    0,
+    0,   96,   96,   96,    0,  132,    0,    0,  132,    0,
+    0,    0,    0,    0,    0,   58,   58,   58,   58,    0,
+    0,    0,  132,  132,   58,    0,    0,  132,   58,   58,
+   58,   58,    0,    0,    0,    0,    0,   58,   58,    0,
+    0,   58,   58,   58,   58,   58,    0,   58,   58,    0,
+    0,   58,    0,    0,   58,   58,   58,  132,   95,   95,
+   95,   95,    0,    0,    0,   71,    0,   95,   71,    0,
+    0,   95,   95,   95,   95,    0,    0,    0,    0,    0,
+   95,   95,   71,   71,   95,   95,   95,   95,   95,    0,
+   95,   95,    0,    0,   95,    0,    0,   95,   95,   95,
+    0,    0,    0,    0,    0,    0,   61,   61,   61,   61,
+    0,    0,    0,    0,    0,   61,    0,   71,    0,   61,
+   61,   61,   61,    0,    0,    0,    0,    0,   61,   61,
+    0,  157,   61,   61,   61,   61,   61,    0,   61,   61,
+    0,    0,   61,    0,    0,   61,   61,   61,  145,  145,
+  145,  145,    0,    0,    0,    0,    0,  145,    0,  168,
+    0,  145,  145,  145,  145,    0,    0,    0,    0,    0,
+  145,  145,    0,    0,  145,  145,  145,  145,  145,  102,
+  145,  145,  102,    0,  145,    0,    0,  145,  145,  145,
+    0,  150,    0,    0,    0,    0,  102,  102,    0,    0,
+    0,  102,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  109,    0,    0,  109,
+    0,  102,    0,    0,    0,    0,  132,  132,  132,  132,
+    0,    0,    0,  109,  109,  132,    0,    0,  109,  132,
+  132,  132,  132,    0,    0,    0,    0,    0,  132,  132,
+    0,    0,  132,  132,  132,  132,  132,    0,  132,  132,
+   92,    0,  132,   92,    0,  132,  132,  132,  109,    0,
+    0,    0,    0,    0,    0,    0,    0,   92,   92,    0,
+    0,    0,   92,    0,    0,    0,   71,   71,   71,   71,
+    0,    0,    0,    0,    0,    0,    0,   93,    0,    0,
+   93,    0,    0,    0,    0,    0,    0,    0,   71,   71,
+    0,    0,   92,    0,   93,   93,    0,    0,    0,   93,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   87,    0,    0,   87,    0,  151,
+    0,    0,    0,  152,  153,  154,  155,    0,    0,   93,
+    0,   87,   87,    0,    0,    0,   87,  158,  159,  160,
+  161,    0,  162,  163,    0,    0,  164,    0,    0,  165,
+  166,  167,   88,    0,    0,   88,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   87,    0,    0,   88,
+   88,    0,    0,    0,   88,    0,    0,    0,    0,    0,
+  102,  102,  102,  102,    0,    0,    0,    0,    0,  102,
+    0,    0,    0,  102,  102,  102,  102,    0,    0,    0,
+    0,    0,  102,  102,   88,    0,  102,  102,  102,  102,
+  102,    0,  102,  102,    0,    0,  102,    0,    0,  102,
+  102,  102,    0,    0,    0,    0,    0,  109,  109,  109,
+  109,    0,    0,    0,    0,    0,  109,    0,    0,    0,
+  109,  109,  109,  109,    0,    0,    0,    0,    0,  109,
+  109,    0,    0,  109,  109,  109,  109,  109,    0,  109,
+  109,   89,    0,  109,   89,    0,  109,  109,  109,    0,
+    0,   92,   92,   92,   92,    0,    0,    0,   89,   89,
+   92,    0,    0,   89,   92,   92,   92,   92,    0,    0,
+    0,    0,    0,   92,   92,    0,    0,   92,   92,   92,
+   92,   92,    0,   92,   92,    0,    0,   92,   93,   93,
+   93,   93,    0,   89,    0,    0,    0,   93,    0,    0,
+    0,   93,   93,   93,   93,    0,    0,    0,    0,    0,
+   93,   93,    0,    0,   93,   93,   93,   93,   93,    0,
+   93,   93,    0,    0,   93,   87,   87,   87,   87,    0,
+    0,    0,    0,    0,   87,    0,    0,    0,   87,   87,
+   87,   87,    0,    0,    0,    0,    0,   87,   87,    0,
+    0,   87,   87,   87,   87,   87,    0,   87,   87,    0,
+    0,    0,    0,   88,   88,   88,   88,    0,    0,    0,
+    0,    0,   88,    0,    0,    0,   88,   88,   88,   88,
+   85,    0,    0,   85,    0,   88,   88,    0,    0,   88,
+   88,   88,   88,   88,    0,   88,   88,   85,   85,    0,
+    0,    0,   85,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   86,    0,    0,   86,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   85,   86,   86,    0,    0,    0,   86,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   84,    0,    0,   84,    0,    0,    0,    0,   86,    0,
+    0,    0,   89,   89,   89,   89,    0,   84,   84,    0,
+    0,   89,   84,    0,    0,   89,   89,   89,   89,    0,
+    0,    0,    0,    0,   89,   89,    0,    0,   89,   89,
+   89,   89,   89,   72,   89,   89,   72,    0,    0,    0,
+    0,    0,   84,    0,    0,    0,    0,    0,    0,    0,
+   72,   72,    0,    0,    0,   72,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   73,
+    0,    0,   73,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   72,   73,   73,    0,    0,
+    0,   73,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   75,    0,    0,   75,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   73,    0,   75,   75,    0,    0,    0,   75,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   85,   85,   85,   85,    0,    0,    0,    0,    0,
+   85,    0,    0,    0,   85,   85,   85,   85,   75,    0,
+    0,    0,    0,   85,   85,    0,    0,   85,   85,   85,
+   85,   85,    0,   85,   85,    0,    0,   86,   86,   86,
+   86,    0,    0,    0,    0,    0,   86,    0,    0,    0,
+   86,   86,   86,   86,  123,    0,    0,  123,    0,   86,
+   86,    0,    0,   86,   86,   86,   86,   86,    0,   86,
+   86,  123,  123,    0,    0,    0,  123,    0,    0,    0,
+    0,   84,   84,   84,   84,    0,    0,    0,    0,    0,
+   84,    0,    0,    0,   84,   84,   84,   84,    0,    0,
+    0,    0,    0,   84,   84,    0,  123,   84,   84,   84,
+   84,   84,   94,   84,   84,   94,    0,    0,    0,    0,
+    0,    0,    0,    0,   72,   72,   72,   72,    0,   94,
+   94,    0,    0,   72,   94,    0,    0,   72,   72,   72,
+   72,    0,    0,    0,    0,    0,   72,   72,    0,    0,
+   72,   72,   72,   72,   72,    0,   72,   72,    0,    0,
+   73,   73,   73,   73,   94,    0,    0,    0,    0,   73,
+    0,    0,    0,   73,   73,   73,   73,    0,    0,    0,
+    0,    0,   73,   73,    0,    0,   73,   73,   73,   73,
+   73,  134,   73,    0,  134,    0,    0,   75,   75,   75,
+   75,    0,    0,    0,    0,    0,   75,    0,  134,  134,
+   75,   75,    0,  134,    0,    0,    0,    0,    0,   75,
+   75,    0,    0,   75,   75,   75,   75,   75,   76,   75,
+    0,   76,    0,    0,    0,    0,    0,    0,   77,    0,
+    0,   77,    0,  134,    0,   76,   76,    0,    0,    0,
+   76,    0,    0,    0,    0,   77,   77,    0,    0,    0,
+   77,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   78,    0,    0,   78,    0,    0,
+   76,    0,    0,    0,    0,  123,  123,  123,  123,    0,
+   77,   78,   78,    0,  123,    0,   78,    0,  123,  123,
+    0,    0,    0,    0,    0,    0,   79,  123,  123,   79,
+    0,  123,  123,  123,  123,  123,   81,    0,    0,   81,
+    0,    0,    0,   79,   79,    0,   78,    0,   79,    0,
+    0,    0,    0,   81,   81,    0,    0,    0,   81,    0,
+    0,    0,    0,   94,   94,   94,   94,    0,    0,  284,
+    0,    0,   94,    0,  157,    0,   94,   94,   79,    0,
+    0,    0,    0,    0,    0,   94,   94,    0,   81,   94,
+   94,   94,   94,   94,    0,    0,    0,    0,    0,    0,
+    0,    0,  168,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  150,    0,    0,    0,    0,    0,
+    0,    0,  134,  134,  134,  134,    0,    0,    0,    0,
+    0,  134,    0,    0,    0,  134,  134,    0,    0,    0,
+    0,    0,    0,    0,  134,  134,    0,    0,  134,  134,
+  134,  134,  134,    0,    0,    0,    0,    0,    0,   76,
+   76,   76,   76,    0,    0,    0,    0,    0,   76,   77,
+   77,   77,   77,   76,    0,    0,    0,    0,   77,    0,
+    0,   76,   76,    0,    0,   76,   76,   76,   76,   76,
+    0,   77,   77,    0,    0,   77,   77,   77,   77,   77,
+    0,    0,    0,    0,    0,   78,   78,   78,   78,    0,
+    0,    0,    0,    0,   78,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   78,   78,    0,
+    0,   78,   78,   78,   78,   78,    0,   79,   79,   79,
+   79,    0,    0,    0,    0,    0,   79,   81,   81,   81,
+   81,    0,    0,    0,    0,    0,   81,    0,    0,   79,
+   79,    0,    0,   79,   79,   79,   79,    0,    0,   81,
+   81,    0,  151,   81,   81,   81,  152,  153,  154,  155,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,  156,
+  158,  159,  160,  161,    0,  162,  163,   91,    0,  164,
+    0,    0,  165,  166,  167,  104,    0,    0,    0,    0,
+  111,  113,    0,    0,    0,    0,    0,  125,  126,  127,
+  128,  129,  130,    0,    0,  133,  134,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,  183,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  215,    0,    0,    0,    0,    0,    0,    0,  223,  224,
+  225,  226,  227,  228,  229,  230,  231,  232,  233,  234,
+  235,  236,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  296,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  312,
+};
+dEXT short yycheck[] = {                                      13,
+  257,   13,   91,   17,   44,   41,   59,  182,   36,   41,
+   59,  257,   44,  194,   41,  188,   59,  190,   41,   33,
+   34,   35,   36,   59,   82,   40,   58,   59,   41,   43,
+   88,   63,  125,   45,  123,   59,   50,   40,   59,   59,
+   40,   91,  123,   91,   56,   41,  257,   41,   60,   41,
+   41,   41,  278,   41,   36,   41,   44,   93,  116,   40,
+   91,   93,   41,   91,   78,   41,   40,   40,   59,   41,
+   58,   59,   40,  123,  123,  123,   91,   41,   92,   41,
+   40,   95,   94,   97,   96,   99,   98,  101,  100,   41,
+  102,   40,  123,   41,  106,  123,   44,   59,   41,  123,
+   59,   41,  294,  295,   41,   93,    0,   59,  123,   59,
+   58,   59,  287,   59,   44,   59,   59,   59,  299,   59,
+  123,  302,   59,  123,  297,  298,  184,  141,  276,  277,
+  123,  304,  144,  145,  146,  147,  148,  149,  150,   33,
+   40,  123,   36,   37,   38,   93,   40,  260,   42,   43,
+  123,   45,  123,  334,  327,   93,  168,  169,  170,  171,
+  172,  173,  174,  123,  178,   59,   40,   40,   36,    0,
+   64,  185,   40,  266,  267,  268,  257,  270,  271,   41,
+   40,   93,   91,  266,  267,  268,  198,  270,  271,  125,
+   93,   41,  204,  205,  206,   59,   59,   91,  287,  211,
+   41,  125,   33,   91,  257,   36,   37,   38,  295,   40,
+   93,   42,   43,   40,   45,   41,  305,   40,  125,  308,
+  125,  125,  311,  312,  313,  237,  125,  239,   59,  123,
+  258,  125,  126,   64,   59,  125,  272,  273,  274,  275,
+  272,  273,  274,  275,   93,  259,   41,  261,   41,  263,
+  264,  294,  295,  267,  294,  295,  270,  269,  294,  295,
+   91,   41,  294,  295,   44,  313,  298,  294,  295,   93,
+  282,  294,  295,  294,  295,  257,  272,  273,  274,  275,
+  262,  294,  295,   63,  272,  273,  274,  275,   59,  301,
+  123,  305,  123,   41,  125,  126,    0,   93,  294,  295,
+  294,  295,  294,  295,  294,  295,  294,  295,  294,  295,
+  298,   91,   59,  325,   41,  294,  295,  331,  294,  295,
+   59,  335,  294,  295,  272,  273,  274,  275,   41,   33,
+  294,  295,   36,   37,   38,   59,   40,   83,   42,   43,
+   41,   45,  325,  123,  294,  295,  294,  295,  294,  295,
+  294,  295,  294,  295,   13,   59,  294,  295,  269,   93,
+   64,   -1,  256,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,  266,  267,  268,  269,  270,  271,  272,  273,
+  274,  275,  294,  295,   -1,  279,  280,   91,  282,  283,
+  284,  294,  295,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   41,   -1,   -1,   44,  303,
+   -1,  294,  295,  307,   -1,  309,  310,   -1,   -1,  123,
+   -1,   -1,  126,   59,   91,  256,  257,  258,  259,  260,
+  261,   -1,  263,  264,  265,  266,  267,  268,  269,  270,
+  271,  272,  273,  274,  275,  294,  295,   -1,  279,  280,
+   -1,  282,  283,  284,   91,   -1,  123,   93,  289,  290,
+  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,
+  294,  295,  303,   -1,   -1,   -1,  307,   -1,  309,  310,
+  272,  273,  274,  275,   33,   91,  123,   36,   37,   38,
+   -1,   40,   41,   42,   43,   44,   45,   -1,  294,  295,
+   -1,  281,  294,  295,   -1,  285,  286,  287,  288,   58,
+   59,    6,   -1,    8,   63,   64,   -1,  123,  298,  299,
+  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
+   -1,  311,  312,  313,   -1,   -1,   31,   32,   -1,   -1,
+   -1,   -1,   91,   -1,   93,   41,   -1,   -1,   44,   -1,
+   -1,   91,  256,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   58,   59,   -1,  269,   -1,   63,  272,  273,
+  274,  275,   -1,   -1,  123,  279,  280,  126,  282,  283,
+  284,   -1,   -1,  123,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   91,   -1,   93,   -1,  303,
+   -1,   -1,   -1,  307,   33,  309,  310,   36,   37,   38,
+   -1,   40,   41,   42,   43,   44,   45,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   58,
+   59,   -1,   -1,   -1,   63,   64,  272,  273,  274,  275,
+   -1,  308,   -1,   -1,  311,  312,  313,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,  294,   -1,
+   -1,   -1,   -1,   -1,   93,  302,   -1,  304,  305,   -1,
+   41,  308,   -1,   44,  311,  312,  313,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,  299,  300,  301,  302,  126,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,
+  269,   -1,   93,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,  280,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,  297,  298,
+  299,  300,  301,  302,  303,  304,  305,   -1,  307,  308,
+  309,  310,  311,  312,  313,  305,   -1,   -1,  308,   91,
+   -1,  311,  312,  313,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,  123,  298,  299,  300,  301,  302,   -1,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   91,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   -1,   -1,   -1,
+  269,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+  123,  280,  281,  282,  283,  284,  285,  286,  287,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,  297,  298,
+  299,  300,  301,  302,  303,  304,  305,   -1,  307,  308,
+  309,  310,  311,  312,  313,   33,   48,   49,   36,   37,
+   38,   -1,   40,   -1,   42,   43,   -1,   45,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   59,   -1,   -1,  285,  286,   64,  288,   -1,   -1,
+   82,   -1,   -1,  294,  295,   -1,   88,  298,  299,  300,
+  301,  302,   -1,  304,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   33,   -1,   91,   36,   37,   38,   -1,   40,   -1,
+   42,   43,   -1,   45,  116,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,   -1,  285,  286,  287,  288,   59,   -1,   -1,
+   -1,   -1,   64,   -1,   -1,  123,   -1,   -1,  126,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   -1,   -1,   -1,   -1,   -1,   33,   -1,   91,
+   36,   37,   38,   -1,   40,   -1,   42,   43,   -1,   45,
+   -1,   -1,   -1,   -1,  287,  288,   -1,   -1,   -1,   -1,
+   -1,   -1,  184,   -1,   -1,   -1,   -1,   -1,   64,   -1,
+   -1,  123,  305,   -1,  126,  308,   -1,   -1,  311,  312,
+  313,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   91,   -1,   26,   -1,   -1,
+   33,   58,   59,   36,   37,   38,   -1,   40,   -1,   42,
+   43,   -1,   45,   42,   -1,   -1,   -1,   -1,   47,   -1,
+   49,   -1,   -1,   -1,   -1,   -1,   -1,  123,   -1,   -1,
+  126,   64,   61,   62,   63,   64,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   91,   -1,
+   -1,  269,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   -1,  279,  280,   -1,  282,  283,  284,   -1,  107,   -1,
+   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,  297,
+  123,   -1,   -1,  126,   91,  303,   -1,   -1,   -1,  307,
+   -1,  309,  310,   -1,  256,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   -1,   -1,  269,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,  123,  279,  280,   -1,
+  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
+  292,  293,   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,
+   91,  303,   -1,   -1,   -1,  307,   -1,  309,  310,   -1,
+   -1,  257,  258,  259,  260,  261,  262,  263,  264,  265,
+   41,   -1,   -1,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  123,   -1,  280,   -1,  282,  283,  284,   -1,
+   -1,   -1,   63,  289,  290,  291,  292,  293,   -1,   -1,
+  296,  297,   -1,   -1,   -1,   -1,   -1,  303,   -1,   -1,
+   -1,  307,   -1,  309,  310,  272,  273,  274,  275,   -1,
+   91,   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   -1,   -1,   -1,  269,  294,  295,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,  123,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,   -1,   -1,  296,  297,   -1,   -1,   -1,   -1,   -1,
+  303,   -1,   -1,   -1,  307,   33,  309,  310,   36,   37,
+   38,   -1,   40,   -1,   42,   43,   -1,   45,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   59,   -1,  300,  301,  302,   64,  304,  305,   -1,
+   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   33,   -1,   91,   36,   37,   38,   -1,   40,   -1,
+   42,   43,   -1,   45,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   64,  304,  305,   -1,   -1,  308,  126,   -1,
+  311,  312,  313,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   33,   -1,   91,
+   36,   37,   38,   -1,   40,   41,   42,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   64,   -1,
+   -1,  123,   -1,   -1,  126,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,
+  311,  312,  313,   -1,   -1,   91,   -1,   -1,   -1,   -1,
+   33,   -1,   -1,   36,   37,   38,   -1,   40,   -1,   42,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  126,   64,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,
+  258,  259,  260,  261,   -1,  263,  264,  265,   91,   -1,
+   93,  269,   -1,   -1,   -1,   91,   -1,   -1,   -1,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,
+   -1,  289,  290,  291,  292,  293,   -1,   63,  296,  297,
+   -1,   -1,   -1,  126,   -1,  303,   -1,  123,   -1,  307,
+   -1,  309,  310,   -1,   -1,  257,  258,  259,  260,  261,
+   -1,  263,  264,  265,   -1,   91,   -1,  269,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,
+  292,  293,   -1,   -1,  296,  297,   91,  123,   -1,   -1,
+   -1,  303,   -1,   41,   -1,  307,   44,  309,  310,   -1,
+   -1,  257,  258,  259,  260,  261,   -1,  263,  264,  265,
+   58,   59,   -1,  269,   -1,   63,   -1,   -1,  123,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+   -1,   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,
+  296,  297,   -1,   -1,   -1,   93,   -1,  303,   -1,   -1,
+   -1,  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   -1,   33,   -1,  269,   36,   37,   38,
+   -1,   40,   -1,   42,   43,   -1,   45,  280,   -1,  282,
+  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,  287,  288,  296,  297,   64,   -1,   -1,   -1,   -1,
+  303,   -1,   -1,   -1,  307,   -1,  309,  310,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,
+   33,   -1,   91,   36,   37,   38,   -1,   40,   41,   42,
+   43,   -1,   45,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   64,  298,  299,  300,  301,  302,  126,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,   -1,
+  285,   -1,  287,  288,   -1,   -1,   33,   -1,   91,   36,
+   37,   38,   -1,   40,   41,   42,   43,   -1,   45,  304,
+  305,   -1,   -1,  308,   -1,   -1,  311,  312,  313,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   64,   -1,   -1,
+   -1,   -1,   -1,  126,  272,  273,  274,  275,   -1,   -1,
+   -1,   -1,   -1,  281,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   91,   -1,  294,  295,   -1,   33,
+  298,  299,   36,   37,   38,   -1,   40,   41,   42,   43,
+   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  126,
+   64,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  256,  257,  258,
+  259,  260,  261,   -1,  263,  264,  265,   91,   -1,   -1,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,
+  289,  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,
+   -1,   -1,  126,   -1,  303,   -1,   41,   -1,  307,   44,
+  309,  310,   -1,   -1,  257,  258,  259,  260,  261,   -1,
+  263,  264,  265,   58,   59,   -1,  269,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,
+  293,   -1,   -1,  296,  297,   -1,   91,   -1,   93,   -1,
+  303,   -1,   41,   -1,  307,   44,  309,  310,   -1,   -1,
+  257,  258,  259,  260,  261,   -1,  263,  264,  265,   58,
+   59,   -1,  269,   -1,   63,   -1,   -1,   -1,  123,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,   -1,
+   -1,   -1,  289,  290,  291,  292,  293,   -1,   -1,  296,
+  297,   -1,   91,   -1,   93,   -1,  303,   -1,   -1,   -1,
+  307,   -1,  309,  310,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   -1,   33,  123,  269,   36,   37,   38,   -1,
+   40,   41,   42,   43,   -1,   45,  280,   -1,  282,  283,
+  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   64,   -1,   25,   26,   -1,  303,
+   -1,   -1,   -1,  307,   -1,  309,  310,   -1,   37,   -1,
+   -1,   -1,   -1,   42,   43,   -1,   -1,   -1,   47,   33,
+   49,   91,   36,   37,   38,   -1,   40,   -1,   42,   43,
+   -1,   45,   61,   62,   63,   64,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   64,   -1,   -1,   -1,   -1,   -1,  126,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   91,  107,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   -1,   41,  308,   -1,   44,  311,  312,  313,   -1,
+   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,   58,
+   59,   -1,  126,  272,  273,  274,  275,   -1,   -1,   -1,
+   58,   59,  281,   -1,   -1,   63,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,  167,  298,
+  299,  300,  301,  302,   93,  304,  305,   -1,   41,  308,
+   -1,   44,  311,  312,  313,   93,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  123,   -1,  257,  258,  259,
+  260,  261,   -1,  263,  264,  265,   -1,   -1,   91,  269,
+   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  280,   -1,  282,  283,  284,   -1,   -1,   -1,   -1,  289,
+  290,  291,  292,  293,   -1,   -1,  296,  297,   -1,   -1,
+   -1,   -1,   -1,  303,   -1,   41,   -1,  307,   44,  309,
+  310,   -1,   -1,  257,  258,  259,  260,  261,   -1,  263,
+  264,  265,   58,   59,   -1,  269,   -1,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
+  284,   -1,   -1,   -1,   -1,  289,  290,  291,  292,  293,
+   -1,   -1,  296,  297,   -1,   -1,   -1,   93,   -1,  303,
+   41,   -1,   -1,  307,   -1,  309,  310,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,   -1,  123,   -1,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,
+   91,   -1,   93,  281,   -1,  294,  295,  285,  286,  287,
+  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
+  298,  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,
+  308,   -1,  123,  311,  312,  313,   -1,   -1,   -1,  272,
+  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,
+   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,
+   -1,  294,  295,   -1,   41,  298,  299,  300,  301,  302,
+   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,
+  313,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   91,   -1,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,  123,   -1,  294,  295,
+   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
+   41,   -1,  308,   44,   -1,  311,  312,  313,   -1,   -1,
+   -1,   41,   -1,   -1,   44,   -1,   -1,   58,   59,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
+  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   93,  304,  305,   -1,   -1,  308,   -1,   -1,
+  311,  312,  313,   93,   41,   -1,   -1,   44,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,  123,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   41,   -1,  294,  295,   93,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,  308,   58,   59,  311,  312,  313,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   91,   -1,   93,   -1,   -1,
+   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,  123,   -1,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   93,
+   -1,  281,   -1,  294,  295,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   -1,  304,  305,   -1,   -1,  308,   -1,
+   -1,  311,  312,  313,   -1,   41,   -1,   -1,   44,   -1,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,  308,   -1,   -1,  311,  312,  313,   93,  272,  273,
+  274,  275,   -1,   -1,   -1,   41,   -1,  281,   44,   -1,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   58,   59,  298,  299,  300,  301,  302,   -1,
+  304,  305,   -1,   -1,  308,   -1,   -1,  311,  312,  313,
+   -1,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,  281,   -1,   93,   -1,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   63,  298,  299,  300,  301,  302,   -1,  304,  305,
+   -1,   -1,  308,   -1,   -1,  311,  312,  313,  272,  273,
+  274,  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   91,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   41,
+  304,  305,   44,   -1,  308,   -1,   -1,  311,  312,  313,
+   -1,  123,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   93,   -1,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   58,   59,  281,   -1,   -1,   63,  285,
+  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,  305,
+   41,   -1,  308,   44,   -1,  311,  312,  313,   93,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,  272,  273,  274,  275,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,
+   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,
+   -1,   -1,   93,   -1,   58,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   93,
+   -1,   58,   59,   -1,   -1,   -1,   63,  299,  300,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   93,   -1,   -1,   58,
+   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,
+  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,  294,  295,   93,   -1,  298,  299,  300,  301,
+  302,   -1,  304,  305,   -1,   -1,  308,   -1,   -1,  311,
+  312,  313,   -1,   -1,   -1,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   41,   -1,  308,   44,   -1,  311,  312,  313,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   58,   59,
+  281,   -1,   -1,   63,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  308,  272,  273,
+  274,  275,   -1,   93,   -1,   -1,   -1,  281,   -1,   -1,
+   -1,  285,  286,  287,  288,   -1,   -1,   -1,   -1,   -1,
+  294,  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,
+  304,  305,   -1,   -1,  308,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,  285,  286,
+  287,  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  304,  305,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,
+   -1,   -1,  281,   -1,   -1,   -1,  285,  286,  287,  288,
+   41,   -1,   -1,   44,   -1,  294,  295,   -1,   -1,  298,
+  299,  300,  301,  302,   -1,  304,  305,   58,   59,   -1,
+   -1,   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   93,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   41,   -1,   -1,   44,   -1,   -1,   -1,   -1,   93,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   58,   59,   -1,
+   -1,  281,   63,   -1,   -1,  285,  286,  287,  288,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   41,  304,  305,   44,   -1,   -1,   -1,
+   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,
+   -1,   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   93,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   93,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   93,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,
+  301,  302,   -1,  304,  305,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,
+  285,  286,  287,  288,   41,   -1,   -1,   44,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   -1,  304,
+  305,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,   -1,
+  281,   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,
+   -1,   -1,   -1,  294,  295,   -1,   93,  298,  299,  300,
+  301,  302,   41,  304,  305,   44,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,   58,
+   59,   -1,   -1,  281,   63,   -1,   -1,  285,  286,  287,
+  288,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,
+  298,  299,  300,  301,  302,   -1,  304,  305,   -1,   -1,
+  272,  273,  274,  275,   93,   -1,   -1,   -1,   -1,  281,
+   -1,   -1,   -1,  285,  286,  287,  288,   -1,   -1,   -1,
+   -1,   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,
+  302,   41,  304,   -1,   44,   -1,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   58,   59,
+  285,  286,   -1,   63,   -1,   -1,   -1,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,  302,   41,  304,
+   -1,   44,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   44,   -1,   93,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   41,   -1,   -1,   44,   -1,   -1,
+   93,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   93,   58,   59,   -1,  281,   -1,   63,   -1,  285,  286,
+   -1,   -1,   -1,   -1,   -1,   -1,   41,  294,  295,   44,
+   -1,  298,  299,  300,  301,  302,   41,   -1,   -1,   44,
+   -1,   -1,   -1,   58,   59,   -1,   93,   -1,   63,   -1,
+   -1,   -1,   -1,   58,   59,   -1,   -1,   -1,   63,   -1,
+   -1,   -1,   -1,  272,  273,  274,  275,   -1,   -1,   58,
+   -1,   -1,  281,   -1,   63,   -1,  285,  286,   93,   -1,
+   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,   93,  298,
+  299,  300,  301,  302,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   91,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  272,  273,  274,  275,   -1,   -1,   -1,   -1,
+   -1,  281,   -1,   -1,   -1,  285,  286,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  294,  295,   -1,   -1,  298,  299,
+  300,  301,  302,   -1,   -1,   -1,   -1,   -1,   -1,  272,
+  273,  274,  275,   -1,   -1,   -1,   -1,   -1,  281,  272,
+  273,  274,  275,  286,   -1,   -1,   -1,   -1,  281,   -1,
+   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
+   -1,  294,  295,   -1,   -1,  298,  299,  300,  301,  302,
+   -1,   -1,   -1,   -1,   -1,  272,  273,  274,  275,   -1,
+   -1,   -1,   -1,   -1,  281,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  294,  295,   -1,
+   -1,  298,  299,  300,  301,  302,   -1,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,  272,  273,  274,
+  275,   -1,   -1,   -1,   -1,   -1,  281,   -1,   -1,  294,
+  295,   -1,   -1,  298,  299,  300,  301,   -1,   -1,  294,
+  295,   -1,  281,  298,  299,  300,  285,  286,  287,  288,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  298,
+  299,  300,  301,  302,   -1,  304,  305,   30,   -1,  308,
+   -1,   -1,  311,  312,  313,   38,   -1,   -1,   -1,   -1,
+   43,   44,   -1,   -1,   -1,   -1,   -1,   50,   51,   52,
+   53,   54,   55,   -1,   -1,   58,   59,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   90,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  143,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  151,  152,
+  153,  154,  155,  156,  157,  158,  159,  160,  161,  162,
+  163,  164,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  256,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  284,
+};
+#define YYFINAL 1
+#ifndef YYDEBUG
+#define YYDEBUG 0
+#endif
+#define YYMAXTOKEN 313
+#if YYDEBUG
+dEXT char * yyname[] = {
+"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+"'!'",0,0,"'$'","'%'","'&'",0,"'('","')'","'*'","'+'","','","'-'",0,0,0,0,0,0,0,
+0,0,0,0,0,"':'","';'",0,0,0,"'?'","'@'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,"'['",0,"']'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,"'{'",0,"'}'","'~'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"WORD","METHOD","FUNCMETH","THING",
+"PMFUNC","PRIVATEREF","FUNC0SUB","UNIOPSUB","LSTOPSUB","LABEL","FORMAT","SUB",
+"ANONSUB","PACKAGE","USE","WHILE","UNTIL","IF","UNLESS","ELSE","ELSIF",
+"CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1","FUNC","RELOP","EQOP",
+"MULOP","ADDOP","DOLSHARP","DO","LOCAL","HASHBRACK","NOAMP","OROP","ANDOP",
+"NOTOP","LSTOP","ASSIGNOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP",
+"SHIFTOP","MATCHOP","UMINUS","REFGEN","POWOP","PREINC","PREDEC","POSTINC",
+"POSTDEC","ARROW",
+};
+dEXT char * yyrule[] = {
+"$accept : prog",
+"$$1 :",
+"prog : $$1 lineseq",
+"block : '{' remember lineseq '}'",
+"remember :",
+"lineseq :",
+"lineseq : lineseq decl",
+"lineseq : lineseq line",
+"line : label cond",
+"line : loop",
+"line : label ';'",
+"line : label sideff ';'",
+"sideff : error",
+"sideff : expr",
+"sideff : expr IF expr",
+"sideff : expr UNLESS expr",
+"sideff : expr WHILE expr",
+"sideff : expr UNTIL expr",
+"else :",
+"else : ELSE block",
+"else : ELSIF '(' expr ')' block else",
+"cond : IF '(' expr ')' block else",
+"cond : UNLESS '(' expr ')' block else",
+"cond : IF block block else",
+"cond : UNLESS block block else",
+"cont :",
+"cont : CONTINUE block",
+"loop : label WHILE '(' texpr ')' block cont",
+"loop : label UNTIL '(' expr ')' block cont",
+"loop : label WHILE block block cont",
+"loop : label UNTIL block block cont",
+"loop : label FOR scalar '(' expr ')' block cont",
+"loop : label FOR '(' expr ')' block cont",
+"loop : label FOR '(' nexpr ';' texpr ';' nexpr ')' block",
+"loop : label block cont",
+"nexpr :",
+"nexpr : sideff",
+"texpr :",
+"texpr : expr",
+"label :",
+"label : LABEL",
+"decl : format",
+"decl : subrout",
+"decl : package",
+"decl : use",
+"format : FORMAT startsub WORD block",
+"format : FORMAT startsub block",
+"subrout : SUB startsub WORD proto block",
+"subrout : SUB startsub WORD proto ';'",
+"proto :",
+"proto : THING",
+"startsub :",
+"package : PACKAGE WORD ';'",
+"package : PACKAGE ';'",
+"use : USE startsub WORD listexpr ';'",
+"expr : expr ANDOP expr",
+"expr : expr OROP expr",
+"expr : argexpr",
+"argexpr : argexpr ','",
+"argexpr : argexpr ',' term",
+"argexpr : term",
+"listop : LSTOP indirob argexpr",
+"listop : FUNC '(' indirob expr ')'",
+"listop : term ARROW method '(' listexprcom ')'",
+"listop : METHOD indirob listexpr",
+"listop : FUNCMETH indirob '(' listexprcom ')'",
+"listop : LSTOP listexpr",
+"listop : FUNC '(' listexprcom ')'",
+"listop : LSTOPSUB startsub block listexpr",
+"method : METHOD",
+"method : scalar",
+"term : term ASSIGNOP term",
+"term : term POWOP term",
+"term : term MULOP term",
+"term : term ADDOP term",
+"term : term SHIFTOP term",
+"term : term RELOP term",
+"term : term EQOP term",
+"term : term BITANDOP term",
+"term : term BITOROP term",
+"term : term DOTDOT term",
+"term : term ANDAND term",
+"term : term OROR term",
+"term : term '?' term ':' term",
+"term : term MATCHOP term",
+"term : '-' term",
+"term : '+' term",
+"term : '!' term",
+"term : '~' term",
+"term : REFGEN term",
+"term : term POSTINC",
+"term : term POSTDEC",
+"term : PREINC term",
+"term : PREDEC term",
+"term : LOCAL term",
+"term : '(' expr ')'",
+"term : '(' ')'",
+"term : '[' expr ']'",
+"term : '[' ']'",
+"term : HASHBRACK expr ';' '}'",
+"term : HASHBRACK ';' '}'",
+"term : ANONSUB startsub proto block",
+"term : scalar",
+"term : star '{' expr ';' '}'",
+"term : star",
+"term : scalar '[' expr ']'",
+"term : term ARROW '[' expr ']'",
+"term : term '[' expr ']'",
+"term : hsh",
+"term : ary",
+"term : arylen",
+"term : scalar '{' expr ';' '}'",
+"term : term ARROW '{' expr ';' '}'",
+"term : term '{' expr ';' '}'",
+"term : '(' expr ')' '[' expr ']'",
+"term : '(' ')' '[' expr ']'",
+"term : ary '[' expr ']'",
+"term : ary '{' expr ';' '}'",
+"term : THING",
+"term : amper",
+"term : amper '(' ')'",
+"term : amper '(' expr ')'",
+"term : NOAMP WORD listexpr",
+"term : DO term",
+"term : DO block",
+"term : DO WORD '(' ')'",
+"term : DO WORD '(' expr ')'",
+"term : DO scalar '(' ')'",
+"term : DO scalar '(' expr ')'",
+"term : LOOPEX",
+"term : LOOPEX term",
+"term : NOTOP argexpr",
+"term : UNIOP",
+"term : UNIOP block",
+"term : UNIOP term",
+"term : UNIOPSUB term",
+"term : FUNC0",
+"term : FUNC0 '(' ')'",
+"term : FUNC0SUB",
+"term : FUNC1 '(' ')'",
+"term : FUNC1 '(' expr ')'",
+"term : PMFUNC '(' term ')'",
+"term : PMFUNC '(' term ',' term ')'",
+"term : WORD",
+"term : listop",
+"listexpr :",
+"listexpr : argexpr",
+"listexprcom :",
+"listexprcom : expr",
+"listexprcom : expr ','",
+"amper : '&' indirob",
+"scalar : '$' indirob",
+"ary : '@' indirob",
+"hsh : '%' indirob",
+"arylen : DOLSHARP indirob",
+"star : '*' indirob",
+"indirob : WORD",
+"indirob : scalar",
+"indirob : block",
+"indirob : PRIVATEREF",
+};
+#endif
+#define yyclearin (yychar=(-1))
+#define yyerrok (yyerrflag=0)
+#ifdef YYSTACKSIZE
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH YYSTACKSIZE
+#endif
+#else
+#ifdef YYMAXDEPTH
+#define YYSTACKSIZE YYMAXDEPTH
+#else
+#define YYSTACKSIZE 500
+#define YYMAXDEPTH 500
+#endif
+#endif
+dEXT int yydebug;
+dEXT int yynerrs;
+dEXT int yyerrflag;
+dEXT int yychar;
+dEXT YYSTYPE yyval;
+dEXT YYSTYPE yylval;
+#line 571 "perly.y"
+ /* PROGRAM */
+#line 1394 "y_tab.c"
+#define YYABORT goto yyabort
+#define YYACCEPT goto yyaccept
+#define YYERROR goto yyerrlab
+
+struct ysv {
+    short* yyss;
+    YYSTYPE* yyvs;
+    int oldyydebug;
+    int oldyynerrs;
+    int oldyyerrflag;
+    int oldyychar;
+    YYSTYPE oldyyval;
+    YYSTYPE oldyylval;
+};
+
+void
+yydestruct(ptr)
+void* ptr;
+{
+    struct ysv* ysave = (struct ysv*)ptr;
+    if (ysave->yyss) Safefree(ysave->yyss);
+    if (ysave->yyvs) Safefree(ysave->yyvs);
+    yydebug	= ysave->oldyydebug;
+    yynerrs	= ysave->oldyynerrs;
+    yyerrflag	= ysave->oldyyerrflag;
+    yychar	= ysave->oldyychar;
+    yyval	= ysave->oldyyval;
+    yylval	= ysave->oldyylval;
+    Safefree(ysave);
+}
+
+int
+yyparse()
+{
+    register int yym, yyn, yystate;
+    register short *yyssp;
+    register YYSTYPE *yyvsp;
+    short* yyss;
+    YYSTYPE* yyvs;
+    unsigned yystacksize = YYSTACKSIZE;
+    int retval = 0;
+#if YYDEBUG
+    register char *yys;
+    extern char *getenv();
+#endif
+
+    struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+    SAVEDESTRUCTOR(yydestruct, ysave);
+    ysave->oldyydebug	= yydebug;
+    ysave->oldyynerrs	= yynerrs;
+    ysave->oldyyerrflag	= yyerrflag;
+    ysave->oldyychar	= yychar;
+    ysave->oldyyval	= yyval;
+    ysave->oldyylval	= yylval;
+
+#if YYDEBUG
+    if (yys = getenv("YYDEBUG"))
+    {
+        yyn = *yys;
+        if (yyn >= '0' && yyn <= '9')
+            yydebug = yyn - '0';
+    }
+#endif
+
+    yynerrs = 0;
+    yyerrflag = 0;
+    yychar = (-1);
+
+    /*
+    ** Initialize private stacks (yyparse may be called from an action)
+    */
+    ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
+    ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+    if (!yyvs || !yyss)
+	goto yyoverflow;
+
+    yyssp = yyss;
+    yyvsp = yyvs;
+    *yyssp = yystate = 0;
+
+yyloop:
+    if (yyn = yydefred[yystate]) goto yyreduce;
+    if (yychar < 0)
+    {
+        if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate,
+                    yychar, yys);
+        }
+#endif
+    }
+    if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+#if YYDEBUG
+        if (yydebug)
+            fprintf(stderr, "yydebug: state %d, shifting to state %d\n",
+                    yystate, yytable[yyn]);
+#endif
+        if (yyssp >= yyss + yystacksize - 1)
+        {
+	    /*
+	    ** reallocate and recover.  Note that pointers
+	    ** have to be reset, or bad things will happen
+	    */
+	    int yyps_index = (yyssp - yyss);
+	    int yypv_index = (yyvsp - yyvs);
+	    yystacksize += YYSTACKSIZE;
+	    ysave->yyvs = yyvs =
+		(YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+	    ysave->yyss = yyss =
+		(short*)realloc((char*)yyss,yystacksize * sizeof(short));
+	    if (!yyvs || !yyss)
+		goto yyoverflow;
+	    yyssp = yyss + yyps_index;
+	    yyvsp = yyvs + yypv_index;
+        }
+        *++yyssp = yystate = yytable[yyn];
+        *++yyvsp = yylval;
+        yychar = (-1);
+        if (yyerrflag > 0)  --yyerrflag;
+        goto yyloop;
+    }
+    if ((yyn = yyrindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+        yyn = yytable[yyn];
+        goto yyreduce;
+    }
+    if (yyerrflag) goto yyinrecovery;
+#ifdef lint
+    goto yynewerror;
+#endif
+yynewerror:
+    yyerror("syntax error");
+#ifdef lint
+    goto yyerrlab;
+#endif
+yyerrlab:
+    ++yynerrs;
+yyinrecovery:
+    if (yyerrflag < 3)
+    {
+        yyerrflag = 3;
+        for (;;)
+        {
+            if ((yyn = yysindex[*yyssp]) && (yyn += YYERRCODE) >= 0 &&
+                    yyn <= YYTABLESIZE && yycheck[yyn] == YYERRCODE)
+            {
+#if YYDEBUG
+                if (yydebug)
+                    fprintf(stderr,
+		     "yydebug: state %d, error recovery shifting to state %d\n",
+		     *yyssp, yytable[yyn]);
+#endif
+                if (yyssp >= yyss + yystacksize - 1)
+                {
+		    /*
+		    ** reallocate and recover.  Note that pointers
+		    ** have to be reset, or bad things will happen
+		    */
+		    int yyps_index = (yyssp - yyss);
+		    int yypv_index = (yyvsp - yyvs);
+		    yystacksize += YYSTACKSIZE;
+		    ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
+			yystacksize * sizeof(YYSTYPE));
+		    ysave->yyss = yyss = (short*)realloc((char*)yyss,
+			yystacksize * sizeof(short));
+		    if (!yyvs || !yyss)
+			goto yyoverflow;
+		    yyssp = yyss + yyps_index;
+		    yyvsp = yyvs + yypv_index;
+                }
+                *++yyssp = yystate = yytable[yyn];
+                *++yyvsp = yylval;
+                goto yyloop;
+            }
+            else
+            {
+#if YYDEBUG
+                if (yydebug)
+                    fprintf(stderr,
+			"yydebug: error recovery discarding state %d\n",
+			*yyssp);
+#endif
+                if (yyssp <= yyss) goto yyabort;
+                --yyssp;
+                --yyvsp;
+            }
+        }
+    }
+    else
+    {
+        if (yychar == 0) goto yyabort;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            fprintf(stderr,
+		"yydebug: state %d, error recovery discards token %d (%s)\n",
+		yystate, yychar, yys);
+        }
+#endif
+        yychar = (-1);
+        goto yyloop;
+    }
+yyreduce:
+#if YYDEBUG
+    if (yydebug)
+        fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n",
+                yystate, yyn, yyrule[yyn]);
+#endif
+    yym = yylen[yyn];
+    yyval = yyvsp[1-yym];
+    switch (yyn)
+    {
+case 1:
+#line 84 "perly.y"
+{
+#if defined(YYDEBUG) && defined(DEBUGGING)
+		    yydebug = (debug & 1);
+#endif
+		    expect = XSTATE;
+		}
+break;
+case 2:
+#line 91 "perly.y"
+{ newPROG(yyvsp[0].opval); }
+break;
+case 3:
+#line 95 "perly.y"
+{ yyval.opval = block_end(yyvsp[-3].ival,yyvsp[-2].ival,yyvsp[-1].opval); }
+break;
+case 4:
+#line 99 "perly.y"
+{ yyval.ival = block_start(); }
+break;
+case 5:
+#line 103 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 6:
+#line 105 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 7:
+#line 107 "perly.y"
+{   yyval.opval = append_list(OP_LINESEQ,
+				(LISTOP*)yyvsp[-1].opval, (LISTOP*)yyvsp[0].opval);
+			    pad_reset_pending = TRUE;
+			    if (yyvsp[-1].opval && yyvsp[0].opval) hints |= HINT_BLOCK_SCOPE; }
+break;
+case 8:
+#line 114 "perly.y"
+{ yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); }
+break;
+case 10:
+#line 117 "perly.y"
+{ if (yyvsp[-1].pval != Nullch) {
+			      yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0));
+			    }
+			    else {
+			      yyval.opval = Nullop;
+			      copline = NOLINE;
+			    }
+			    expect = XSTATE; }
+break;
+case 11:
+#line 126 "perly.y"
+{ yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval);
+			  expect = XSTATE; }
+break;
+case 12:
+#line 131 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 13:
+#line 133 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 14:
+#line 135 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); }
+break;
+case 15:
+#line 137 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); }
+break;
+case 16:
+#line 139 "perly.y"
+{ yyval.opval = newLOOPOP(OPf_PARENS, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); }
+break;
+case 17:
+#line 141 "perly.y"
+{ yyval.opval = newLOOPOP(OPf_PARENS, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);}
+break;
+case 18:
+#line 145 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 19:
+#line 147 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 20:
+#line 149 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, 0,
+				newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval));
+			    hints |= HINT_BLOCK_SCOPE; }
+break;
+case 21:
+#line 156 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 22:
+#line 159 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newCONDOP(0,
+				invert(scalar(yyvsp[-3].opval)), scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 23:
+#line 163 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    deprecate("if BLOCK BLOCK");
+			    yyval.opval = newCONDOP(0, scope(yyvsp[-2].opval), scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 24:
+#line 167 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    deprecate("unless BLOCK BLOCK");
+			    yyval.opval = newCONDOP(0, invert(scalar(scope(yyvsp[-2].opval))),
+						scope(yyvsp[-1].opval), yyvsp[0].opval); }
+break;
+case 25:
+#line 174 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 26:
+#line 176 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 27:
+#line 180 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 28:
+#line 185 "perly.y"
+{ copline = yyvsp[-5].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-6].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 29:
+#line 190 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); }
+break;
+case 30:
+#line 195 "perly.y"
+{ copline = yyvsp[-3].ival;
+			    yyval.opval = newSTATEOP(0, yyvsp[-4].pval,
+				    newWHILEOP(0, 1, (LOOP*)Nullop,
+					invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); }
+break;
+case 31:
+#line 200 "perly.y"
+{ yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, mod(yyvsp[-5].opval, OP_ENTERLOOP),
+				yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 32:
+#line 203 "perly.y"
+{ yyval.opval = newFOROP(0, yyvsp[-6].pval, yyvsp[-5].ival, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 33:
+#line 206 "perly.y"
+{  copline = yyvsp[-8].ival;
+			    yyval.opval = append_elem(OP_LINESEQ,
+				    newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)),
+				    newSTATEOP(0, yyvsp[-9].pval,
+					newWHILEOP(0, 1, (LOOP*)Nullop,
+					    scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); }
+break;
+case 34:
+#line 213 "perly.y"
+{ yyval.opval = newSTATEOP(0,
+				yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop,
+					Nullop, yyvsp[-1].opval, yyvsp[0].opval)); }
+break;
+case 35:
+#line 219 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 37:
+#line 224 "perly.y"
+{ (void)scan_num("1"); yyval.opval = yylval.opval; }
+break;
+case 39:
+#line 229 "perly.y"
+{ yyval.pval = Nullch; }
+break;
+case 41:
+#line 234 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 42:
+#line 236 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 43:
+#line 238 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 44:
+#line 240 "perly.y"
+{ yyval.ival = 0; }
+break;
+case 45:
+#line 244 "perly.y"
+{ newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 46:
+#line 246 "perly.y"
+{ newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); }
+break;
+case 47:
+#line 250 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 48:
+#line 252 "perly.y"
+{ newSUB(yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval, Nullop); expect = XSTATE; }
+break;
+case 49:
+#line 256 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 51:
+#line 261 "perly.y"
+{ yyval.ival = start_subparse(); }
+break;
+case 52:
+#line 265 "perly.y"
+{ package(yyvsp[-1].opval); }
+break;
+case 53:
+#line 267 "perly.y"
+{ package(Nullop); }
+break;
+case 54:
+#line 271 "perly.y"
+{ utilize(yyvsp[-4].ival, yyvsp[-3].ival, yyvsp[-2].opval, yyvsp[-1].opval); }
+break;
+case 55:
+#line 275 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 56:
+#line 277 "perly.y"
+{ yyval.opval = newLOGOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 58:
+#line 282 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 59:
+#line 284 "perly.y"
+{ yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 61:
+#line 289 "perly.y"
+{ yyval.opval = convert(yyvsp[-2].ival, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF(yyvsp[-2].ival,yyvsp[-1].opval), yyvsp[0].opval) ); }
+break;
+case 62:
+#line 292 "perly.y"
+{ yyval.opval = convert(yyvsp[-4].ival, OPf_STACKED,
+				prepend_elem(OP_LIST, newGVREF(yyvsp[-4].ival,yyvsp[-2].opval), yyvsp[-1].opval) ); }
+break;
+case 63:
+#line 295 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-5].opval, yyvsp[-1].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-3].opval))); }
+break;
+case 64:
+#line 300 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-1].opval, yyvsp[0].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-2].opval))); }
+break;
+case 65:
+#line 305 "perly.y"
+{ yyval.opval = convert(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST,
+				    prepend_elem(OP_LIST, yyvsp[-3].opval, yyvsp[-1].opval),
+				    newUNOP(OP_METHOD, 0, yyvsp[-4].opval))); }
+break;
+case 66:
+#line 310 "perly.y"
+{ yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 67:
+#line 312 "perly.y"
+{ yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
+break;
+case 68:
+#line 314 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST,
+			      prepend_elem(OP_LIST, newANONSUB(yyvsp[-2].ival, 0, yyvsp[-1].opval), yyvsp[0].opval),
+			      yyvsp[-3].opval)); }
+break;
+case 71:
+#line 325 "perly.y"
+{ yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[-1].ival, yyvsp[0].opval); }
+break;
+case 72:
+#line 327 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 73:
+#line 329 "perly.y"
+{   if (yyvsp[-1].ival != OP_REPEAT)
+				scalar(yyvsp[-2].opval);
+			    yyval.opval = newBINOP(yyvsp[-1].ival, 0, yyvsp[-2].opval, scalar(yyvsp[0].opval)); }
+break;
+case 74:
+#line 333 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 75:
+#line 335 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 76:
+#line 337 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 77:
+#line 339 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 78:
+#line 341 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 79:
+#line 343 "perly.y"
+{ yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); }
+break;
+case 80:
+#line 345 "perly.y"
+{ yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));}
+break;
+case 81:
+#line 347 "perly.y"
+{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 82:
+#line 349 "perly.y"
+{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 83:
+#line 351 "perly.y"
+{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 84:
+#line 353 "perly.y"
+{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); }
+break;
+case 85:
+#line 356 "perly.y"
+{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); }
+break;
+case 86:
+#line 358 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 87:
+#line 360 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+break;
+case 88:
+#line 362 "perly.y"
+{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));}
+break;
+case 89:
+#line 364 "perly.y"
+{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); }
+break;
+case 90:
+#line 366 "perly.y"
+{ yyval.opval = newUNOP(OP_POSTINC, 0,
+					mod(scalar(yyvsp[-1].opval), OP_POSTINC)); }
+break;
+case 91:
+#line 369 "perly.y"
+{ yyval.opval = newUNOP(OP_POSTDEC, 0,
+					mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); }
+break;
+case 92:
+#line 372 "perly.y"
+{ yyval.opval = newUNOP(OP_PREINC, 0,
+					mod(scalar(yyvsp[0].opval), OP_PREINC)); }
+break;
+case 93:
+#line 375 "perly.y"
+{ yyval.opval = newUNOP(OP_PREDEC, 0,
+					mod(scalar(yyvsp[0].opval), OP_PREDEC)); }
+break;
+case 94:
+#line 378 "perly.y"
+{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); }
+break;
+case 95:
+#line 380 "perly.y"
+{ yyval.opval = sawparens(yyvsp[-1].opval); }
+break;
+case 96:
+#line 382 "perly.y"
+{ yyval.opval = sawparens(newNULLLIST()); }
+break;
+case 97:
+#line 384 "perly.y"
+{ yyval.opval = newANONLIST(yyvsp[-1].opval); }
+break;
+case 98:
+#line 386 "perly.y"
+{ yyval.opval = newANONLIST(Nullop); }
+break;
+case 99:
+#line 388 "perly.y"
+{ yyval.opval = newANONHASH(yyvsp[-2].opval); }
+break;
+case 100:
+#line 390 "perly.y"
+{ yyval.opval = newANONHASH(Nullop); }
+break;
+case 101:
+#line 392 "perly.y"
+{ yyval.opval = newANONSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); }
+break;
+case 102:
+#line 394 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 103:
+#line 396 "perly.y"
+{ yyval.opval = newBINOP(OP_GELEM, 0, newGVREF(0,yyvsp[-4].opval), yyvsp[-2].opval); }
+break;
+case 104:
+#line 398 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 105:
+#line 400 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); }
+break;
+case 106:
+#line 402 "perly.y"
+{ yyval.opval = newBINOP(OP_AELEM, 0,
+					ref(newAVREF(yyvsp[-4].opval),OP_RV2AV),
+					scalar(yyvsp[-1].opval));}
+break;
+case 107:
+#line 406 "perly.y"
+{ assertref(yyvsp[-3].opval); yyval.opval = newBINOP(OP_AELEM, 0,
+					ref(newAVREF(yyvsp[-3].opval),OP_RV2AV),
+					scalar(yyvsp[-1].opval));}
+break;
+case 108:
+#line 410 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 109:
+#line 412 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 110:
+#line 414 "perly.y"
+{ yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));}
+break;
+case 111:
+#line 416 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 112:
+#line 419 "perly.y"
+{ yyval.opval = newBINOP(OP_HELEM, 0,
+					ref(newHVREF(yyvsp[-5].opval),OP_RV2HV),
+					jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 113:
+#line 424 "perly.y"
+{ assertref(yyvsp[-4].opval); yyval.opval = newBINOP(OP_HELEM, 0,
+					ref(newHVREF(yyvsp[-4].opval),OP_RV2HV),
+					jmaybe(yyvsp[-2].opval));
+			    expect = XOPERATOR; }
+break;
+case 114:
+#line 429 "perly.y"
+{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); }
+break;
+case 115:
+#line 431 "perly.y"
+{ yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); }
+break;
+case 116:
+#line 433 "perly.y"
+{ yyval.opval = prepend_elem(OP_ASLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_ASLICE, 0,
+					list(yyvsp[-1].opval),
+					ref(yyvsp[-3].opval, OP_ASLICE))); }
+break;
+case 117:
+#line 439 "perly.y"
+{ yyval.opval = prepend_elem(OP_HSLICE,
+				newOP(OP_PUSHMARK, 0),
+				    newLISTOP(OP_HSLICE, 0,
+					list(yyvsp[-2].opval),
+					ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)));
+			    expect = XOPERATOR; }
+break;
+case 118:
+#line 446 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 119:
+#line 448 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, 0, scalar(yyvsp[0].opval)); }
+break;
+case 120:
+#line 450 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar(yyvsp[-2].opval)); }
+break;
+case 121:
+#line 452 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[-1].opval, scalar(yyvsp[-3].opval))); }
+break;
+case 122:
+#line 455 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
+break;
+case 123:
+#line 458 "perly.y"
+{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
+break;
+case 124:
+#line 460 "perly.y"
+{ yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); }
+break;
+case 125:
+#line 462 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar(yyvsp[-2].opval)
+				)),Nullop)); dep();}
+break;
+case 126:
+#line 470 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB,
+			    OPf_SPECIAL|OPf_STACKED,
+			    append_elem(OP_LIST,
+				yyvsp[-1].opval,
+				scalar(newCVREF(
+				    (OPpENTERSUB_AMPER<<8),
+				    scalar(yyvsp[-3].opval)
+				)))); dep();}
+break;
+case 127:
+#line 479 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				scalar(newCVREF(0,scalar(yyvsp[-2].opval))), Nullop)); dep();}
+break;
+case 128:
+#line 483 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
+			    prepend_elem(OP_LIST,
+				yyvsp[-1].opval,
+				scalar(newCVREF(0,scalar(yyvsp[-3].opval))))); dep();}
+break;
+case 129:
+#line 488 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL);
+			    hints |= HINT_BLOCK_SCOPE; }
+break;
+case 130:
+#line 491 "perly.y"
+{ yyval.opval = newLOOPEX(yyvsp[-1].ival,yyvsp[0].opval); }
+break;
+case 131:
+#line 493 "perly.y"
+{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); }
+break;
+case 132:
+#line 495 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+break;
+case 133:
+#line 497 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 134:
+#line 499 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); }
+break;
+case 135:
+#line 501 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST, yyvsp[0].opval, scalar(yyvsp[-1].opval))); }
+break;
+case 136:
+#line 504 "perly.y"
+{ yyval.opval = newOP(yyvsp[0].ival, 0); }
+break;
+case 137:
+#line 506 "perly.y"
+{ yyval.opval = newOP(yyvsp[-2].ival, 0); }
+break;
+case 138:
+#line 508 "perly.y"
+{ yyval.opval = newUNOP(OP_ENTERSUB, 0,
+				scalar(yyvsp[0].opval)); }
+break;
+case 139:
+#line 511 "perly.y"
+{ yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); }
+break;
+case 140:
+#line 513 "perly.y"
+{ yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); }
+break;
+case 141:
+#line 515 "perly.y"
+{ yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); }
+break;
+case 142:
+#line 517 "perly.y"
+{ yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); }
+break;
+case 145:
+#line 523 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 146:
+#line 525 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 147:
+#line 529 "perly.y"
+{ yyval.opval = Nullop; }
+break;
+case 148:
+#line 531 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+case 149:
+#line 533 "perly.y"
+{ yyval.opval = yyvsp[-1].opval; }
+break;
+case 150:
+#line 537 "perly.y"
+{ yyval.opval = newCVREF(yyvsp[-1].ival,yyvsp[0].opval); }
+break;
+case 151:
+#line 541 "perly.y"
+{ yyval.opval = newSVREF(yyvsp[0].opval); }
+break;
+case 152:
+#line 545 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
+break;
+case 153:
+#line 549 "perly.y"
+{ yyval.opval = newHVREF(yyvsp[0].opval); }
+break;
+case 154:
+#line 553 "perly.y"
+{ yyval.opval = newAVREF(yyvsp[0].opval); }
+break;
+case 155:
+#line 557 "perly.y"
+{ yyval.opval = newGVREF(0,yyvsp[0].opval); }
+break;
+case 156:
+#line 561 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval); }
+break;
+case 157:
+#line 563 "perly.y"
+{ yyval.opval = scalar(yyvsp[0].opval);  }
+break;
+case 158:
+#line 565 "perly.y"
+{ yyval.opval = scope(yyvsp[0].opval); }
+break;
+case 159:
+#line 568 "perly.y"
+{ yyval.opval = yyvsp[0].opval; }
+break;
+#line 2236 "y_tab.c"
+    }
+    yyssp -= yym;
+    yystate = *yyssp;
+    yyvsp -= yym;
+    yym = yylhs[yyn];
+    if (yystate == 0 && yym == 0)
+    {
+#if YYDEBUG
+        if (yydebug)
+            fprintf(stderr,
+		"yydebug: after reduction, shifting from state 0 to state %d\n",
+		YYFINAL);
+#endif
+        yystate = YYFINAL;
+        *++yyssp = YYFINAL;
+        *++yyvsp = yyval;
+        if (yychar < 0)
+        {
+            if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+            if (yydebug)
+            {
+                yys = 0;
+                if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+                if (!yys) yys = "illegal-symbol";
+                fprintf(stderr, "yydebug: state %d, reading %d (%s)\n",
+                        YYFINAL, yychar, yys);
+            }
+#endif
+        }
+        if (yychar == 0) goto yyaccept;
+        goto yyloop;
+    }
+    if ((yyn = yygindex[yym]) && (yyn += yystate) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yystate)
+        yystate = yytable[yyn];
+    else
+        yystate = yydgoto[yym];
+#if YYDEBUG
+    if (yydebug)
+        fprintf(stderr,
+	    "yydebug: after reduction, shifting from state %d to state %d\n",
+	    *yyssp, yystate);
+#endif
+    if (yyssp >= yyss + yystacksize - 1)
+    {
+	/*
+	** reallocate and recover.  Note that pointers
+	** have to be reset, or bad things will happen
+	*/
+	int yyps_index = (yyssp - yyss);
+	int yypv_index = (yyvsp - yyvs);
+	yystacksize += YYSTACKSIZE;
+	ysave->yyvs = yyvs =
+	    (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
+	ysave->yyss = yyss =
+	    (short*)realloc((char*)yyss,yystacksize * sizeof(short));
+	if (!yyvs || !yyss)
+	    goto yyoverflow;
+	yyssp = yyss + yyps_index;
+	yyvsp = yyvs + yypv_index;
+    }
+    *++yyssp = yystate;
+    *++yyvsp = yyval;
+    goto yyloop;
+yyoverflow:
+    yyerror("Out of memory for yacc stack");
+yyabort:
+    retval = 1;
+yyaccept:
+    return retval;
+}
diff --git a/gnu/usr.bin/perl/vms/perly_h.vms b/gnu/usr.bin/perl/vms/perly_h.vms
new file mode 100644
index 00000000000..c6ec3a41ad5
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/perly_h.vms
@@ -0,0 +1,69 @@
+/* Postprocessed by vms_yfix.pl 1.1 to add VMS declarations of globals */
+#define WORD 257
+#define METHOD 258
+#define FUNCMETH 259
+#define THING 260
+#define PMFUNC 261
+#define PRIVATEREF 262
+#define FUNC0SUB 263
+#define UNIOPSUB 264
+#define LSTOPSUB 265
+#define LABEL 266
+#define FORMAT 267
+#define SUB 268
+#define ANONSUB 269
+#define PACKAGE 270
+#define USE 271
+#define WHILE 272
+#define UNTIL 273
+#define IF 274
+#define UNLESS 275
+#define ELSE 276
+#define ELSIF 277
+#define CONTINUE 278
+#define FOR 279
+#define LOOPEX 280
+#define DOTDOT 281
+#define FUNC0 282
+#define FUNC1 283
+#define FUNC 284
+#define RELOP 285
+#define EQOP 286
+#define MULOP 287
+#define ADDOP 288
+#define DOLSHARP 289
+#define DO 290
+#define LOCAL 291
+#define HASHBRACK 292
+#define NOAMP 293
+#define OROP 294
+#define ANDOP 295
+#define NOTOP 296
+#define LSTOP 297
+#define ASSIGNOP 298
+#define OROR 299
+#define ANDAND 300
+#define BITOROP 301
+#define BITANDOP 302
+#define UNIOP 303
+#define SHIFTOP 304
+#define MATCHOP 305
+#define UMINUS 306
+#define REFGEN 307
+#define POWOP 308
+#define PREINC 309
+#define PREDEC 310
+#define POSTINC 311
+#define POSTDEC 312
+#define ARROW 313
+typedef union {
+    I32	ival;
+    char *pval;
+    OP *opval;
+    GV *gvval;
+} YYSTYPE;
+#ifndef vax11c
+  extern YYSTYPE yylval;
+#else
+  globalref YYSTYPE yylval;
+#endif
diff --git a/gnu/usr.bin/perl/vms/sockadapt.c b/gnu/usr.bin/perl/vms/sockadapt.c
new file mode 100644
index 00000000000..08251d6bdfe
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/sockadapt.c
@@ -0,0 +1,43 @@
+/*  sockadapt.c
+ *
+ *  Author: Charles Bailey  bailey@genetics.upenn.edu
+ *  Last Revised: 29-Jan-1996
+ *
+ *  This file should contain stubs for any of the TCP/IP functions perl5
+ *  requires which are not supported by your TCP/IP stack.  These stubs
+ *  can attempt to emulate the routine in question, or can just return
+ *  an error status or cause perl to die.
+ *
+ *  This version is set up for perl5 with socketshr 0.9D TCP/IP support.
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000)
+#  define __sockadapt_my_netent_t __struct_netent_ptr32
+#  define __sockadapt_my_addr_t   __in_addr_t
+#  define __sockadapt_my_name_t   const char *
+#else
+#  define __sockadapt_my_netent_t struct netent *
+#  define __sockadapt_my_addr_t   long
+#  define __sockadapt_my_name_t   char *
+#endif
+
+__sockadapt_my_netent_t getnetbyaddr( __sockadapt_my_addr_t net, int type) {
+  croak("Function \"getnetbyaddr\" not implemented in this version of perl");
+  return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
+}
+__sockadapt_my_netent_t getnetbyname( __sockadapt_my_name_t name) {
+  croak("Function \"getnetbyname\" not implemented in this version of perl");
+  return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
+}
+__sockadapt_my_netent_t getnetent() {
+  croak("Function \"getnetent\" not implemented in this version of perl");
+  return (struct netent *)NULL; /* Avoid MISSINGRETURN warning, not reached */
+}
+void setnetent() {
+  croak("Function \"setnetent\" not implemented in this version of perl");
+}
+void endnetent() {
+  croak("Function \"endnetent\" not implemented in this version of perl");
+}
diff --git a/gnu/usr.bin/perl/vms/sockadapt.h b/gnu/usr.bin/perl/vms/sockadapt.h
new file mode 100644
index 00000000000..18f4002f127
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/sockadapt.h
@@ -0,0 +1,142 @@
+/*  sockadapt.h
+ *
+ *  Authors: Charles Bailey  bailey@genetics.upenn.edu
+ *           David Denholm  denholm@conmat.phys.soton.ac.uk
+ *  Last Revised: 17-Mar-1995
+ *
+ *  This file should include any other header files and procide any
+ *  declarations, typedefs, and prototypes needed by perl for TCP/IP
+ *  operations.
+ *
+ *  This version is set up for perl5 with socketshr 0.9D TCP/IP support.
+ */
+
+/* SocketShr doesn't support these routines, but the DECC RTL contains
+ * stubs with these names, designed to be used with the UCX socket
+ * library.  We avoid linker collisions by substituting new names.
+ */
+#define getnetbyaddr no_getnetbyaddr
+#define getnetbyname no_getnetbyname
+#define getnetent    no_getnetent
+#define setnetent    no_setnetent
+#define endnetent    no_endnetent
+
+
+#ifdef __GNU_CC__
+
+/* we may not have netdb.h etc, so lets just do this here  - div */
+/* no harm doing this for all .c files - needed only by pp_sys.c */
+
+struct	hostent {
+    char	*h_name;	/* official name of host */
+    char	**h_aliases;	/* alias list */
+    int	h_addrtype;	/* host address type */
+    int	h_length;	/* length of address */
+    char	**h_addr_list;	/* address */
+};
+#ifdef h_addr
+#   undef h_addr
+#endif
+#define h_addr h_addr_list[0]
+
+struct	protoent {
+    char	*p_name;	/* official protocol name */
+    char	**p_aliases;	/* alias list */
+    int	p_proto;	/* protocol # */
+};
+
+struct	servent {
+    char	*s_name;	/* official service name */
+    char	**s_aliases;	/* alias list */
+    int	s_port;		/* port # */
+    char	*s_proto;	/* protocol to use */
+};
+
+struct	in_addr {
+    unsigned long s_addr;
+};
+
+struct	sockaddr {
+    unsigned short	sa_family;		/* address family */
+    char	sa_data[14];		/* up to 14 bytes of direct address */
+};
+
+/*
+ * Socket address, internet style.
+ */
+struct sockaddr_in {
+	short	sin_family;
+	unsigned short	sin_port;
+	struct	in_addr sin_addr;
+	char	sin_zero[8];
+};
+
+struct timeval {
+    long tv_sec;
+    long tv_usec;
+};
+
+struct netent {
+	char *n_name;
+	char **n_aliases;
+	int n_addrtype;
+	long n_net;
+};
+
+/* Since socketshr.h won't declare function prototypes unless it thinks
+ * the system headers have already been included, we convince it that
+ * this is the case.
+ */
+
+#ifndef AF_INET
+#  define AF_INET 2
+#endif
+#ifndef IPPROTO_TCP
+#  define IPPROTO_TCP 6
+#endif
+#ifndef __INET_LOADED
+#  define __INET_LOADED
+#endif
+#ifndef __NETDB_LOADED
+#  define __NETDB_LOADED
+#endif
+
+/* Finally, we provide prototypes for routines not supported by SocketShr,
+ * so that the stubs in sockadapt.c won't cause complaints about
+ * undeclared routines.
+ */
+
+struct netent *getnetbyaddr( long net, int type);
+struct netent *getnetbyname( char *name);
+struct netent *getnetent();
+void setnetent();
+void endnetent();
+
+#else /* !__GNU_CC__ */
+
+/* DECC and VAXC have socket headers in the system set; they're for UCX, but
+ * we'll assume that the actual calling sequence is identical across the
+ * various TCP/IP stacks; these routines are pretty standard.
+ */
+#include <socket.h>
+#include <in.h>
+#include <inet.h>
+#include <netdb.h>
+/* However, we don't have these two in the system headers. */
+void setnetent();
+void endnetent();
+
+#endif
+
+#include <socketshr.h>
+/* socketshr.h from SocketShr 0.9D doesn't alias fileno; it's comments say
+ * that the CRTL version works OK.  This isn't the case, at least with
+ * VAXC, so we use the SocketShr version.
+ * N.B. This means that sockadapt.h must be included *after* stdio.h.
+ *      This is presently the case for Perl.
+ */
+#ifdef fileno
+#  undef fileno
+#endif
+#define fileno si_fileno
+int si_fileno(FILE *);
diff --git a/gnu/usr.bin/perl/vms/test.com b/gnu/usr.bin/perl/vms/test.com
new file mode 100644
index 00000000000..05ff0bba6c7
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/test.com
@@ -0,0 +1,199 @@
+$!  Test.Com - DCL driver for perl5 regression tests
+$!
+$!  Version 1.1   4-Dec-1995
+$!  Charles Bailey  bailey@genetics.upenn.edu
+$
+$!  A little basic setup
+$   On Error Then Goto wrapup
+$   olddef = F$Environment("Default")
+$   If F$Search("t.dir").nes.""
+$   Then
+$       Set Default [.t]
+$   Else
+$       If F$TrnLNm("Perl_Root").nes.""
+$       Then 
+$           Set Default Perl_Root:[t]
+$       Else
+$           Write Sys$Error "Can't find test directory"
+$           Exit 44
+$       EndIf
+$   EndIf
+$
+$!  Pick up a copy of perl to use for the tests
+$   Delete/Log/NoConfirm Perl.;*
+$   Copy/Log/NoConfirm [-]Perl.Exe []Perl.
+$
+$!  Make the environment look a little friendlier to tests which assume Unix
+$   cat = "Type"
+$   Macro/NoDebug/Object=Echo.Obj Sys$Input
+		.title echo
+		.psect data,wrt,noexe
+	dsc:
+		.word 0
+		.byte 14 ; DSC$K_DTYPE_T
+		.byte 2  ; DSC$K_CLASS_D
+		.long 0
+		.psect code,nowrt,exe
+		.entry	echo,^m<r2,r3>
+		movab	dsc,r2
+		pushab	(r2)
+		calls	#1,G^LIB$GET_FOREIGN
+		movl	4(r2),r3
+		movzwl	(r2),r0
+		addl2	4(r2),r0
+		cmpl	r3,r0
+		bgtru	sym.3
+		nop	
+	sym.1:
+		movb	(r3),r0
+		cmpb	r0,#65
+		blss	sym.2
+		cmpb	r0,#90
+		bgtr	sym.2
+		cvtbl	r0,r0
+		addl2	#32,r0
+		cvtlb	r0,(r3)
+	sym.2:
+		incl	r3
+		movzwl	(r2),r0
+		addl2	4(r2),r0
+		cmpl	r3,r0
+		blequ	sym.1
+	sym.3:
+		pushab	(r2)
+		calls	#1,G^LIB$PUT_OUTPUT
+		movl	#1,r0
+		ret	
+		.end echo
+$   Link/NoTrace Echo.Obj;
+$   Delete/Log/NoConfirm Echo.Obj;*
+$   echo = "$" + F$Parse("Echo.Exe")
+$
+$!  And do it
+$   testdir = "Directory/NoHead/NoTrail/Column=1"
+$   Define/User Perlshr Sys$Disk:[-]PerlShr.Exe
+$   MCR Sys$Disk:[]Perl. "''p1'" "''p2'" "''p3'" "''p4'" "''p5'" "''p6'"
+$   Deck/Dollar=$$END-OF-TEST$$
+# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $
+# Modified for VMS 30-Sep-1994  Charles Bailey  bailey@genetics.upenn.edu
+#
+# This is written in a peculiar style, since we're trying to avoid
+# most of the constructs we'll be testing for.
+
+# skip those tests we know will fail entirely or cause perl to hang bacause
+# of Unixisms
+@compexcl=('cpp.t','script.t');
+@ioexcl=('argv.t','dup.t','fs.t','inplace.t','pipe.t');
+@libexcl=('anydbm.t','db-btree.t','db-hash.t','db-recno.t',
+          'gdbm.t','ndbm.t','odbm.t','sdbm.t','posix.t','soundex.t');
+@opexcl=('exec.t','fork.t','glob.t','magic.t','misc.t','stat.t');
+@exclist=(@compexcl,@ioexcl,@libexcl,@opexcl);
+foreach $file (@exclist) { $skip{$file}++; }
+
+$| = 1;
+
+@ARGV = grep($_,@ARGV);  # remove empty elements due to "''p1'" syntax
+
+if ($ARGV[0] eq '-v') {
+    $verbose = 1;
+    shift;
+}
+
+chdir 't' if -f 't/TEST';
+
+if ($ARGV[0] eq '') {
+    foreach (<[.*]*.t>) {
+      s/.*[\[.]t./[./;
+      ($fname = $_) =~ s/.*\]//;
+      if ($skip{"\L$fname"}) { push(@skipped,$_); }
+      else { push(@ARGV,$_); }
+    }
+}
+
+if (@skipped) {
+  print "The following tests were skipped because they rely extensively on\n";
+  print " Unixisms not compatible with the current version of perl for VMS:\n";
+  print "\t",join("\n\t",@skipped),"\n\n";
+}
+
+$bad = 0;
+$good = 0;
+$total = @ARGV;
+while ($test = shift) {
+    if ($test =~ /^$/) {
+	next;
+    }
+    $te = $test;
+    chop($te);
+    $te .= '.' x (24 - length($te));
+	open(script,"$test") || die "Can't run $test.\n";
+	$_ = <script>;
+	close(script);
+	if (/#!..perl(.*)/) {
+	    $switch = $1;
+	} else {
+	    $switch = '';
+	}
+	open(results,"\$ MCR Sys\$Disk:[]Perl. $switch $test |") || (print "can't run.\n");
+    $ok = 0;
+    $next = 0;
+    while (<results>) {
+	if ($verbose) {
+	    print "$te$_";
+	    $te = '';
+	}
+	unless (/^#/) {
+	    if (/^1\.\.([0-9]+)/) {
+		$max = $1;
+		$totmax += $max;
+		$files += 1;
+		$next = 1;
+		$ok = 1;
+	    } else {
+		$next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+		next if /^\s*$/; # our 'echo' substitute produces one more \n than Unix'
+		if (/^ok (.*)/ && $1 == $next) {
+		    $next = $next + 1;
+		} else {
+		    $ok = 0;
+		}
+	    }
+	}
+    }
+    $next = $next - 1;
+    if ($ok && $next == $max) {
+	print "${te}ok\n";
+	$good = $good + 1;
+    } else {
+	$next += 1;
+	print "${te}FAILED on test $next\n";
+	$bad = $bad + 1;
+	$_ = $test;
+	if (/^base/) {
+	    die "Failed a basic test--cannot continue.\n";
+	}
+    }
+}
+
+if ($bad == 0) {
+    if ($ok) {
+	print "All tests successful.\n";
+    } else {
+	die "FAILED--no tests were run for some reason.\n";
+    }
+} else {
+    $pct = sprintf("%.2f", $good / $total * 100);
+    if ($bad == 1) {
+	warn "Failed 1 test, $pct% okay.\n";
+    } else {
+	warn "Failed $bad/$total tests, $pct% okay.\n";
+    }
+}
+($user,$sys,$cuser,$csys) = times;
+print sprintf("u=%g  s=%g  cu=%g  cs=%g  files=%d  tests=%d\n",
+    $user,$sys,$cuser,$csys,$files,$totmax);
+$$END-OF-TEST$$
+$ wrapup:
+$   If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;*
+$   Set Default &olddef
+$   Exit
diff --git a/gnu/usr.bin/perl/vms/vms.c b/gnu/usr.bin/perl/vms/vms.c
new file mode 100644
index 00000000000..150747f52d2
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/vms.c
@@ -0,0 +1,3639 @@
+/* vms.c
+ *
+ * VMS-specific routines for perl5
+ *
+ * Last revised: 21-Jun-1996 by Charles Bailey  bailey@genetics.upenn.edu
+ * Version: 5.2.2
+ */
+
+#include <acedef.h>
+#include <acldef.h>
+#include <armdef.h>
+#include <atrdef.h>
+#include <chpdef.h>
+#include <climsgdef.h>
+#include <descrip.h>
+#include <dvidef.h>
+#include <fibdef.h>
+#include <float.h>
+#include <fscndef.h>
+#include <iodef.h>
+#include <jpidef.h>
+#include <libdef.h>
+#include <lib$routines.h>
+#include <lnmdef.h>
+#include <prvdef.h>
+#include <psldef.h>
+#include <rms.h>
+#include <shrdef.h>
+#include <ssdef.h>
+#include <starlet.h>
+#include <stsdef.h>
+#include <syidef.h>
+#include <uaidef.h>
+#include <uicdef.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+/* gcc's header files don't #define direct access macros
+ * corresponding to VAXC's variant structs */
+#ifdef __GNUC__
+#  define uic$v_format uic$r_uic_form.uic$v_format
+#  define uic$v_group uic$r_uic_form.uic$v_group
+#  define uic$v_member uic$r_uic_form.uic$v_member
+#  define prv$v_bypass  prv$r_prvdef_bits0.prv$v_bypass
+#  define prv$v_grpprv  prv$r_prvdef_bits0.prv$v_grpprv
+#  define prv$v_readall prv$r_prvdef_bits0.prv$v_readall
+#  define prv$v_sysprv  prv$r_prvdef_bits0.prv$v_sysprv
+#endif
+
+
+struct itmlst_3 {
+  unsigned short int buflen;
+  unsigned short int itmcode;
+  void *bufadr;
+  unsigned short int *retlen;
+};
+
+static char *__mystrtolower(char *str)
+{
+  if (str) for (; *str; ++str) *str= tolower(*str);
+  return str;
+}
+
+int
+my_trnlnm(char *lnm, char *eqv, unsigned long int idx)
+{
+    static char __my_trnlnm_eqv[LNM$C_NAMLENGTH+1];
+    unsigned short int eqvlen;
+    unsigned long int retsts, attr = LNM$M_CASE_BLIND;
+    $DESCRIPTOR(tabdsc,"LNM$FILE_DEV");
+    struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
+    struct itmlst_3 lnmlst[3] = {{sizeof idx,      LNM$_INDEX,  &idx, 0},
+                                 {LNM$C_NAMLENGTH, LNM$_STRING, 0,    &eqvlen},
+                                 {0, 0, 0, 0}};
+
+    if (!eqv) eqv = __my_trnlnm_eqv;
+    lnmlst[1].bufadr = (void *)eqv;
+    lnmdsc.dsc$a_pointer = lnm;
+    lnmdsc.dsc$w_length = strlen(lnm);
+    retsts = sys$trnlnm(&attr,&tabdsc,&lnmdsc,0,lnmlst);
+    if (retsts == SS$_NOLOGNAM || retsts == SS$_IVLOGNAM) {
+      set_vaxc_errno(retsts); set_errno(EINVAL); return 0;
+    }
+    else if (retsts & 1) {
+      eqv[eqvlen] = '\0';
+      return 1;
+    }
+    _ckvmssts(retsts);  /* Must be an error */
+    return 0;      /* Not reached, assuming _ckvmssts() bails out */
+
+}  /* end of my_trnlnm */
+
+/* my_getenv
+ * Translate a logical name.  Substitute for CRTL getenv() to avoid
+ * memory leak, and to keep my_getenv() and my_setenv() in the same
+ * domain (mostly - my_getenv() need not return a translation from
+ * the process logical name table)
+ *
+ * Note: Uses static buffer -- not thread-safe!
+ */
+/*{{{ char *my_getenv(char *lnm)*/
+char *
+my_getenv(char *lnm)
+{
+    static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
+    char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+    unsigned long int idx = 0;
+
+    for (cp1 = lnm, cp2= uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
+    *cp2 = '\0';
+    if (cp1 - lnm == 7 && !strncmp(uplnm,"DEFAULT",7)) {
+      getcwd(__my_getenv_eqv,sizeof __my_getenv_eqv);
+      return __my_getenv_eqv;
+    }
+    else {
+      if ((cp2 = strchr(uplnm,';')) != NULL) {
+        *cp2 = '\0';
+        idx = strtoul(cp2+1,NULL,0);
+      }
+      if (my_trnlnm(uplnm,__my_getenv_eqv,idx)) {
+        return __my_getenv_eqv;
+      }
+      else {
+        unsigned long int retsts;
+        struct dsc$descriptor_s symdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
+                                valdsc = {sizeof __my_getenv_eqv,DSC$K_DTYPE_T,
+                                          DSC$K_CLASS_S, __my_getenv_eqv};
+        symdsc.dsc$w_length = cp1 - lnm;
+        symdsc.dsc$a_pointer = uplnm;
+        retsts = lib$get_symbol(&symdsc,&valdsc,&(valdsc.dsc$w_length),0);
+        if (retsts == LIB$_INVSYMNAM) return Nullch;
+        if (retsts != LIB$_NOSUCHSYM) {
+          /* We want to return only logical names or CRTL Unix emulations */
+          if (retsts & 1) return Nullch;
+          _ckvmssts(retsts);
+        }
+        /* Try for CRTL emulation of a Unix/POSIX name */
+        else return getenv(lnm);
+      }
+    }
+    return Nullch;
+
+}  /* end of my_getenv() */
+/*}}}*/
+
+/*{{{ void  my_setenv(char *lnm, char *eqv)*/
+void
+my_setenv(char *lnm,char *eqv)
+/* Define a supervisor-mode logical name in the process table.
+ * In the future we'll add tables, attribs, and acmodes,
+ * probably through a different call.
+ */
+{
+    char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
+    unsigned long int retsts, usermode = PSL$C_USER;
+    $DESCRIPTOR(tabdsc,"LNM$PROCESS");
+    struct dsc$descriptor_s lnmdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,uplnm},
+                            eqvdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
+
+    for(cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) *cp2 = _toupper(*cp1);
+    lnmdsc.dsc$w_length = cp1 - lnm;
+
+    if (!eqv || !*eqv) {  /* we're deleting a logical name */
+      retsts = sys$dellnm(&tabdsc,&lnmdsc,&usermode); /* try user mode first */
+      if (retsts == SS$_IVLOGNAM) return;
+      if (retsts != SS$_NOLOGNAM) _ckvmssts(retsts);
+      if (!(retsts & 1)) {
+        retsts = lib$delete_logical(&lnmdsc,&tabdsc); /* then supervisor mode */
+        if (retsts != SS$_NOLOGNAM) _ckvmssts(retsts);
+      }
+    }
+    else {
+      eqvdsc.dsc$w_length = strlen(eqv);
+      eqvdsc.dsc$a_pointer = eqv;
+
+      _ckvmssts(lib$set_logical(&lnmdsc,&eqvdsc,&tabdsc,0,0));
+    }
+
+}  /* end of my_setenv() */
+/*}}}*/
+
+
+/*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/
+/* my_crypt - VMS password hashing
+ * my_crypt() provides an interface compatible with the Unix crypt()
+ * C library function, and uses sys$hash_password() to perform VMS
+ * password hashing.  The quadword hashed password value is returned
+ * as a NUL-terminated 8 character string.  my_crypt() does not change
+ * the case of its string arguments; in order to match the behavior
+ * of LOGINOUT et al., alphabetic characters in both arguments must
+ *  be upcased by the caller.
+ */
+char *
+my_crypt(const char *textpasswd, const char *usrname)
+{
+#   ifndef UAI$C_PREFERRED_ALGORITHM
+#     define UAI$C_PREFERRED_ALGORITHM 127
+#   endif
+    unsigned char alg = UAI$C_PREFERRED_ALGORITHM;
+    unsigned short int salt = 0;
+    unsigned long int sts;
+    struct const_dsc {
+        unsigned short int dsc$w_length;
+        unsigned char      dsc$b_type;
+        unsigned char      dsc$b_class;
+        const char *       dsc$a_pointer;
+    }  usrdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+       txtdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    struct itmlst_3 uailst[3] = {
+        { sizeof alg,  UAI$_ENCRYPT, &alg, 0},
+        { sizeof salt, UAI$_SALT,    &salt, 0},
+        { 0,           0,            NULL,  NULL}};
+    static char hash[9];
+
+    usrdsc.dsc$w_length = strlen(usrname);
+    usrdsc.dsc$a_pointer = usrname;
+    if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) {
+      switch (sts) {
+        case SS$_NOGRPPRV:
+        case SS$_NOSYSPRV:
+          set_errno(EACCES);
+          break;
+        case RMS$_RNF:
+          set_errno(ESRCH);  /* There isn't a Unix no-such-user error */
+          break;
+        default:
+          set_errno(EVMSERR);
+      }
+      set_vaxc_errno(sts);
+      if (sts != RMS$_RNF) return NULL;
+    }
+
+    txtdsc.dsc$w_length = strlen(textpasswd);
+    txtdsc.dsc$a_pointer = textpasswd;
+    if (!((sts = sys$hash_password(&txtdsc, alg, salt, &usrdsc, &hash)) & 1)) {
+      set_errno(EVMSERR);  set_vaxc_errno(sts);  return NULL;
+    }
+
+    return (char *) hash;
+
+}  /* end of my_crypt() */
+/*}}}*/
+
+
+static char *do_fileify_dirspec(char *, char *, int);
+static char *do_tovmsspec(char *, char *, int);
+
+/*{{{int do_rmdir(char *name)*/
+int
+do_rmdir(char *name)
+{
+    char dirfile[NAM$C_MAXRSS+1];
+    int retval;
+    struct stat st;
+
+    if (do_fileify_dirspec(name,dirfile,0) == NULL) return -1;
+    if (flex_stat(dirfile,&st) || !S_ISDIR(st.st_mode)) retval = -1;
+    else retval = kill_file(dirfile);
+    return retval;
+
+}  /* end of do_rmdir */
+/*}}}*/
+
+/* kill_file
+ * Delete any file to which user has control access, regardless of whether
+ * delete access is explicitly allowed.
+ * Limitations: User must have write access to parent directory.
+ *              Does not block signals or ASTs; if interrupted in midstream
+ *              may leave file with an altered ACL.
+ * HANDLE WITH CARE!
+ */
+/*{{{int kill_file(char *name)*/
+int
+kill_file(char *name)
+{
+    char vmsname[NAM$C_MAXRSS+1];
+    unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE;
+    unsigned long int cxt = 0, aclsts, fndsts, rmsts = -1;
+    struct dsc$descriptor_s fildsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+    struct myacedef {
+      unsigned char myace$b_length;
+      unsigned char myace$b_type;
+      unsigned short int myace$w_flags;
+      unsigned long int myace$l_access;
+      unsigned long int myace$l_ident;
+    } newace = { sizeof(struct myacedef), ACE$C_KEYID, 0,
+                 ACE$M_READ | ACE$M_WRITE | ACE$M_DELETE | ACE$M_CONTROL, 0},
+      oldace = { sizeof(struct myacedef), ACE$C_KEYID, 0, 0, 0};
+     struct itmlst_3
+       findlst[3] = {{sizeof oldace, ACL$C_FNDACLENT, &oldace, 0},
+                     {sizeof oldace, ACL$C_READACE,   &oldace, 0},{0,0,0,0}},
+       addlst[2] = {{sizeof newace, ACL$C_ADDACLENT, &newace, 0},{0,0,0,0}},
+       dellst[2] = {{sizeof newace, ACL$C_DELACLENT, &newace, 0},{0,0,0,0}},
+       lcklst[2] = {{sizeof newace, ACL$C_WLOCK_ACL, &newace, 0},{0,0,0,0}},
+       ulklst[2] = {{sizeof newace, ACL$C_UNLOCK_ACL, &newace, 0},{0,0,0,0}};
+      
+    if (!remove(name)) return 0;  /* Can we just get rid of it? */
+
+    /* No, so we get our own UIC to use as a rights identifier,
+     * and the insert an ACE at the head of the ACL which allows us
+     * to delete the file.
+     */
+    _ckvmssts(lib$getjpi(&jpicode,0,0,&(oldace.myace$l_ident),0,0));
+    if (do_tovmsspec(name,vmsname,0) == NULL) return -1;
+    fildsc.dsc$w_length = strlen(vmsname);
+    fildsc.dsc$a_pointer = vmsname;
+    cxt = 0;
+    newace.myace$l_ident = oldace.myace$l_ident;
+    if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) {
+      set_errno(EVMSERR);
+      set_vaxc_errno(aclsts);
+      return -1;
+    }
+    /* Grab any existing ACEs with this identifier in case we fail */
+    aclsts = fndsts = sys$change_acl(0,&type,&fildsc,findlst,0,0,&cxt);
+    if ( fndsts & 1 || fndsts == SS$_ACLEMPTY || fndsts == SS$_NOENTRY
+                    || fndsts == SS$_NOMOREACE ) {
+      /* Add the new ACE . . . */
+      if (!((aclsts = sys$change_acl(0,&type,&fildsc,addlst,0,0,0)) & 1))
+        goto yourroom;
+      if ((rmsts = remove(name))) {
+        /* We blew it - dir with files in it, no write priv for
+         * parent directory, etc.  Put things back the way they were. */
+        if (!((aclsts = sys$change_acl(0,&type,&fildsc,dellst,0,0,0)) & 1))
+          goto yourroom;
+        if (fndsts & 1) {
+          addlst[0].bufadr = &oldace;
+          if (!((aclsts = sys$change_acl(0,&type,&fildsc,addlst,0,0,&cxt)) & 1))
+            goto yourroom;
+        }
+      }
+    }
+
+    yourroom:
+    if (rmsts) {
+      fndsts = sys$change_acl(0,&type,&fildsc,ulklst,0,0,0);
+      if (aclsts & 1) aclsts = fndsts;
+    }
+    if (!(aclsts & 1)) {
+      set_errno(EVMSERR);
+      set_vaxc_errno(aclsts);
+      return -1;
+    }
+
+    return rmsts;
+
+}  /* end of kill_file() */
+/*}}}*/
+
+/* my_utime - update modification time of a file
+ * calling sequence is identical to POSIX utime(), but under
+ * VMS only the modification time is changed; ODS-2 does not
+ * maintain access times.  Restrictions differ from the POSIX
+ * definition in that the time can be changed as long as the
+ * caller has permission to execute the necessary IO$_MODIFY $QIO;
+ * no separate checks are made to insure that the caller is the
+ * owner of the file or has special privs enabled.
+ * Code here is based on Joe Meadows' FILE utility.
+ */
+
+/* Adjustment from Unix epoch (01-JAN-1970 00:00:00.00)
+ *              to VMS epoch  (01-JAN-1858 00:00:00.00)
+ * in 100 ns intervals.
+ */
+static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
+
+/*{{{int my_utime(char *path, struct utimbuf *utimes)*/
+int my_utime(char *file, struct utimbuf *utimes)
+{
+  register int i;
+  long int bintime[2], len = 2, lowbit, unixtime,
+           secscale = 10000000; /* seconds --> 100 ns intervals */
+  unsigned long int chan, iosb[2], retsts;
+  char vmsspec[NAM$C_MAXRSS+1], rsa[NAM$C_MAXRSS], esa[NAM$C_MAXRSS];
+  struct FAB myfab = cc$rms_fab;
+  struct NAM mynam = cc$rms_nam;
+#if defined (__DECC) && defined (__VAX)
+  /* VAX DEC C atrdef.h has unsigned type for pointer member atr$l_addr,
+   * at least through VMS V6.1, which causes a type-conversion warning.
+   */
+#  pragma message save
+#  pragma message disable cvtdiftypes
+#endif
+  struct atrdef myatr[2] = {{sizeof bintime, ATR$C_REVDATE, bintime}, {0,0,0}};
+  struct fibdef myfib;
+#if defined (__DECC) && defined (__VAX)
+  /* This should be right after the declaration of myatr, but due
+   * to a bug in VAX DEC C, this takes effect a statement early.
+   */
+#  pragma message restore
+#endif
+  struct dsc$descriptor fibdsc = {sizeof(myfib), DSC$K_DTYPE_Z, DSC$K_CLASS_S,(char *) &myfib},
+                        devdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0},
+                        fnmdsc = {0,DSC$K_DTYPE_T, DSC$K_CLASS_S,0};
+
+  if (file == NULL || *file == '\0') {
+    set_errno(ENOENT);
+    set_vaxc_errno(LIB$_INVARG);
+    return -1;
+  }
+  if (do_tovmsspec(file,vmsspec,0) == NULL) return -1;
+
+  if (utimes != NULL) {
+    /* Convert Unix time    (seconds since 01-JAN-1970 00:00:00.00)
+     * to VMS quadword time (100 nsec intervals since 01-JAN-1858 00:00:00.00).
+     * Since time_t is unsigned long int, and lib$emul takes a signed long int
+     * as input, we force the sign bit to be clear by shifting unixtime right
+     * one bit, then multiplying by an extra factor of 2 in lib$emul().
+     */
+    lowbit = (utimes->modtime & 1) ? secscale : 0;
+    unixtime = (long int) utimes->modtime;
+    unixtime >> 1;  secscale << 1;
+    retsts = lib$emul(&secscale, &unixtime, &lowbit, bintime);
+    if (!(retsts & 1)) {
+      set_errno(EVMSERR);
+      set_vaxc_errno(retsts);
+      return -1;
+    }
+    retsts = lib$addx(bintime,utime_baseadjust,bintime,&len);
+    if (!(retsts & 1)) {
+      set_errno(EVMSERR);
+      set_vaxc_errno(retsts);
+      return -1;
+    }
+  }
+  else {
+    /* Just get the current time in VMS format directly */
+    retsts = sys$gettim(bintime);
+    if (!(retsts & 1)) {
+      set_errno(EVMSERR);
+      set_vaxc_errno(retsts);
+      return -1;
+    }
+  }
+
+  myfab.fab$l_fna = vmsspec;
+  myfab.fab$b_fns = (unsigned char) strlen(vmsspec);
+  myfab.fab$l_nam = &mynam;
+  mynam.nam$l_esa = esa;
+  mynam.nam$b_ess = (unsigned char) sizeof esa;
+  mynam.nam$l_rsa = rsa;
+  mynam.nam$b_rss = (unsigned char) sizeof rsa;
+
+  /* Look for the file to be affected, letting RMS parse the file
+   * specification for us as well.  I have set errno using only
+   * values documented in the utime() man page for VMS POSIX.
+   */
+  retsts = sys$parse(&myfab,0,0);
+  if (!(retsts & 1)) {
+    set_vaxc_errno(retsts);
+    if      (retsts == RMS$_PRV) set_errno(EACCES);
+    else if (retsts == RMS$_DIR) set_errno(ENOTDIR);
+    else                         set_errno(EVMSERR);
+    return -1;
+  }
+  retsts = sys$search(&myfab,0,0);
+  if (!(retsts & 1)) {
+    set_vaxc_errno(retsts);
+    if      (retsts == RMS$_PRV) set_errno(EACCES);
+    else if (retsts == RMS$_FNF) set_errno(ENOENT);
+    else                         set_errno(EVMSERR);
+    return -1;
+  }
+
+  devdsc.dsc$w_length = mynam.nam$b_dev;
+  devdsc.dsc$a_pointer = (char *) mynam.nam$l_dev;
+
+  retsts = sys$assign(&devdsc,&chan,0,0);
+  if (!(retsts & 1)) {
+    set_vaxc_errno(retsts);
+    if      (retsts == SS$_IVDEVNAM)   set_errno(ENOTDIR);
+    else if (retsts == SS$_NOPRIV)     set_errno(EACCES);
+    else if (retsts == SS$_NOSUCHDEV)  set_errno(ENOTDIR);
+    else                               set_errno(EVMSERR);
+    return -1;
+  }
+
+  fnmdsc.dsc$a_pointer = mynam.nam$l_name;
+  fnmdsc.dsc$w_length = mynam.nam$b_name + mynam.nam$b_type + mynam.nam$b_ver;
+
+  memset((void *) &myfib, 0, sizeof myfib);
+#ifdef __DECC
+  for (i=0;i<3;i++) myfib.fib$w_fid[i] = mynam.nam$w_fid[i];
+  for (i=0;i<3;i++) myfib.fib$w_did[i] = mynam.nam$w_did[i];
+  /* This prevents the revision time of the file being reset to the current
+   * time as a result of our IO$_MODIFY $QIO. */
+  myfib.fib$l_acctl = FIB$M_NORECORD;
+#else
+  for (i=0;i<3;i++) myfib.fib$r_fid_overlay.fib$w_fid[i] = mynam.nam$w_fid[i];
+  for (i=0;i<3;i++) myfib.fib$r_did_overlay.fib$w_did[i] = mynam.nam$w_did[i];
+  myfib.fib$r_acctl_overlay.fib$l_acctl = FIB$M_NORECORD;
+#endif
+  retsts = sys$qiow(0,chan,IO$_MODIFY,iosb,0,0,&fibdsc,&fnmdsc,0,0,myatr,0);
+  _ckvmssts(sys$dassgn(chan));
+  if (retsts & 1) retsts = iosb[0];
+  if (!(retsts & 1)) {
+    set_vaxc_errno(retsts);
+    if (retsts == SS$_NOPRIV) set_errno(EACCES);
+    else                      set_errno(EVMSERR);
+    return -1;
+  }
+
+  return 0;
+}  /* end of my_utime() */
+/*}}}*/
+
+static void
+create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
+{
+  static unsigned long int mbxbufsiz;
+  long int syiitm = SYI$_MAXBUF, dviitm = DVI$_DEVNAM;
+  
+  if (!mbxbufsiz) {
+    /*
+     * Get the SYSGEN parameter MAXBUF, and the smaller of it and the
+     * preprocessor consant BUFSIZ from stdio.h as the size of the
+     * 'pipe' mailbox.
+     */
+    _ckvmssts(lib$getsyi(&syiitm, &mbxbufsiz, 0, 0, 0, 0));
+    if (mbxbufsiz > BUFSIZ) mbxbufsiz = BUFSIZ; 
+  }
+  _ckvmssts(sys$crembx(0,chan,mbxbufsiz,mbxbufsiz,0,0,0));
+
+  _ckvmssts(lib$getdvi(&dviitm, chan, NULL, NULL, namdsc, &namdsc->dsc$w_length));
+  namdsc->dsc$a_pointer[namdsc->dsc$w_length] = '\0';
+
+}  /* end of create_mbx() */
+
+/*{{{  my_popen and my_pclose*/
+struct pipe_details
+{
+    struct pipe_details *next;
+    FILE *fp;  /* stdio file pointer to pipe mailbox */
+    int pid;   /* PID of subprocess */
+    int mode;  /* == 'r' if pipe open for reading */
+    int done;  /* subprocess has completed */
+    unsigned long int completion;  /* termination status of subprocess */
+};
+
+struct exit_control_block
+{
+    struct exit_control_block *flink;
+    unsigned long int	(*exit_routine)();
+    unsigned long int arg_count;
+    unsigned long int *status_address;
+    unsigned long int exit_status;
+}; 
+
+static struct pipe_details *open_pipes = NULL;
+static $DESCRIPTOR(nl_desc, "NL:");
+static int waitpid_asleep = 0;
+
+static unsigned long int
+pipe_exit_routine()
+{
+    unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT, sts;
+
+    while (open_pipes != NULL) {
+      if (!open_pipes->done) { /* Tap them gently on the shoulder . . .*/
+        _ckvmssts(sys$forcex(&open_pipes->pid,0,&abort));
+        sleep(1);
+      }
+      if (!open_pipes->done)  /* We tried to be nice . . . */
+        _ckvmssts(sys$delprc(&open_pipes->pid,0));
+      if (!((sts = my_pclose(open_pipes->fp))&1)) retsts = sts;
+    }
+    return retsts;
+}
+
+static struct exit_control_block pipe_exitblock = 
+       {(struct exit_control_block *) 0,
+        pipe_exit_routine, 0, &pipe_exitblock.exit_status, 0};
+
+
+static void
+popen_completion_ast(struct pipe_details *thispipe)
+{
+  thispipe->done = TRUE;
+  if (waitpid_asleep) {
+    waitpid_asleep = 0;
+    sys$wake(0,0);
+  }
+}
+
+/*{{{  FILE *my_popen(char *cmd, char *mode)*/
+FILE *
+my_popen(char *cmd, char *mode)
+{
+    static int handler_set_up = FALSE;
+    char mbxname[64];
+    unsigned short int chan;
+    unsigned long int flags=1;  /* nowait - gnu c doesn't allow &1 */
+    struct pipe_details *info;
+    struct dsc$descriptor_s namdsc = {sizeof mbxname, DSC$K_DTYPE_T,
+                                      DSC$K_CLASS_S, mbxname},
+                            cmddsc = {0, DSC$K_DTYPE_T,
+                                      DSC$K_CLASS_S, 0};
+                            
+
+    cmddsc.dsc$w_length=strlen(cmd);
+    cmddsc.dsc$a_pointer=cmd;
+    if (cmddsc.dsc$w_length > 255) {
+      set_errno(E2BIG); set_vaxc_errno(CLI$_BUFOVF);
+      return Nullfp;
+    }
+
+    New(7001,info,1,struct pipe_details);
+
+    /* create mailbox */
+    create_mbx(&chan,&namdsc);
+
+    /* open a FILE* onto it */
+    info->fp=fopen(mbxname, mode);
+
+    /* give up other channel onto it */
+    _ckvmssts(sys$dassgn(chan));
+
+    if (!info->fp)
+        return Nullfp;
+        
+    info->mode = *mode;
+    info->done = FALSE;
+    info->completion=0;
+        
+    if (*mode == 'r') {
+      _ckvmssts(lib$spawn(&cmddsc, &nl_desc, &namdsc, &flags,
+                     0  /* name */, &info->pid, &info->completion,
+                     0, popen_completion_ast,info,0,0,0));
+    }
+    else {
+      _ckvmssts(lib$spawn(&cmddsc, &namdsc, 0 /* sys$output */, &flags,
+                     0  /* name */, &info->pid, &info->completion,
+                     0, popen_completion_ast,info,0,0,0));
+    }
+
+    if (!handler_set_up) {
+      _ckvmssts(sys$dclexh(&pipe_exitblock));
+      handler_set_up = TRUE;
+    }
+    info->next=open_pipes;  /* prepend to list */
+    open_pipes=info;
+        
+    forkprocess = info->pid;
+    return info->fp;
+}
+/*}}}*/
+
+/*{{{  I32 my_pclose(FILE *fp)*/
+I32 my_pclose(FILE *fp)
+{
+    struct pipe_details *info, *last = NULL;
+    unsigned long int retsts;
+    
+    for (info = open_pipes; info != NULL; last = info, info = info->next)
+        if (info->fp == fp) break;
+
+    if (info == NULL)
+      /* get here => no such pipe open */
+      croak("No such pipe open");
+
+    fclose(info->fp);
+
+    if (info->done) retsts = info->completion;
+    else waitpid(info->pid,(int *) &retsts,0);
+
+    /* remove from list of open pipes */
+    if (last) last->next = info->next;
+    else open_pipes = info->next;
+    Safefree(info);
+
+    return retsts;
+
+}  /* end of my_pclose() */
+
+/* sort-of waitpid; use only with popen() */
+/*{{{unsigned long int waitpid(unsigned long int pid, int *statusp, int flags)*/
+unsigned long int
+waitpid(unsigned long int pid, int *statusp, int flags)
+{
+    struct pipe_details *info;
+    
+    for (info = open_pipes; info != NULL; info = info->next)
+        if (info->pid == pid) break;
+
+    if (info != NULL) {  /* we know about this child */
+      while (!info->done) {
+        waitpid_asleep = 1;
+        sys$hiber();
+      }
+
+      *statusp = info->completion;
+      return pid;
+    }
+    else {  /* we haven't heard of this child */
+      $DESCRIPTOR(intdsc,"0 00:00:01");
+      unsigned long int ownercode = JPI$_OWNER, ownerpid, mypid;
+      unsigned long int interval[2],sts;
+
+      if (dowarn) {
+        _ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
+        _ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
+        if (ownerpid != mypid)
+          warn("pid %d not a child",pid);
+      }
+
+      _ckvmssts(sys$bintim(&intdsc,interval));
+      while ((sts=lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0)) & 1) {
+        _ckvmssts(sys$schdwk(0,0,interval,0));
+        _ckvmssts(sys$hiber());
+      }
+      _ckvmssts(sts);
+
+      /* There's no easy way to find the termination status a child we're
+       * not aware of beforehand.  If we're really interested in the future,
+       * we can go looking for a termination mailbox, or chase after the
+       * accounting record for the process.
+       */
+      *statusp = 0;
+      return pid;
+    }
+                    
+}  /* end of waitpid() */
+/*}}}*/
+/*}}}*/
+/*}}}*/
+
+/*{{{ char *my_gconvert(double val, int ndig, int trail, char *buf) */
+char *
+my_gconvert(double val, int ndig, int trail, char *buf)
+{
+  static char __gcvtbuf[DBL_DIG+1];
+  char *loc;
+
+  loc = buf ? buf : __gcvtbuf;
+  if (val) {
+    if (!buf && ndig > DBL_DIG) ndig = DBL_DIG;
+    return gcvt(val,ndig,loc);
+  }
+  else {
+    loc[0] = '0'; loc[1] = '\0';
+    return loc;
+  }
+
+}
+/*}}}*/
+
+/*
+** The following routines are provided to make life easier when
+** converting among VMS-style and Unix-style directory specifications.
+** All will take input specifications in either VMS or Unix syntax. On
+** failure, all return NULL.  If successful, the routines listed below
+** return a pointer to a buffer containing the appropriately
+** reformatted spec (and, therefore, subsequent calls to that routine
+** will clobber the result), while the routines of the same names with
+** a _ts suffix appended will return a pointer to a mallocd string
+** containing the appropriately reformatted spec.
+** In all cases, only explicit syntax is altered; no check is made that
+** the resulting string is valid or that the directory in question
+** actually exists.
+**
+**   fileify_dirspec() - convert a directory spec into the name of the
+**     directory file (i.e. what you can stat() to see if it's a dir).
+**     The style (VMS or Unix) of the result is the same as the style
+**     of the parameter passed in.
+**   pathify_dirspec() - convert a directory spec into a path (i.e.
+**     what you prepend to a filename to indicate what directory it's in).
+**     The style (VMS or Unix) of the result is the same as the style
+**     of the parameter passed in.
+**   tounixpath() - convert a directory spec into a Unix-style path.
+**   tovmspath() - convert a directory spec into a VMS-style path.
+**   tounixspec() - convert any file spec into a Unix-style file spec.
+**   tovmsspec() - convert any file spec into a VMS-style spec.
+**
+** Copyright 1996 by Charles Bailey  <bailey@genetics.upenn.edu>
+** Permission is given to distribute this code as part of the Perl
+** standard distribution under the terms of the GNU General Public
+** License or the Perl Artistic License.  Copies of each may be
+** found in the Perl standard distribution.
+ */
+
+static char *do_tounixspec(char *, char *, int);
+
+/*{{{ char *fileify_dirspec[_ts](char *path, char *buf)*/
+static char *do_fileify_dirspec(char *dir,char *buf,int ts)
+{
+    static char __fileify_retbuf[NAM$C_MAXRSS+1];
+    unsigned long int dirlen, retlen, addmfd = 0;
+    char *retspec, *cp1, *cp2, *lastdir;
+    char trndir[NAM$C_MAXRSS+1], vmsdir[NAM$C_MAXRSS+1];
+
+    if (!dir || !*dir) {
+      set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
+    }
+    dirlen = strlen(dir);
+    if (dir[dirlen-1] == '/') --dirlen;
+    if (!dirlen) {
+      set_errno(ENOTDIR);
+      set_vaxc_errno(RMS$_DIR);
+      return NULL;
+    }
+    if (!strpbrk(dir+1,"/]>:")) {
+      strcpy(trndir,*dir == '/' ? dir + 1: dir);
+      while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) ;
+      dir = trndir;
+      dirlen = strlen(dir);
+    }
+    else {
+      strncpy(trndir,dir,dirlen);
+      trndir[dirlen] = '\0';
+      dir = trndir;
+    }
+    /* If we were handed a rooted logical name or spec, treat it like a
+     * simple directory, so that
+     *    $ Define myroot dev:[dir.]
+     *    ... do_fileify_dirspec("myroot",buf,1) ...
+     * does something useful.
+     */
+    if (!strcmp(dir+dirlen-2,".]")) {
+      dir[--dirlen] = '\0';
+      dir[dirlen-1] = ']';
+    }
+
+    if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */
+      if (dir[0] == '.') {
+        if (dir[1] == '\0' || (dir[1] == '/' && dir[2] == '\0'))
+          return do_fileify_dirspec("[]",buf,ts);
+        else if (dir[1] == '.' &&
+                 (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0')))
+          return do_fileify_dirspec("[-]",buf,ts);
+      }
+      if (dir[dirlen-1] == '/') {    /* path ends with '/'; just add .dir;1 */
+        dirlen -= 1;                 /* to last element */
+        lastdir = strrchr(dir,'/');
+      }
+      else if ((cp1 = strstr(dir,"/.")) != NULL) {
+        /* If we have "/." or "/..", VMSify it and let the VMS code
+         * below expand it, rather than repeating the code to handle
+         * relative components of a filespec here */
+        do {
+          if (*(cp1+2) == '.') cp1++;
+          if (*(cp1+2) == '/' || *(cp1+2) == '\0') {
+            if (do_tovmsspec(dir,vmsdir,0) == NULL) return NULL;
+            if (do_fileify_dirspec(vmsdir,trndir,0) == NULL) return NULL;
+            return do_tounixspec(trndir,buf,ts);
+          }
+          cp1++;
+        } while ((cp1 = strstr(cp1,"/.")) != NULL);
+      }
+      else {
+        if (!(lastdir = cp1 = strrchr(dir,'/'))) cp1 = dir;
+        if ((cp2 = strchr(cp1,'.'))) {  /* look for explicit type */
+          if (toupper(*(cp2+1)) == 'D' &&    /* Yep.  Is it .dir? */
+              toupper(*(cp2+2)) == 'I' &&
+              toupper(*(cp2+3)) == 'R') {
+            if ((cp1 = strchr(cp2,';')) || (cp1 = strchr(cp2+1,'.'))) {
+              if (*(cp1+1) != '1' || *(cp1+2) != '\0') { /* Version is not ;1 */
+                set_errno(ENOTDIR);                      /* Bzzt. */
+                set_vaxc_errno(RMS$_DIR);
+                return NULL;
+              }
+            }
+            dirlen = cp2 - dir;
+          }
+          else {   /* There's a type, and it's not .dir.  Bzzt. */
+            set_errno(ENOTDIR); 
+            set_vaxc_errno(RMS$_DIR);
+            return NULL;
+          }
+        }
+      }
+      /* If we lead off with a device or rooted logical, add the MFD
+         if we're specifying a top-level directory. */
+      if (lastdir && *dir == '/') {
+        addmfd = 1;
+        for (cp1 = lastdir - 1; cp1 > dir; cp1--) {
+          if (*cp1 == '/') {
+            addmfd = 0;
+            break;
+          }
+        }
+      }
+      retlen = dirlen + (addmfd ? 13 : 6);
+      if (buf) retspec = buf;
+      else if (ts) New(7009,retspec,retlen+1,char);
+      else retspec = __fileify_retbuf;
+      if (addmfd) {
+        dirlen = lastdir - dir;
+        memcpy(retspec,dir,dirlen);
+        strcpy(&retspec[dirlen],"/000000");
+        strcpy(&retspec[dirlen+7],lastdir);
+      }
+      else {
+        memcpy(retspec,dir,dirlen);
+        retspec[dirlen] = '\0';
+      }
+      /* We've picked up everything up to the directory file name.
+         Now just add the type and version, and we're set. */
+      strcat(retspec,".dir;1");
+      return retspec;
+    }
+    else {  /* VMS-style directory spec */
+      char esa[NAM$C_MAXRSS+1], term, *cp;
+      unsigned long int sts, cmplen, haslower = 0;
+      struct FAB dirfab = cc$rms_fab;
+      struct NAM savnam, dirnam = cc$rms_nam;
+
+      dirfab.fab$b_fns = strlen(dir);
+      dirfab.fab$l_fna = dir;
+      dirfab.fab$l_nam = &dirnam;
+      dirfab.fab$l_dna = ".DIR;1";
+      dirfab.fab$b_dns = 6;
+      dirnam.nam$b_ess = NAM$C_MAXRSS;
+      dirnam.nam$l_esa = esa;
+
+      for (cp = dir; *cp; cp++)
+        if (islower(*cp)) { haslower = 1; break; }
+      if (!((sts = sys$parse(&dirfab))&1)) {
+        if (dirfab.fab$l_sts == RMS$_DIR) {
+          dirnam.nam$b_nop |= NAM$M_SYNCHK;
+          sts = sys$parse(&dirfab) & 1;
+        }
+        if (!sts) {
+          set_errno(EVMSERR);
+          set_vaxc_errno(dirfab.fab$l_sts);
+          return NULL;
+        }
+      }
+      else {
+        savnam = dirnam;
+        if (sys$search(&dirfab)&1) {  /* Does the file really exist? */
+          /* Yes; fake the fnb bits so we'll check type below */
+          dirnam.nam$l_fnb |= NAM$M_EXP_TYPE | NAM$M_EXP_VER;
+        }
+        else {
+          if (dirfab.fab$l_sts != RMS$_FNF) {
+            set_errno(EVMSERR);
+            set_vaxc_errno(dirfab.fab$l_sts);
+            return NULL;
+          }
+          dirnam = savnam; /* No; just work with potential name */
+        }
+      }
+      if (!(dirnam.nam$l_fnb & (NAM$M_EXP_DEV | NAM$M_EXP_DIR))) {
+        cp1 = strchr(esa,']');
+        if (!cp1) cp1 = strchr(esa,'>');
+        if (cp1) {  /* Should always be true */
+          dirnam.nam$b_esl -= cp1 - esa - 1;
+          memcpy(esa,cp1 + 1,dirnam.nam$b_esl);
+        }
+      }
+      if (dirnam.nam$l_fnb & NAM$M_EXP_TYPE) {  /* Was type specified? */
+        /* Yep; check version while we're at it, if it's there. */
+        cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4;
+        if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { 
+          /* Something other than .DIR[;1].  Bzzt. */
+          set_errno(ENOTDIR);
+          set_vaxc_errno(RMS$_DIR);
+          return NULL;
+        }
+      }
+      esa[dirnam.nam$b_esl] = '\0';
+      if (dirnam.nam$l_fnb & NAM$M_EXP_NAME) {
+        /* They provided at least the name; we added the type, if necessary, */
+        if (buf) retspec = buf;                            /* in sys$parse() */
+        else if (ts) New(7011,retspec,dirnam.nam$b_esl+1,char);
+        else retspec = __fileify_retbuf;
+        strcpy(retspec,esa);
+        return retspec;
+      }
+      if ((cp1 = strstr(esa,".][000000]")) != NULL) {
+        for (cp2 = cp1 + 9; *cp2; cp1++,cp2++) *cp1 = *cp2;
+        *cp1 = '\0';
+        dirnam.nam$b_esl -= 9;
+      }
+      if ((cp1 = strrchr(esa,']')) == NULL) cp1 = strrchr(esa,'>');
+      if (cp1 == NULL) return NULL; /* should never happen */
+      term = *cp1;
+      *cp1 = '\0';
+      retlen = strlen(esa);
+      if ((cp1 = strrchr(esa,'.')) != NULL) {
+        /* There's more than one directory in the path.  Just roll back. */
+        *cp1 = term;
+        if (buf) retspec = buf;
+        else if (ts) New(7011,retspec,retlen+7,char);
+        else retspec = __fileify_retbuf;
+        strcpy(retspec,esa);
+      }
+      else {
+        if (dirnam.nam$l_fnb & NAM$M_ROOT_DIR) {
+          /* Go back and expand rooted logical name */
+          dirnam.nam$b_nop = NAM$M_SYNCHK | NAM$M_NOCONCEAL;
+          if (!(sys$parse(&dirfab) & 1)) {
+            set_errno(EVMSERR);
+            set_vaxc_errno(dirfab.fab$l_sts);
+            return NULL;
+          }
+          retlen = dirnam.nam$b_esl - 9; /* esa - '][' - '].DIR;1' */
+          if (buf) retspec = buf;
+          else if (ts) New(7012,retspec,retlen+16,char);
+          else retspec = __fileify_retbuf;
+          cp1 = strstr(esa,"][");
+          dirlen = cp1 - esa;
+          memcpy(retspec,esa,dirlen);
+          if (!strncmp(cp1+2,"000000]",7)) {
+            retspec[dirlen-1] = '\0';
+            for (cp1 = retspec+dirlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ;
+            if (*cp1 == '.') *cp1 = ']';
+            else {
+              memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
+              memcpy(cp1+1,"000000]",7);
+            }
+          }
+          else {
+            memcpy(retspec+dirlen,cp1+2,retlen-dirlen);
+            retspec[retlen] = '\0';
+            /* Convert last '.' to ']' */
+            for (cp1 = retspec+retlen-1; *cp1 != '.' && *cp1 != '['; cp1--) ;
+            if (*cp1 == '.') *cp1 = ']';
+            else {
+              memmove(cp1+8,cp1+1,retspec+dirlen-cp1);
+              memcpy(cp1+1,"000000]",7);
+            }
+          }
+        }
+        else {  /* This is a top-level dir.  Add the MFD to the path. */
+          if (buf) retspec = buf;
+          else if (ts) New(7012,retspec,retlen+16,char);
+          else retspec = __fileify_retbuf;
+          cp1 = esa;
+          cp2 = retspec;
+          while (*cp1 != ':') *(cp2++) = *(cp1++);
+          strcpy(cp2,":[000000]");
+          cp1 += 2;
+          strcpy(cp2+9,cp1);
+        }
+      }
+      /* We've set up the string up through the filename.  Add the
+         type and version, and we're done. */
+      strcat(retspec,".DIR;1");
+
+      /* $PARSE may have upcased filespec, so convert output to lower
+       * case if input contained any lowercase characters. */
+      if (haslower) __mystrtolower(retspec);
+      return retspec;
+    }
+}  /* end of do_fileify_dirspec() */
+/*}}}*/
+/* External entry points */
+char *fileify_dirspec(char *dir, char *buf)
+{ return do_fileify_dirspec(dir,buf,0); }
+char *fileify_dirspec_ts(char *dir, char *buf)
+{ return do_fileify_dirspec(dir,buf,1); }
+
+/*{{{ char *pathify_dirspec[_ts](char *path, char *buf)*/
+static char *do_pathify_dirspec(char *dir,char *buf, int ts)
+{
+    static char __pathify_retbuf[NAM$C_MAXRSS+1];
+    unsigned long int retlen;
+    char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1];
+
+    if (!dir || !*dir) {
+      set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
+    }
+
+    if (*dir) strcpy(trndir,dir);
+    else getcwd(trndir,sizeof trndir - 1);
+
+    while (!strpbrk(trndir,"/]:>") && my_trnlnm(trndir,trndir,0)) {
+      STRLEN trnlen = strlen(trndir);
+
+      /* Trap simple rooted lnms, and return lnm:[000000] */
+      if (!strcmp(trndir+trnlen-2,".]")) {
+        if (buf) retpath = buf;
+        else if (ts) New(7018,retpath,strlen(dir)+10,char);
+        else retpath = __pathify_retbuf;
+        strcpy(retpath,dir);
+        strcat(retpath,":[000000]");
+        return retpath;
+      }
+    }
+    dir = trndir;
+
+    if (!strpbrk(dir,"]:>")) { /* Unix-style path or plain dir name */
+      if (*dir == '.' && (*(dir+1) == '\0' ||
+                          (*(dir+1) == '.' && *(dir+2) == '\0')))
+        retlen = 2 + (*(dir+1) != '\0');
+      else {
+        if (!(cp1 = strrchr(dir,'/'))) cp1 = dir;
+        if ((cp2 = strchr(cp1,'.')) && (*(cp2+1) != '.' && *(cp2+1) != '\0')) {
+          if (toupper(*(cp2+1)) == 'D' &&  /* They specified .dir. */
+              toupper(*(cp2+2)) == 'I' &&  /* Trim it off. */
+              toupper(*(cp2+3)) == 'R') {
+            retlen = cp2 - dir + 1;
+          }
+          else {  /* Some other file type.  Bzzt. */
+            set_errno(ENOTDIR);
+            set_vaxc_errno(RMS$_DIR);
+            return NULL;
+          }
+        }
+        else {  /* No file type present.  Treat the filename as a directory. */
+          retlen = strlen(dir) + 1;
+        }
+      }
+      if (buf) retpath = buf;
+      else if (ts) New(7013,retpath,retlen+1,char);
+      else retpath = __pathify_retbuf;
+      strncpy(retpath,dir,retlen-1);
+      if (retpath[retlen-2] != '/') { /* If the path doesn't already end */
+        retpath[retlen-1] = '/';      /* with '/', add it. */
+        retpath[retlen] = '\0';
+      }
+      else retpath[retlen-1] = '\0';
+    }
+    else {  /* VMS-style directory spec */
+      char esa[NAM$C_MAXRSS+1], *cp;
+      unsigned long int sts, cmplen, haslower;
+      struct FAB dirfab = cc$rms_fab;
+      struct NAM savnam, dirnam = cc$rms_nam;
+
+      dirfab.fab$b_fns = strlen(dir);
+      dirfab.fab$l_fna = dir;
+      if (dir[dirfab.fab$b_fns-1] == ']' ||
+          dir[dirfab.fab$b_fns-1] == '>' ||
+          dir[dirfab.fab$b_fns-1] == ':') { /* It's already a VMS 'path' */
+        if (buf) retpath = buf;
+        else if (ts) New(7014,retpath,strlen(dir)+1,char);
+        else retpath = __pathify_retbuf;
+        strcpy(retpath,dir);
+        return retpath;
+      } 
+      dirfab.fab$l_dna = ".DIR;1";
+      dirfab.fab$b_dns = 6;
+      dirfab.fab$l_nam = &dirnam;
+      dirnam.nam$b_ess = (unsigned char) sizeof esa - 1;
+      dirnam.nam$l_esa = esa;
+
+      for (cp = dir; *cp; cp++)
+        if (islower(*cp)) { haslower = 1; break; }
+
+      if (!(sts = (sys$parse(&dirfab)&1))) {
+        if (dirfab.fab$l_sts == RMS$_DIR) {
+          dirnam.nam$b_nop |= NAM$M_SYNCHK;
+          sts = sys$parse(&dirfab) & 1;
+        }
+        if (!sts) {
+          set_errno(EVMSERR);
+          set_vaxc_errno(dirfab.fab$l_sts);
+          return NULL;
+        }
+      }
+      else {
+        savnam = dirnam;
+        if (!(sys$search(&dirfab)&1)) {  /* Does the file really exist? */
+          if (dirfab.fab$l_sts != RMS$_FNF) {
+            set_errno(EVMSERR);
+            set_vaxc_errno(dirfab.fab$l_sts);
+            return NULL;
+          }
+          dirnam = savnam; /* No; just work with potential name */
+        }
+      }
+      if (dirnam.nam$l_fnb & NAM$M_EXP_TYPE) {  /* Was type specified? */
+        /* Yep; check version while we're at it, if it's there. */
+        cmplen = (dirnam.nam$l_fnb & NAM$M_EXP_VER) ? 6 : 4;
+        if (strncmp(dirnam.nam$l_type,".DIR;1",cmplen)) { 
+          /* Something other than .DIR[;1].  Bzzt. */
+          set_errno(ENOTDIR);
+          set_vaxc_errno(RMS$_DIR);
+          return NULL;
+        }
+      }
+      /* OK, the type was fine.  Now pull any file name into the
+         directory path. */
+      if ((cp1 = strrchr(esa,']'))) *dirnam.nam$l_type = ']';
+      else {
+        cp1 = strrchr(esa,'>');
+        *dirnam.nam$l_type = '>';
+      }
+      *cp1 = '.';
+      *(dirnam.nam$l_type + 1) = '\0';
+      retlen = dirnam.nam$l_type - esa + 2;
+      if (buf) retpath = buf;
+      else if (ts) New(7014,retpath,retlen,char);
+      else retpath = __pathify_retbuf;
+      strcpy(retpath,esa);
+      /* $PARSE may have upcased filespec, so convert output to lower
+       * case if input contained any lowercase characters. */
+      if (haslower) __mystrtolower(retpath);
+    }
+
+    return retpath;
+}  /* end of do_pathify_dirspec() */
+/*}}}*/
+/* External entry points */
+char *pathify_dirspec(char *dir, char *buf)
+{ return do_pathify_dirspec(dir,buf,0); }
+char *pathify_dirspec_ts(char *dir, char *buf)
+{ return do_pathify_dirspec(dir,buf,1); }
+
+/*{{{ char *tounixspec[_ts](char *path, char *buf)*/
+static char *do_tounixspec(char *spec, char *buf, int ts)
+{
+  static char __tounixspec_retbuf[NAM$C_MAXRSS+1];
+  char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1];
+  int devlen, dirlen, retlen = NAM$C_MAXRSS+1, dashes = 0;
+
+  if (spec == NULL) return NULL;
+  if (strlen(spec) > NAM$C_MAXRSS) return NULL;
+  if (buf) rslt = buf;
+  else if (ts) {
+    retlen = strlen(spec);
+    cp1 = strchr(spec,'[');
+    if (!cp1) cp1 = strchr(spec,'<');
+    if (cp1) {
+      for (cp1++; *cp1 == '-'; cp1++) dashes++; /* VMS  '-' ==> Unix '../' */
+    }
+    New(7015,rslt,retlen+2+2*dashes,char);
+  }
+  else rslt = __tounixspec_retbuf;
+  if (strchr(spec,'/') != NULL) {
+    strcpy(rslt,spec);
+    return rslt;
+  }
+
+  cp1 = rslt;
+  cp2 = spec;
+  dirend = strrchr(spec,']');
+  if (dirend == NULL) dirend = strrchr(spec,'>');
+  if (dirend == NULL) dirend = strchr(spec,':');
+  if (dirend == NULL) {
+    strcpy(rslt,spec);
+    return rslt;
+  }
+  if (*cp2 != '[' && *cp2 != '<') {
+    *(cp1++) = '/';
+  }
+  else {  /* the VMS spec begins with directories */
+    cp2++;
+    if (*cp2 == ']' || *cp2 == '>') {
+      strcpy(rslt,"./");
+      return rslt;
+    }
+    else if ( *cp2 != '.' && *cp2 != '-') {
+      *(cp1++) = '/';           /* add the implied device into the Unix spec */
+      if (getcwd(tmp,sizeof tmp,1) == NULL) {
+        if (ts) Safefree(rslt);
+        return NULL;
+      }
+      do {
+        cp3 = tmp;
+        while (*cp3 != ':' && *cp3) cp3++;
+        *(cp3++) = '\0';
+        if (strchr(cp3,']') != NULL) break;
+      } while (((cp3 = my_getenv(tmp)) != NULL) && strcpy(tmp,cp3));
+      cp3 = tmp;
+      while (*cp3) *(cp1++) = *(cp3++);
+      *(cp1++) = '/';
+      if (ts &&
+          ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > retlen)) {
+        int offset = cp1 - rslt;
+
+        retlen = devlen + dirlen;
+        Renew(rslt,retlen+1+2*dashes,char);
+        cp1 = rslt + offset;
+      }
+    }
+    else if (*cp2 == '.') cp2++;
+  }
+  for (; cp2 <= dirend; cp2++) {
+    if (*cp2 == ':') {
+      *(cp1++) = '/';
+      if (*(cp2+1) == '[') cp2++;
+    }
+    else if (*cp2 == ']' || *cp2 == '>') *(cp1++) = '/';
+    else if (*cp2 == '.') {
+      *(cp1++) = '/';
+      if (*(cp2+1) == ']' || *(cp2+1) == '>') {
+        while (*(cp2+1) == ']' || *(cp2+1) == '>' ||
+               *(cp2+1) == '[' || *(cp2+1) == '<') cp2++;
+        if (!strncmp(cp2,"[000000",7) && (*(cp2+7) == ']' ||
+            *(cp2+7) == '>' || *(cp2+7) == '.')) cp2 += 7;
+      }
+    }
+    else if (*cp2 == '-') {
+      if (*(cp2-1) == '[' || *(cp2-1) == '<' || *(cp2-1) == '.') {
+        while (*cp2 == '-') {
+          cp2++;
+          *(cp1++) = '.'; *(cp1++) = '.'; *(cp1++) = '/';
+        }
+        if (*cp2 != '.' && *cp2 != ']' && *cp2 != '>') { /* we don't allow */
+          if (ts) Safefree(rslt);                        /* filespecs like */
+          set_errno(EINVAL); set_vaxc_errno(RMS$_SYN);   /* [fred.--foo.bar] */
+          return NULL;
+        }
+      }
+      else *(cp1++) = *cp2;
+    }
+    else *(cp1++) = *cp2;
+  }
+  while (*cp2) *(cp1++) = *(cp2++);
+  *cp1 = '\0';
+
+  return rslt;
+
+}  /* end of do_tounixspec() */
+/*}}}*/
+/* External entry points */
+char *tounixspec(char *spec, char *buf) { return do_tounixspec(spec,buf,0); }
+char *tounixspec_ts(char *spec, char *buf) { return do_tounixspec(spec,buf,1); }
+
+/*{{{ char *tovmsspec[_ts](char *path, char *buf)*/
+static char *do_tovmsspec(char *path, char *buf, int ts) {
+  static char __tovmsspec_retbuf[NAM$C_MAXRSS+1];
+  char *rslt, *dirend;
+  register char *cp1, *cp2;
+  unsigned long int infront = 0, hasdir = 1;
+
+  if (path == NULL) return NULL;
+  if (buf) rslt = buf;
+  else if (ts) New(7016,rslt,strlen(path)+9,char);
+  else rslt = __tovmsspec_retbuf;
+  if (strpbrk(path,"]:>") ||
+      (dirend = strrchr(path,'/')) == NULL) {
+    if (path[0] == '.') {
+      if (path[1] == '\0') strcpy(rslt,"[]");
+      else if (path[1] == '.' && path[2] == '\0') strcpy(rslt,"[-]");
+      else strcpy(rslt,path); /* probably garbage */
+    }
+    else strcpy(rslt,path);
+    return rslt;
+  }
+  if (*(dirend+1) == '.') {  /* do we have trailing "/." or "/.."? */
+    if (!*(dirend+2)) dirend +=2;
+    if (*(dirend+2) == '.' && !*(dirend+3)) dirend += 3;
+  }
+  cp1 = rslt;
+  cp2 = path;
+  if (*cp2 == '/') {
+    char trndev[NAM$C_MAXRSS+1];
+    int islnm, rooted;
+    STRLEN trnend;
+
+    while (*(++cp2) == '/') ;  /* Skip multiple /s */
+    while (*(++cp2) != '/' && *cp2) *(cp1++) = *cp2;
+    *cp1 = '\0';
+    islnm =  my_trnlnm(rslt,trndev,0);
+    trnend = islnm ? strlen(trndev) - 1 : 0;
+    islnm =  trnend ? (trndev[trnend] == ']' || trndev[trnend] == '>') : 0;
+    rooted = islnm ? (trndev[trnend-1] == '.') : 0;
+    /* If the first element of the path is a logical name, determine
+     * whether it has to be translated so we can add more directories. */
+    if (!islnm || rooted) {
+      *(cp1++) = ':';
+      *(cp1++) = '[';
+      if (cp2 == dirend) while (infront++ < 6) *(cp1++) = '0';
+      else cp2++;
+    }
+    else {
+      if (cp2 != dirend) {
+        if (!buf && ts) Renew(rslt,strlen(path)-strlen(rslt)+trnend+4,char);
+        strcpy(rslt,trndev);
+        cp1 = rslt + trnend;
+        *(cp1++) = '.';
+        cp2++;
+      }
+      else {
+        *(cp1++) = ':';
+        hasdir = 0;
+      }
+    }
+  }
+  else {
+    *(cp1++) = '[';
+    if (*cp2 == '.') {
+      if (*(cp2+1) == '/' || *(cp2+1) == '\0') {
+        cp2 += 2;         /* skip over "./" - it's redundant */
+        *(cp1++) = '.';   /* but it does indicate a relative dirspec */
+      }
+      else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) {
+        *(cp1++) = '-';                                 /* "../" --> "-" */
+        cp2 += 3;
+      }
+      if (cp2 > dirend) cp2 = dirend;
+    }
+    else *(cp1++) = '.';
+  }
+  for (; cp2 < dirend; cp2++) {
+    if (*cp2 == '/') {
+      if (*(cp2-1) == '/') continue;
+      if (*(cp1-1) != '.') *(cp1++) = '.';
+      infront = 0;
+    }
+    else if (!infront && *cp2 == '.') {
+      if (cp2+1 == dirend || *(cp2+1) == '\0') { cp2++; break; }
+      else if (*(cp2+1) == '/') cp2++;   /* skip over "./" - it's redundant */
+      else if (*(cp2+1) == '.' && (*(cp2+2) == '/' || *(cp2+2) == '\0')) {
+        if (*(cp1-1) == '-' || *(cp1-1) == '[') *(cp1++) = '-'; /* handle "../" */
+        else if (*(cp1-2) == '[') *(cp1-1) = '-';
+        else {  /* back up over previous directory name */
+          cp1--;
+          while (*(cp1-1) != '.' && *(cp1-1) != '[') cp1--;
+          if (*(cp1-1) == '[') {
+            memcpy(cp1,"000000.",7);
+            cp1 += 7;
+          }
+        }
+        cp2 += 2;
+        if (cp2 == dirend) break;
+      }
+      else *(cp1++) = '_';  /* fix up syntax - '.' in name not allowed */
+    }
+    else {
+      if (!infront && *(cp1-1) == '-')  *(cp1++) = '.';
+      if (*cp2 == '.')      *(cp1++) = '_';
+      else                  *(cp1++) =  *cp2;
+      infront = 1;
+    }
+  }
+  if (*(cp1-1) == '.') cp1--; /* Unix spec ending in '/' ==> trailing '.' */
+  if (hasdir) *(cp1++) = ']';
+  if (*cp2) cp2++;  /* check in case we ended with trailing '..' */
+  while (*cp2) *(cp1++) = *(cp2++);
+  *cp1 = '\0';
+
+  return rslt;
+
+}  /* end of do_tovmsspec() */
+/*}}}*/
+/* External entry points */
+char *tovmsspec(char *path, char *buf) { return do_tovmsspec(path,buf,0); }
+char *tovmsspec_ts(char *path, char *buf) { return do_tovmsspec(path,buf,1); }
+
+/*{{{ char *tovmspath[_ts](char *path, char *buf)*/
+static char *do_tovmspath(char *path, char *buf, int ts) {
+  static char __tovmspath_retbuf[NAM$C_MAXRSS+1];
+  int vmslen;
+  char pathified[NAM$C_MAXRSS+1], vmsified[NAM$C_MAXRSS+1], *cp;
+
+  if (path == NULL) return NULL;
+  if (do_pathify_dirspec(path,pathified,0) == NULL) return NULL;
+  if (do_tovmsspec(pathified,buf ? buf : vmsified,0) == NULL) return NULL;
+  if (buf) return buf;
+  else if (ts) {
+    vmslen = strlen(vmsified);
+    New(7017,cp,vmslen+1,char);
+    memcpy(cp,vmsified,vmslen);
+    cp[vmslen] = '\0';
+    return cp;
+  }
+  else {
+    strcpy(__tovmspath_retbuf,vmsified);
+    return __tovmspath_retbuf;
+  }
+
+}  /* end of do_tovmspath() */
+/*}}}*/
+/* External entry points */
+char *tovmspath(char *path, char *buf) { return do_tovmspath(path,buf,0); }
+char *tovmspath_ts(char *path, char *buf) { return do_tovmspath(path,buf,1); }
+
+
+/*{{{ char *tounixpath[_ts](char *path, char *buf)*/
+static char *do_tounixpath(char *path, char *buf, int ts) {
+  static char __tounixpath_retbuf[NAM$C_MAXRSS+1];
+  int unixlen;
+  char pathified[NAM$C_MAXRSS+1], unixified[NAM$C_MAXRSS+1], *cp;
+
+  if (path == NULL) return NULL;
+  if (do_pathify_dirspec(path,pathified,0) == NULL) return NULL;
+  if (do_tounixspec(pathified,buf ? buf : unixified,0) == NULL) return NULL;
+  if (buf) return buf;
+  else if (ts) {
+    unixlen = strlen(unixified);
+    New(7017,cp,unixlen+1,char);
+    memcpy(cp,unixified,unixlen);
+    cp[unixlen] = '\0';
+    return cp;
+  }
+  else {
+    strcpy(__tounixpath_retbuf,unixified);
+    return __tounixpath_retbuf;
+  }
+
+}  /* end of do_tounixpath() */
+/*}}}*/
+/* External entry points */
+char *tounixpath(char *path, char *buf) { return do_tounixpath(path,buf,0); }
+char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); }
+
+/*
+ * @(#)argproc.c 2.2 94/08/16	Mark Pizzolato (mark@infocomm.com)
+ *
+ *****************************************************************************
+ *                                                                           *
+ *  Copyright (C) 1989-1994 by                                               *
+ *  Mark Pizzolato - INFO COMM, Danville, California  (510) 837-5600         *
+ *                                                                           *
+ *  Permission is hereby  granted for the reproduction of this software,     *
+ *  on condition that this copyright notice is included in the reproduction, *
+ *  and that such reproduction is not for purposes of profit or material     *
+ *  gain.                                                                    *
+ *                                                                           *
+ *  27-Aug-1994 Modified for inclusion in perl5                              *
+ *              by Charles Bailey  bailey@genetics.upenn.edu                 *
+ *****************************************************************************
+ */
+
+/*
+ * getredirection() is intended to aid in porting C programs
+ * to VMS (Vax-11 C).  The native VMS environment does not support 
+ * '>' and '<' I/O redirection, or command line wild card expansion, 
+ * or a command line pipe mechanism using the '|' AND background 
+ * command execution '&'.  All of these capabilities are provided to any
+ * C program which calls this procedure as the first thing in the 
+ * main program.
+ * The piping mechanism will probably work with almost any 'filter' type
+ * of program.  With suitable modification, it may useful for other
+ * portability problems as well.
+ *
+ * Author:  Mark Pizzolato	mark@infocomm.com
+ */
+struct list_item
+    {
+    struct list_item *next;
+    char *value;
+    };
+
+static void add_item(struct list_item **head,
+		     struct list_item **tail,
+		     char *value,
+		     int *count);
+
+static void expand_wild_cards(char *item,
+			      struct list_item **head,
+			      struct list_item **tail,
+			      int *count);
+
+static int background_process(int argc, char **argv);
+
+static void pipe_and_fork(char **cmargv);
+
+/*{{{ void getredirection(int *ac, char ***av)*/
+void
+getredirection(int *ac, char ***av)
+/*
+ * Process vms redirection arg's.  Exit if any error is seen.
+ * If getredirection() processes an argument, it is erased
+ * from the vector.  getredirection() returns a new argc and argv value.
+ * In the event that a background command is requested (by a trailing "&"),
+ * this routine creates a background subprocess, and simply exits the program.
+ *
+ * Warning: do not try to simplify the code for vms.  The code
+ * presupposes that getredirection() is called before any data is
+ * read from stdin or written to stdout.
+ *
+ * Normal usage is as follows:
+ *
+ *	main(argc, argv)
+ *	int		argc;
+ *    	char		*argv[];
+ *	{
+ *		getredirection(&argc, &argv);
+ *	}
+ */
+{
+    int			argc = *ac;	/* Argument Count	  */
+    char		**argv = *av;	/* Argument Vector	  */
+    char		*ap;   		/* Argument pointer	  */
+    int	       		j;		/* argv[] index		  */
+    int			item_count = 0;	/* Count of Items in List */
+    struct list_item 	*list_head = 0;	/* First Item in List	    */
+    struct list_item	*list_tail;	/* Last Item in List	    */
+    char 		*in = NULL;	/* Input File Name	    */
+    char 		*out = NULL;	/* Output File Name	    */
+    char 		*outmode = "w";	/* Mode to Open Output File */
+    char 		*err = NULL;	/* Error File Name	    */
+    char 		*errmode = "w";	/* Mode to Open Error File  */
+    int			cmargc = 0;    	/* Piped Command Arg Count  */
+    char		**cmargv = NULL;/* Piped Command Arg Vector */
+
+    /*
+     * First handle the case where the last thing on the line ends with
+     * a '&'.  This indicates the desire for the command to be run in a
+     * subprocess, so we satisfy that desire.
+     */
+    ap = argv[argc-1];
+    if (0 == strcmp("&", ap))
+	exit(background_process(--argc, argv));
+    if (*ap && '&' == ap[strlen(ap)-1])
+	{
+	ap[strlen(ap)-1] = '\0';
+	exit(background_process(argc, argv));
+	}
+    /*
+     * Now we handle the general redirection cases that involve '>', '>>',
+     * '<', and pipes '|'.
+     */
+    for (j = 0; j < argc; ++j)
+	{
+	if (0 == strcmp("<", argv[j]))
+	    {
+	    if (j+1 >= argc)
+		{
+		fprintf(stderr,"No input file after < on command line");
+		exit(LIB$_WRONUMARG);
+		}
+	    in = argv[++j];
+	    continue;
+	    }
+	if ('<' == *(ap = argv[j]))
+	    {
+	    in = 1 + ap;
+	    continue;
+	    }
+	if (0 == strcmp(">", ap))
+	    {
+	    if (j+1 >= argc)
+		{
+		fprintf(stderr,"No output file after > on command line");
+		exit(LIB$_WRONUMARG);
+		}
+	    out = argv[++j];
+	    continue;
+	    }
+	if ('>' == *ap)
+	    {
+	    if ('>' == ap[1])
+		{
+		outmode = "a";
+		if ('\0' == ap[2])
+		    out = argv[++j];
+		else
+		    out = 2 + ap;
+		}
+	    else
+		out = 1 + ap;
+	    if (j >= argc)
+		{
+		fprintf(stderr,"No output file after > or >> on command line");
+		exit(LIB$_WRONUMARG);
+		}
+	    continue;
+	    }
+	if (('2' == *ap) && ('>' == ap[1]))
+	    {
+	    if ('>' == ap[2])
+		{
+		errmode = "a";
+		if ('\0' == ap[3])
+		    err = argv[++j];
+		else
+		    err = 3 + ap;
+		}
+	    else
+		if ('\0' == ap[2])
+		    err = argv[++j];
+		else
+		    err = 2 + ap;
+	    if (j >= argc)
+		{
+		fprintf(stderr,"No output file after 2> or 2>> on command line");
+		exit(LIB$_WRONUMARG);
+		}
+	    continue;
+	    }
+	if (0 == strcmp("|", argv[j]))
+	    {
+	    if (j+1 >= argc)
+		{
+		fprintf(stderr,"No command into which to pipe on command line");
+		exit(LIB$_WRONUMARG);
+		}
+	    cmargc = argc-(j+1);
+	    cmargv = &argv[j+1];
+	    argc = j;
+	    continue;
+	    }
+	if ('|' == *(ap = argv[j]))
+	    {
+	    ++argv[j];
+	    cmargc = argc-j;
+	    cmargv = &argv[j];
+	    argc = j;
+	    continue;
+	    }
+	expand_wild_cards(ap, &list_head, &list_tail, &item_count);
+	}
+    /*
+     * Allocate and fill in the new argument vector, Some Unix's terminate
+     * the list with an extra null pointer.
+     */
+    New(7002, argv, item_count+1, char *);
+    *av = argv;
+    for (j = 0; j < item_count; ++j, list_head = list_head->next)
+	argv[j] = list_head->value;
+    *ac = item_count;
+    if (cmargv != NULL)
+	{
+	if (out != NULL)
+	    {
+	    fprintf(stderr,"'|' and '>' may not both be specified on command line");
+	    exit(LIB$_INVARGORD);
+	    }
+	pipe_and_fork(cmargv);
+	}
+	
+    /* Check for input from a pipe (mailbox) */
+
+    if (in == NULL && 1 == isapipe(0))
+	{
+	char mbxname[L_tmpnam];
+	long int bufsize;
+	long int dvi_item = DVI$_DEVBUFSIZ;
+	$DESCRIPTOR(mbxnam, "");
+	$DESCRIPTOR(mbxdevnam, "");
+
+	/* Input from a pipe, reopen it in binary mode to disable	*/
+	/* carriage control processing.	 				*/
+
+	fgetname(stdin, mbxname,1);
+	mbxnam.dsc$a_pointer = mbxname;
+	mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);	
+	lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
+	mbxdevnam.dsc$a_pointer = mbxname;
+	mbxdevnam.dsc$w_length = sizeof(mbxname);
+	dvi_item = DVI$_DEVNAM;
+	lib$getdvi(&dvi_item, 0, &mbxnam, 0, &mbxdevnam, &mbxdevnam.dsc$w_length);
+	mbxdevnam.dsc$a_pointer[mbxdevnam.dsc$w_length] = '\0';
+	set_errno(0);
+	set_vaxc_errno(1);
+	freopen(mbxname, "rb", stdin);
+	if (errno != 0)
+	    {
+	    fprintf(stderr,"Can't reopen input pipe (name: %s) in binary mode",mbxname);
+	    exit(vaxc$errno);
+	    }
+	}
+    if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2")))
+	{
+	fprintf(stderr,"Can't open input file %s as stdin",in);
+	exit(vaxc$errno);
+	}
+    if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2")))
+	{	
+	fprintf(stderr,"Can't open output file %s as stdout",out);
+	exit(vaxc$errno);
+	}
+    if (err != NULL) {
+	FILE *tmperr;
+	if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
+	    {
+	    fprintf(stderr,"Can't open error file %s as stderr",err);
+	    exit(vaxc$errno);
+	    }
+	    fclose(tmperr);
+	    if (NULL == freopen(err, "a", stderr, "mbc=32", "mbf=2"))
+		{
+		exit(vaxc$errno);
+		}
+	}
+#ifdef ARGPROC_DEBUG
+    fprintf(stderr, "Arglist:\n");
+    for (j = 0; j < *ac;  ++j)
+	fprintf(stderr, "argv[%d] = '%s'\n", j, argv[j]);
+#endif
+}  /* end of getredirection() */
+/*}}}*/
+
+static void add_item(struct list_item **head,
+		     struct list_item **tail,
+		     char *value,
+		     int *count)
+{
+    if (*head == 0)
+	{
+	New(7003,*head,1,struct list_item);
+	*tail = *head;
+	}
+    else {
+	New(7004,(*tail)->next,1,struct list_item);
+	*tail = (*tail)->next;
+	}
+    (*tail)->value = value;
+    ++(*count);
+}
+
+static void expand_wild_cards(char *item,
+			      struct list_item **head,
+			      struct list_item **tail,
+			      int *count)
+{
+int expcount = 0;
+unsigned long int context = 0;
+int isunix = 0;
+char *had_version;
+char *had_device;
+int had_directory;
+char *devdir;
+char vmsspec[NAM$C_MAXRSS+1];
+$DESCRIPTOR(filespec, "");
+$DESCRIPTOR(defaultspec, "SYS$DISK:[]");
+$DESCRIPTOR(resultspec, "");
+unsigned long int zero = 0, sts;
+
+    if (strcspn(item, "*%") == strlen(item))
+	{
+	add_item(head, tail, item, count);
+	return;
+	}
+    resultspec.dsc$b_dtype = DSC$K_DTYPE_T;
+    resultspec.dsc$b_class = DSC$K_CLASS_D;
+    resultspec.dsc$a_pointer = NULL;
+    if ((isunix = (int) strchr(item,'/')) != (int) NULL)
+      filespec.dsc$a_pointer = do_tovmsspec(item,vmsspec,0);
+    if (!isunix || !filespec.dsc$a_pointer)
+      filespec.dsc$a_pointer = item;
+    filespec.dsc$w_length = strlen(filespec.dsc$a_pointer);
+    /*
+     * Only return version specs, if the caller specified a version
+     */
+    had_version = strchr(item, ';');
+    /*
+     * Only return device and directory specs, if the caller specifed either.
+     */
+    had_device = strchr(item, ':');
+    had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<'));
+    
+    while (1 == (1 & (sts = lib$find_file(&filespec, &resultspec, &context,
+    				  &defaultspec, 0, 0, &zero))))
+	{
+	char *string;
+	char *c;
+
+	New(7005,string,resultspec.dsc$w_length+1,char);
+	strncpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length);
+	string[resultspec.dsc$w_length] = '\0';
+	if (NULL == had_version)
+	    *((char *)strrchr(string, ';')) = '\0';
+	if ((!had_directory) && (had_device == NULL))
+	    {
+	    if (NULL == (devdir = strrchr(string, ']')))
+		devdir = strrchr(string, '>');
+	    strcpy(string, devdir + 1);
+	    }
+	/*
+	 * Be consistent with what the C RTL has already done to the rest of
+	 * the argv items and lowercase all of these names.
+	 */
+	for (c = string; *c; ++c)
+	    if (isupper(*c))
+		*c = tolower(*c);
+	if (isunix) trim_unixpath(string,item);
+	add_item(head, tail, string, count);
+	++expcount;
+	}
+    if (sts != RMS$_NMF)
+	{
+	set_vaxc_errno(sts);
+	switch (sts)
+	    {
+	    case RMS$_FNF:
+	    case RMS$_DIR:
+		set_errno(ENOENT); break;
+	    case RMS$_DEV:
+		set_errno(ENODEV); break;
+	    case RMS$_SYN:
+		set_errno(EINVAL); break;
+	    case RMS$_PRV:
+		set_errno(EACCES); break;
+	    default:
+		_ckvmssts(sts);
+	    }
+	}
+    if (expcount == 0)
+	add_item(head, tail, item, count);
+    _ckvmssts(lib$sfree1_dd(&resultspec));
+    _ckvmssts(lib$find_file_end(&context));
+}
+
+static int child_st[2];/* Event Flag set when child process completes	*/
+
+static unsigned short child_chan;/* I/O Channel for Pipe Mailbox		*/
+
+static unsigned long int exit_handler(int *status)
+{
+short iosb[4];
+
+    if (0 == child_st[0])
+	{
+#ifdef ARGPROC_DEBUG
+	fprintf(stderr, "Waiting for Child Process to Finish . . .\n");
+#endif
+	fflush(stdout);	    /* Have to flush pipe for binary data to	*/
+			    /* terminate properly -- <tp@mccall.com>	*/
+	sys$qiow(0, child_chan, IO$_WRITEOF, iosb, 0, 0, 0, 0, 0, 0, 0, 0);
+	sys$dassgn(child_chan);
+	fclose(stdout);
+	sys$synch(0, child_st);
+	}
+    return(1);
+}
+
+static void sig_child(int chan)
+{
+#ifdef ARGPROC_DEBUG
+    fprintf(stderr, "Child Completion AST\n");
+#endif
+    if (child_st[0] == 0)
+	child_st[0] = 1;
+}
+
+static struct exit_control_block exit_block =
+    {
+    0,
+    exit_handler,
+    1,
+    &exit_block.exit_status,
+    0
+    };
+
+static void pipe_and_fork(char **cmargv)
+{
+    char subcmd[2048];
+    $DESCRIPTOR(cmddsc, "");
+    static char mbxname[64];
+    $DESCRIPTOR(mbxdsc, mbxname);
+    int pid, j;
+    unsigned long int zero = 0, one = 1;
+
+    strcpy(subcmd, cmargv[0]);
+    for (j = 1; NULL != cmargv[j]; ++j)
+	{
+	strcat(subcmd, " \"");
+	strcat(subcmd, cmargv[j]);
+	strcat(subcmd, "\"");
+	}
+    cmddsc.dsc$a_pointer = subcmd;
+    cmddsc.dsc$w_length = strlen(cmddsc.dsc$a_pointer);
+
+	create_mbx(&child_chan,&mbxdsc);
+#ifdef ARGPROC_DEBUG
+    fprintf(stderr, "Pipe Mailbox Name = '%s'\n", mbxdsc.dsc$a_pointer);
+    fprintf(stderr, "Sub Process Command = '%s'\n", cmddsc.dsc$a_pointer);
+#endif
+    _ckvmssts(lib$spawn(&cmddsc, &mbxdsc, 0, &one,
+    					0, &pid, child_st, &zero, sig_child,
+    					&child_chan));
+#ifdef ARGPROC_DEBUG
+    fprintf(stderr, "Subprocess's Pid = %08X\n", pid);
+#endif
+    sys$dclexh(&exit_block);
+    if (NULL == freopen(mbxname, "wb", stdout))
+	{
+	fprintf(stderr,"Can't open output pipe (name %s)",mbxname);
+	}
+}
+
+static int background_process(int argc, char **argv)
+{
+char command[2048] = "$";
+$DESCRIPTOR(value, "");
+static $DESCRIPTOR(cmd, "BACKGROUND$COMMAND");
+static $DESCRIPTOR(null, "NLA0:");
+static $DESCRIPTOR(pidsymbol, "SHELL_BACKGROUND_PID");
+char pidstring[80];
+$DESCRIPTOR(pidstr, "");
+int pid;
+unsigned long int flags = 17, one = 1, retsts;
+
+    strcat(command, argv[0]);
+    while (--argc)
+	{
+	strcat(command, " \"");
+	strcat(command, *(++argv));
+	strcat(command, "\"");
+	}
+    value.dsc$a_pointer = command;
+    value.dsc$w_length = strlen(value.dsc$a_pointer);
+    _ckvmssts(lib$set_symbol(&cmd, &value));
+    retsts = lib$spawn(&cmd, &null, 0, &flags, 0, &pid);
+    if (retsts == 0x38250) { /* DCL-W-NOTIFY - We must be BATCH, so retry */
+	_ckvmssts(lib$spawn(&cmd, &null, 0, &one, 0, &pid));
+    }
+    else {
+	_ckvmssts(retsts);
+    }
+#ifdef ARGPROC_DEBUG
+    fprintf(stderr, "%s\n", command);
+#endif
+    sprintf(pidstring, "%08X", pid);
+    fprintf(stderr, "%s\n", pidstring);
+    pidstr.dsc$a_pointer = pidstring;
+    pidstr.dsc$w_length = strlen(pidstr.dsc$a_pointer);
+    lib$set_symbol(&pidsymbol, &pidstr);
+    return(SS$_NORMAL);
+}
+/*}}}*/
+/***** End of code taken from Mark Pizzolato's argproc.c package *****/
+
+/* trim_unixpath()
+ * Trim Unix-style prefix off filespec, so it looks like what a shell
+ * glob expansion would return (i.e. from specified prefix on, not
+ * full path).  Note that returned filespec is Unix-style, regardless
+ * of whether input filespec was VMS-style or Unix-style.
+ *
+ * fspec is filespec to be trimmed, and wildspec is wildcard spec used to
+ * determine prefix (both may be in VMS or Unix syntax).
+ *
+ * Returns !=0 on success, with trimmed filespec replacing contents of
+ * fspec, and 0 on failure, with contents of fpsec unchanged.
+ */
+/*{{{int trim_unixpath(char *fspec, char *wildspec)*/
+int
+trim_unixpath(char *fspec, char *wildspec)
+{
+  char unixified[NAM$C_MAXRSS+1], unixwild[NAM$C_MAXRSS+1],
+       *template, *base, *cp1, *cp2;
+  register int tmplen, reslen = 0;
+
+  if (!wildspec || !fspec) return 0;
+  if (strpbrk(wildspec,"]>:") != NULL) {
+    if (do_tounixspec(wildspec,unixwild,0) == NULL) return 0;
+    else template = unixified;
+  }
+  else template = wildspec;
+  if (strpbrk(fspec,"]>:") != NULL) {
+    if (do_tounixspec(fspec,unixified,0) == NULL) return 0;
+    else base = unixified;
+    /* reslen != 0 ==> we had to unixify resultant filespec, so we must
+     * check to see that final result fits into (isn't longer than) fspec */
+    reslen = strlen(fspec);
+  }
+  else base = fspec;
+
+  /* No prefix or absolute path on wildcard, so nothing to remove */
+  if (!*template || *template == '/') {
+    if (base == fspec) return 1;
+    tmplen = strlen(unixified);
+    if (tmplen > reslen) return 0;  /* not enough space */
+    /* Copy unixified resultant, including trailing NUL */
+    memmove(fspec,unixified,tmplen+1);
+    return 1;
+  }
+
+  /* Find prefix to template consisting of path elements without wildcards */
+  if ((cp1 = strpbrk(template,"*%?")) == NULL)
+    for (cp1 = template; *cp1; cp1++) ;
+  else while (cp1 > template && *cp1 != '/') cp1--;
+  for (cp2 = base; *cp2; cp2++) ;  /* Find end of resultant filespec */
+
+  /* Wildcard was in first element, so we don't have a reliable string to
+   * match against.  Guess where to trim resultant filespec by counting
+   * directory levels in the Unix template.  (We could do this instead of
+   * string matching in all cases, since Unix doesn't have a ... wildcard
+   * that can expand into multiple levels of subdirectory, but we try for
+   * the string match so our caller can interpret foo/.../bar.* as
+   * [.foo...]bar.* if it wants, and only get burned if there was a
+   * wildcard in the first word (in which case, caveat caller). */
+  if (cp1 == template) { 
+    int subdirs = 0;
+    for ( ; *cp1; cp1++) if (*cp1 == '/') subdirs++;
+    /* need to back one more '/' than in template, to pick up leading dirname */
+    subdirs++;
+    while (cp2 > base) {
+      if (*cp2 == '/') subdirs--;
+      if (!subdirs) break;  /* quit without decrement when we hit last '/' */
+      cp2--;
+    }
+    /* ran out of directories on resultant; allow for already trimmed
+     * resultant, which hits start of string looking for leading '/' */
+    if (subdirs && (cp2 != base || subdirs != 1)) return 0;
+    /* Move past leading '/', if there is one */
+    base = cp2 + (*cp2 == '/' ? 1 : 0);
+    tmplen = strlen(base);
+    if (reslen && tmplen > reslen) return 0;  /* not enough space */
+    memmove(fspec,base,tmplen+1);  /* copy result to fspec, with trailing NUL */
+    return 1;
+  }
+  /* We have a prefix string of complete directory names, so we
+   * try to find it on the resultant filespec */
+  else { 
+    tmplen = cp1 - template;
+    if (!memcmp(base,template,tmplen)) { /* Nothing before prefix; we're done */
+      if (reslen) { /* we converted to Unix syntax; copy result over */
+        tmplen = cp2 - base;
+        if (tmplen > reslen) return 0;  /* not enough space */
+        memmove(fspec,base,tmplen+1);  /* Copy trimmed spec + trailing NUL */
+      }
+      return 1; 
+    }
+    for ( ; cp2 - base > tmplen; base++) {
+       if (*base != '/') continue;
+       if (!memcmp(base + 1,template,tmplen)) break;
+    }
+
+    if (cp2 - base == tmplen) return 0;  /* Not there - not good */
+    base++;  /* Move past leading '/' */
+    if (reslen && cp2 - base > reslen) return 0;  /* not enough space */
+    /* Copy down remaining portion of filespec, including trailing NUL */
+    memmove(fspec,base,cp2 - base + 1);
+    return 1;
+  }
+
+}  /* end of trim_unixpath() */
+/*}}}*/
+
+
+/*
+ *  VMS readdir() routines.
+ *  Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
+ *  This code has no copyright.
+ *
+ *  21-Jul-1994  Charles Bailey  bailey@genetics.upenn.edu
+ *  Minor modifications to original routines.
+ */
+
+    /* Number of elements in vms_versions array */
+#define VERSIZE(e)	(sizeof e->vms_versions / sizeof e->vms_versions[0])
+
+/*
+ *  Open a directory, return a handle for later use.
+ */
+/*{{{ DIR *opendir(char*name) */
+DIR *
+opendir(char *name)
+{
+    DIR *dd;
+    char dir[NAM$C_MAXRSS+1];
+      
+    /* Get memory for the handle, and the pattern. */
+    New(7006,dd,1,DIR);
+    if (do_tovmspath(name,dir,0) == NULL) {
+      Safefree((char *)dd);
+      return(NULL);
+    }
+    New(7007,dd->pattern,strlen(dir)+sizeof "*.*" + 1,char);
+
+    /* Fill in the fields; mainly playing with the descriptor. */
+    (void)sprintf(dd->pattern, "%s*.*",dir);
+    dd->context = 0;
+    dd->count = 0;
+    dd->vms_wantversions = 0;
+    dd->pat.dsc$a_pointer = dd->pattern;
+    dd->pat.dsc$w_length = strlen(dd->pattern);
+    dd->pat.dsc$b_dtype = DSC$K_DTYPE_T;
+    dd->pat.dsc$b_class = DSC$K_CLASS_S;
+
+    return dd;
+}  /* end of opendir() */
+/*}}}*/
+
+/*
+ *  Set the flag to indicate we want versions or not.
+ */
+/*{{{ void vmsreaddirversions(DIR *dd, int flag)*/
+void
+vmsreaddirversions(DIR *dd, int flag)
+{
+    dd->vms_wantversions = flag;
+}
+/*}}}*/
+
+/*
+ *  Free up an opened directory.
+ */
+/*{{{ void closedir(DIR *dd)*/
+void
+closedir(DIR *dd)
+{
+    (void)lib$find_file_end(&dd->context);
+    Safefree(dd->pattern);
+    Safefree((char *)dd);
+}
+/*}}}*/
+
+/*
+ *  Collect all the version numbers for the current file.
+ */
+static void
+collectversions(dd)
+    DIR *dd;
+{
+    struct dsc$descriptor_s	pat;
+    struct dsc$descriptor_s	res;
+    struct dirent *e;
+    char *p, *text, buff[sizeof dd->entry.d_name];
+    int i;
+    unsigned long context, tmpsts;
+
+    /* Convenient shorthand. */
+    e = &dd->entry;
+
+    /* Add the version wildcard, ignoring the "*.*" put on before */
+    i = strlen(dd->pattern);
+    New(7008,text,i + e->d_namlen + 3,char);
+    (void)strcpy(text, dd->pattern);
+    (void)sprintf(&text[i - 3], "%s;*", e->d_name);
+
+    /* Set up the pattern descriptor. */
+    pat.dsc$a_pointer = text;
+    pat.dsc$w_length = i + e->d_namlen - 1;
+    pat.dsc$b_dtype = DSC$K_DTYPE_T;
+    pat.dsc$b_class = DSC$K_CLASS_S;
+
+    /* Set up result descriptor. */
+    res.dsc$a_pointer = buff;
+    res.dsc$w_length = sizeof buff - 2;
+    res.dsc$b_dtype = DSC$K_DTYPE_T;
+    res.dsc$b_class = DSC$K_CLASS_S;
+
+    /* Read files, collecting versions. */
+    for (context = 0, e->vms_verscount = 0;
+         e->vms_verscount < VERSIZE(e);
+         e->vms_verscount++) {
+	tmpsts = lib$find_file(&pat, &res, &context);
+	if (tmpsts == RMS$_NMF || context == 0) break;
+	_ckvmssts(tmpsts);
+	buff[sizeof buff - 1] = '\0';
+	if ((p = strchr(buff, ';')))
+	    e->vms_versions[e->vms_verscount] = atoi(p + 1);
+	else
+	    e->vms_versions[e->vms_verscount] = -1;
+    }
+
+    _ckvmssts(lib$find_file_end(&context));
+    Safefree(text);
+
+}  /* end of collectversions() */
+
+/*
+ *  Read the next entry from the directory.
+ */
+/*{{{ struct dirent *readdir(DIR *dd)*/
+struct dirent *
+readdir(DIR *dd)
+{
+    struct dsc$descriptor_s	res;
+    char *p, buff[sizeof dd->entry.d_name];
+    unsigned long int tmpsts;
+
+    /* Set up result descriptor, and get next file. */
+    res.dsc$a_pointer = buff;
+    res.dsc$w_length = sizeof buff - 2;
+    res.dsc$b_dtype = DSC$K_DTYPE_T;
+    res.dsc$b_class = DSC$K_CLASS_S;
+    tmpsts = lib$find_file(&dd->pat, &res, &dd->context);
+    if ( tmpsts == RMS$_NMF || dd->context == 0) return NULL;  /* None left. */
+    if (!(tmpsts & 1)) {
+      set_vaxc_errno(tmpsts);
+      switch (tmpsts) {
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_DIR:
+        case RMS$_FNF:
+          set_errno(ENOENT); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return NULL;
+    }
+    dd->count++;
+    /* Force the buffer to end with a NUL, and downcase name to match C convention. */
+    buff[sizeof buff - 1] = '\0';
+    for (p = buff; !isspace(*p); p++) *p = _tolower(*p);
+    *p = '\0';
+
+    /* Skip any directory component and just copy the name. */
+    if ((p = strchr(buff, ']'))) (void)strcpy(dd->entry.d_name, p + 1);
+    else (void)strcpy(dd->entry.d_name, buff);
+
+    /* Clobber the version. */
+    if ((p = strchr(dd->entry.d_name, ';'))) *p = '\0';
+
+    dd->entry.d_namlen = strlen(dd->entry.d_name);
+    dd->entry.vms_verscount = 0;
+    if (dd->vms_wantversions) collectversions(dd);
+    return &dd->entry;
+
+}  /* end of readdir() */
+/*}}}*/
+
+/*
+ *  Return something that can be used in a seekdir later.
+ */
+/*{{{ long telldir(DIR *dd)*/
+long
+telldir(DIR *dd)
+{
+    return dd->count;
+}
+/*}}}*/
+
+/*
+ *  Return to a spot where we used to be.  Brute force.
+ */
+/*{{{ void seekdir(DIR *dd,long count)*/
+void
+seekdir(DIR *dd, long count)
+{
+    int vms_wantversions;
+
+    /* If we haven't done anything yet... */
+    if (dd->count == 0)
+	return;
+
+    /* Remember some state, and clear it. */
+    vms_wantversions = dd->vms_wantversions;
+    dd->vms_wantversions = 0;
+    _ckvmssts(lib$find_file_end(&dd->context));
+    dd->context = 0;
+
+    /* The increment is in readdir(). */
+    for (dd->count = 0; dd->count < count; )
+	(void)readdir(dd);
+
+    dd->vms_wantversions = vms_wantversions;
+
+}  /* end of seekdir() */
+/*}}}*/
+
+/* VMS subprocess management
+ *
+ * my_vfork() - just a vfork(), after setting a flag to record that
+ * the current script is trying a Unix-style fork/exec.
+ *
+ * vms_do_aexec() and vms_do_exec() are called in response to the
+ * perl 'exec' function.  If this follows a vfork call, then they
+ * call out the the regular perl routines in doio.c which do an
+ * execvp (for those who really want to try this under VMS).
+ * Otherwise, they do exactly what the perl docs say exec should
+ * do - terminate the current script and invoke a new command
+ * (See below for notes on command syntax.)
+ *
+ * do_aspawn() and do_spawn() implement the VMS side of the perl
+ * 'system' function.
+ *
+ * Note on command arguments to perl 'exec' and 'system': When handled
+ * in 'VMSish fashion' (i.e. not after a call to vfork) The args
+ * are concatenated to form a DCL command string.  If the first arg
+ * begins with '$' (i.e. the perl script had "\$ Type" or some such),
+ * the the command string is hrnded off to DCL directly.  Otherwise,
+ * the first token of the command is taken as the filespec of an image
+ * to run.  The filespec is expanded using a default type of '.EXE' and
+ * the process defaults for device, directory, etc., and the resultant
+ * filespec is invoked using the DCL verb 'MCR', and passed the rest of
+ * the command string as parameters.  This is perhaps a bit compicated,
+ * but I hope it will form a happy medium between what VMS folks expect
+ * from lib$spawn and what Unix folks expect from exec.
+ */
+
+static int vfork_called;
+
+/*{{{int my_vfork()*/
+int
+my_vfork()
+{
+  vfork_called++;
+  return vfork();
+}
+/*}}}*/
+
+
+static struct dsc$descriptor_s VMScmd = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,Nullch};
+
+static void
+vms_execfree() {
+  if (Cmd) {
+    Safefree(Cmd);
+    Cmd = Nullch;
+  }
+  if (VMScmd.dsc$a_pointer) {
+    Safefree(VMScmd.dsc$a_pointer);
+    VMScmd.dsc$w_length = 0;
+    VMScmd.dsc$a_pointer = Nullch;
+  }
+}
+
+static char *
+setup_argstr(SV *really, SV **mark, SV **sp)
+{
+  char *junk, *tmps = Nullch;
+  register size_t cmdlen = 0;
+  size_t rlen;
+  register SV **idx;
+
+  idx = mark;
+  if (really) {
+    tmps = SvPV(really,rlen);
+    if (*tmps) {
+      cmdlen += rlen + 1;
+      idx++;
+    }
+  }
+  
+  for (idx++; idx <= sp; idx++) {
+    if (*idx) {
+      junk = SvPVx(*idx,rlen);
+      cmdlen += rlen ? rlen + 1 : 0;
+    }
+  }
+  New(401,Cmd,cmdlen+1,char);
+
+  if (tmps && *tmps) {
+    strcpy(Cmd,tmps);
+    mark++;
+  }
+  else *Cmd = '\0';
+  while (++mark <= sp) {
+    if (*mark) {
+      strcat(Cmd," ");
+      strcat(Cmd,SvPVx(*mark,na));
+    }
+  }
+  return Cmd;
+
+}  /* end of setup_argstr() */
+
+
+static unsigned long int
+setup_cmddsc(char *cmd, int check_img)
+{
+  char resspec[NAM$C_MAXRSS+1];
+  $DESCRIPTOR(defdsc,".EXE");
+  $DESCRIPTOR(resdsc,resspec);
+  struct dsc$descriptor_s imgdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+  unsigned long int cxt = 0, flags = 1, retsts;
+  register char *s, *rest, *cp;
+  register int isdcl = 0;
+
+  s = cmd;
+  while (*s && isspace(*s)) s++;
+  if (check_img) {
+    if (*s == '$') { /* Check whether this is a DCL command: leading $ and */
+      isdcl = 1;     /* no dev/dir separators (i.e. not a foreign command) */
+      for (cp = s; *cp && *cp != '/' && !isspace(*cp); cp++) {
+        if (*cp == ':' || *cp == '[' || *cp == '<') {
+          isdcl = 0;
+          break;
+        }
+      }
+    }
+  }
+  else isdcl = 1;
+  if (isdcl) {  /* It's a DCL command, just do it. */
+    VMScmd.dsc$w_length = strlen(cmd);
+    if (cmd == Cmd) {
+       VMScmd.dsc$a_pointer = Cmd;
+       Cmd = Nullch;  /* Don't try to free twice in vms_execfree() */
+    }
+    else VMScmd.dsc$a_pointer = savepvn(cmd,VMScmd.dsc$w_length);
+  }
+  else {                           /* assume first token is an image spec */
+    cmd = s;
+    while (*s && !isspace(*s)) s++;
+    rest = *s ? s : 0;
+    imgdsc.dsc$a_pointer = cmd;
+    imgdsc.dsc$w_length = s - cmd;
+    retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,0,&flags);
+    if (!(retsts & 1)) {
+      /* just hand off status values likely to be due to user error */
+      if (retsts == RMS$_FNF || retsts == RMS$_DNF ||
+          retsts == RMS$_DEV || retsts == RMS$_DIR || retsts == RMS$_SYN ||
+         (retsts & STS$M_CODE) == (SHR$_NOWILD & STS$M_CODE)) return retsts;
+      else { _ckvmssts(retsts); }
+    }
+    else {
+      _ckvmssts(lib$find_file_end(&cxt));
+      s = resspec;
+      while (*s && !isspace(*s)) s++;
+      *s = '\0';
+      New(402,VMScmd.dsc$a_pointer,7 + s - resspec + (rest ? strlen(rest) : 0),char);
+      strcpy(VMScmd.dsc$a_pointer,"$ MCR ");
+      strcat(VMScmd.dsc$a_pointer,resspec);
+      if (rest) strcat(VMScmd.dsc$a_pointer,rest);
+      VMScmd.dsc$w_length = strlen(VMScmd.dsc$a_pointer);
+    }
+  }
+
+  return (VMScmd.dsc$w_length > 255 ? CLI$_BUFOVF : SS$_NORMAL);
+
+}  /* end of setup_cmddsc() */
+
+
+/* {{{ bool vms_do_aexec(SV *really,SV **mark,SV **sp) */
+bool
+vms_do_aexec(SV *really,SV **mark,SV **sp)
+{
+  if (sp > mark) {
+    if (vfork_called) {           /* this follows a vfork - act Unixish */
+      vfork_called--;
+      if (vfork_called < 0) {
+        warn("Internal inconsistency in tracking vforks");
+        vfork_called = 0;
+      }
+      else return do_aexec(really,mark,sp);
+    }
+                                           /* no vfork - act VMSish */
+    return vms_do_exec(setup_argstr(really,mark,sp));
+
+  }
+
+  return FALSE;
+}  /* end of vms_do_aexec() */
+/*}}}*/
+
+/* {{{bool vms_do_exec(char *cmd) */
+bool
+vms_do_exec(char *cmd)
+{
+
+  if (vfork_called) {             /* this follows a vfork - act Unixish */
+    vfork_called--;
+    if (vfork_called < 0) {
+      warn("Internal inconsistency in tracking vforks");
+      vfork_called = 0;
+    }
+    else return do_exec(cmd);
+  }
+
+  {                               /* no vfork - act VMSish */
+    unsigned long int retsts;
+
+    if ((retsts = setup_cmddsc(cmd,1)) & 1)
+      retsts = lib$do_command(&VMScmd);
+
+    set_errno(EVMSERR);
+    set_vaxc_errno(retsts);
+    if (dowarn)
+      warn("Can't exec \"%s\": %s", VMScmd.dsc$a_pointer, Strerror(errno));
+    vms_execfree();
+  }
+
+  return FALSE;
+
+}  /* end of vms_do_exec() */
+/*}}}*/
+
+unsigned long int do_spawn(char *);
+
+/* {{{ unsigned long int do_aspawn(SV *really,SV **mark,SV **sp) */
+unsigned long int
+do_aspawn(SV *really,SV **mark,SV **sp)
+{
+  if (sp > mark) return do_spawn(setup_argstr(really,mark,sp));
+
+  return SS$_ABORT;
+}  /* end of do_aspawn() */
+/*}}}*/
+
+/* {{{unsigned long int do_spawn(char *cmd) */
+unsigned long int
+do_spawn(char *cmd)
+{
+  unsigned long int substs, hadcmd = 1;
+
+  if (!cmd || !*cmd) {
+    hadcmd = 0;
+    _ckvmssts(lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0));
+  }
+  else if ((substs = setup_cmddsc(cmd,0)) & 1) {
+    _ckvmssts(lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0));
+  }
+  
+  if (!(substs&1)) {
+    set_errno(EVMSERR);
+    set_vaxc_errno(substs);
+    if (dowarn)
+      warn("Can't spawn \"%s\": %s",
+           hadcmd ? VMScmd.dsc$a_pointer : "", Strerror(errno));
+  }
+  vms_execfree();
+  return substs;
+
+}  /* end of do_spawn() */
+/*}}}*/
+
+/* 
+ * A simple fwrite replacement which outputs itmsz*nitm chars without
+ * introducing record boundaries every itmsz chars.
+ */
+/*{{{ int my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)*/
+int
+my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)
+{
+  register char *cp, *end;
+
+  end = (char *)src + itmsz * nitm;
+
+  while ((char *)src <= end) {
+    for (cp = src; cp <= end; cp++) if (!*cp) break;
+    if (fputs(src,dest) == EOF) return EOF;
+    if (cp < end)
+      if (fputc('\0',dest) == EOF) return EOF;
+    src = cp + 1;
+  }
+
+  return 1;
+
+}  /* end of my_fwrite() */
+/*}}}*/
+
+/*
+ * Here are replacements for the following Unix routines in the VMS environment:
+ *      getpwuid    Get information for a particular UIC or UID
+ *      getpwnam    Get information for a named user
+ *      getpwent    Get information for each user in the rights database
+ *      setpwent    Reset search to the start of the rights database
+ *      endpwent    Finish searching for users in the rights database
+ *
+ * getpwuid, getpwnam, and getpwent return a pointer to the passwd structure
+ * (defined in pwd.h), which contains the following fields:-
+ *      struct passwd {
+ *              char        *pw_name;    Username (in lower case)
+ *              char        *pw_passwd;  Hashed password
+ *              unsigned int pw_uid;     UIC
+ *              unsigned int pw_gid;     UIC group  number
+ *              char        *pw_unixdir; Default device/directory (VMS-style)
+ *              char        *pw_gecos;   Owner name
+ *              char        *pw_dir;     Default device/directory (Unix-style)
+ *              char        *pw_shell;   Default CLI name (eg. DCL)
+ *      };
+ * If the specified user does not exist, getpwuid and getpwnam return NULL.
+ *
+ * pw_uid is the full UIC (eg. what's returned by stat() in st_uid).
+ * not the UIC member number (eg. what's returned by getuid()),
+ * getpwuid() can accept either as input (if uid is specified, the caller's
+ * UIC group is used), though it won't recognise gid=0.
+ *
+ * Note that in VMS it is necessary to have GRPPRV or SYSPRV to return
+ * information about other users in your group or in other groups, respectively.
+ * If the required privilege is not available, then these routines fill only
+ * the pw_name, pw_uid, and pw_gid fields (the others point to an empty
+ * string).
+ *
+ * By Tim Adye (T.J.Adye@rl.ac.uk), 10th February 1995.
+ */
+
+/* sizes of various UAF record fields */
+#define UAI$S_USERNAME 12
+#define UAI$S_IDENT    31
+#define UAI$S_OWNER    31
+#define UAI$S_DEFDEV   31
+#define UAI$S_DEFDIR   63
+#define UAI$S_DEFCLI   31
+#define UAI$S_PWD       8
+
+#define valid_uic(uic) ((uic).uic$v_format == UIC$K_UIC_FORMAT  && \
+                        (uic).uic$v_member != UIC$K_WILD_MEMBER && \
+                        (uic).uic$v_group  != UIC$K_WILD_GROUP)
+
+static char __empty[]= "";
+static struct passwd __passwd_empty=
+    {(char *) __empty, (char *) __empty, 0, 0,
+     (char *) __empty, (char *) __empty, (char *) __empty, (char *) __empty};
+static int contxt= 0;
+static struct passwd __pwdcache;
+static char __pw_namecache[UAI$S_IDENT+1];
+
+/*
+ * This routine does most of the work extracting the user information.
+ */
+static int fillpasswd (const char *name, struct passwd *pwd)
+{
+    static struct {
+        unsigned char length;
+        char pw_gecos[UAI$S_OWNER+1];
+    } owner;
+    static union uicdef uic;
+    static struct {
+        unsigned char length;
+        char pw_dir[UAI$S_DEFDEV+UAI$S_DEFDIR+1];
+    } defdev;
+    static struct {
+        unsigned char length;
+        char unixdir[UAI$_DEFDEV+UAI$S_DEFDIR+1];
+    } defdir;
+    static struct {
+        unsigned char length;
+        char pw_shell[UAI$S_DEFCLI+1];
+    } defcli;
+    static char pw_passwd[UAI$S_PWD+1];
+
+    static unsigned short lowner, luic, ldefdev, ldefdir, ldefcli, lpwd;
+    struct dsc$descriptor_s name_desc;
+    unsigned long int sts;
+
+    static struct itmlst_3 itmlst[]= {
+        {UAI$S_OWNER+1,    UAI$_OWNER,  &owner,    &lowner},
+        {sizeof(uic),      UAI$_UIC,    &uic,      &luic},
+        {UAI$S_DEFDEV+1,   UAI$_DEFDEV, &defdev,   &ldefdev},
+        {UAI$S_DEFDIR+1,   UAI$_DEFDIR, &defdir,   &ldefdir},
+        {UAI$S_DEFCLI+1,   UAI$_DEFCLI, &defcli,   &ldefcli},
+        {UAI$S_PWD,        UAI$_PWD,    pw_passwd, &lpwd},
+        {0,                0,           NULL,    NULL}};
+
+    name_desc.dsc$w_length=  strlen(name);
+    name_desc.dsc$b_dtype=   DSC$K_DTYPE_T;
+    name_desc.dsc$b_class=   DSC$K_CLASS_S;
+    name_desc.dsc$a_pointer= (char *) name;
+
+/*  Note that sys$getuai returns many fields as counted strings. */
+    sts= sys$getuai(0, 0, &name_desc, &itmlst, 0, 0, 0);
+    if (sts == SS$_NOSYSPRV || sts == SS$_NOGRPPRV || sts == RMS$_RNF) {
+      set_vaxc_errno(sts); set_errno(sts == RMS$_RNF ? EINVAL : EACCES);
+    }
+    else { _ckvmssts(sts); }
+    if (!(sts & 1)) return 0;  /* out here in case _ckvmssts() doesn't abort */
+
+    if ((int) owner.length  < lowner)  lowner=  (int) owner.length;
+    if ((int) defdev.length < ldefdev) ldefdev= (int) defdev.length;
+    if ((int) defdir.length < ldefdir) ldefdir= (int) defdir.length;
+    if ((int) defcli.length < ldefcli) ldefcli= (int) defcli.length;
+    memcpy(&defdev.pw_dir[ldefdev], &defdir.unixdir[0], ldefdir);
+    owner.pw_gecos[lowner]=            '\0';
+    defdev.pw_dir[ldefdev+ldefdir]= '\0';
+    defcli.pw_shell[ldefcli]=          '\0';
+    if (valid_uic(uic)) {
+        pwd->pw_uid= uic.uic$l_uic;
+        pwd->pw_gid= uic.uic$v_group;
+    }
+    else
+      warn("getpwnam returned invalid UIC %#o for user \"%s\"");
+    pwd->pw_passwd=  pw_passwd;
+    pwd->pw_gecos=   owner.pw_gecos;
+    pwd->pw_dir=     defdev.pw_dir;
+    pwd->pw_unixdir= do_tounixpath(defdev.pw_dir, defdir.unixdir,1);
+    pwd->pw_shell=   defcli.pw_shell;
+    if (pwd->pw_unixdir && pwd->pw_unixdir[0]) {
+        int ldir;
+        ldir= strlen(pwd->pw_unixdir) - 1;
+        if (pwd->pw_unixdir[ldir]=='/') pwd->pw_unixdir[ldir]= '\0';
+    }
+    else
+        strcpy(pwd->pw_unixdir, pwd->pw_dir);
+    __mystrtolower(pwd->pw_unixdir);
+    return 1;
+}
+
+/*
+ * Get information for a named user.
+*/
+/*{{{struct passwd *getpwnam(char *name)*/
+struct passwd *my_getpwnam(char *name)
+{
+    struct dsc$descriptor_s name_desc;
+    union uicdef uic;
+    unsigned long int status, stat;
+                                  
+    __pwdcache = __passwd_empty;
+    if (!fillpasswd(name, &__pwdcache)) {
+      /* We still may be able to determine pw_uid and pw_gid */
+      name_desc.dsc$w_length=  strlen(name);
+      name_desc.dsc$b_dtype=   DSC$K_DTYPE_T;
+      name_desc.dsc$b_class=   DSC$K_CLASS_S;
+      name_desc.dsc$a_pointer= (char *) name;
+      if ((stat = sys$asctoid(&name_desc, &uic, 0)) == SS$_NORMAL) {
+        __pwdcache.pw_uid= uic.uic$l_uic;
+        __pwdcache.pw_gid= uic.uic$v_group;
+      }
+      else {
+        if (stat == SS$_NOSUCHID || stat == SS$_IVIDENT || stat == RMS$_PRV) {
+          set_vaxc_errno(stat);
+          set_errno(stat == RMS$_PRV ? EACCES : EINVAL);
+          return NULL;
+        }
+        else { _ckvmssts(stat); }
+      }
+    }
+    strncpy(__pw_namecache, name, sizeof(__pw_namecache));
+    __pw_namecache[sizeof __pw_namecache - 1] = '\0';
+    __pwdcache.pw_name= __pw_namecache;
+    return &__pwdcache;
+}  /* end of my_getpwnam() */
+/*}}}*/
+
+/*
+ * Get information for a particular UIC or UID.
+ * Called by my_getpwent with uid=-1 to list all users.
+*/
+/*{{{struct passwd *my_getpwuid(Uid_t uid)*/
+struct passwd *my_getpwuid(Uid_t uid)
+{
+    const $DESCRIPTOR(name_desc,__pw_namecache);
+    unsigned short lname;
+    union uicdef uic;
+    unsigned long int status;
+
+    if (uid == (unsigned int) -1) {
+      do {
+        status = sys$idtoasc(-1, &lname, &name_desc, &uic, 0, &contxt);
+        if (status == SS$_NOSUCHID || status == RMS$_PRV) {
+          set_vaxc_errno(status);
+          set_errno(status == RMS$_PRV ? EACCES : EINVAL);
+          my_endpwent();
+          return NULL;
+        }
+        else { _ckvmssts(status); }
+      } while (!valid_uic (uic));
+    }
+    else {
+      uic.uic$l_uic= uid;
+      if (!uic.uic$v_group)
+        uic.uic$v_group= getgid();
+      if (valid_uic(uic))
+        status = sys$idtoasc(uic.uic$l_uic, &lname, &name_desc, 0, 0, 0);
+      else status = SS$_IVIDENT;
+      if (status == SS$_IVIDENT || status == SS$_NOSUCHID ||
+          status == RMS$_PRV) {
+        set_vaxc_errno(status); set_errno(status == RMS$_PRV ? EACCES : EINVAL);
+        return NULL;
+      }
+      else { _ckvmssts(status); }
+    }
+    __pw_namecache[lname]= '\0';
+    __mystrtolower(__pw_namecache);
+
+    __pwdcache = __passwd_empty;
+    __pwdcache.pw_name = __pw_namecache;
+
+/*  Fill in the uid and gid in case fillpasswd can't (eg. no privilege).
+    The identifier's value is usually the UIC, but it doesn't have to be,
+    so if we can, we let fillpasswd update this. */
+    __pwdcache.pw_uid =  uic.uic$l_uic;
+    __pwdcache.pw_gid =  uic.uic$v_group;
+
+    fillpasswd(__pw_namecache, &__pwdcache);
+    return &__pwdcache;
+
+}  /* end of my_getpwuid() */
+/*}}}*/
+
+/*
+ * Get information for next user.
+*/
+/*{{{struct passwd *my_getpwent()*/
+struct passwd *my_getpwent()
+{
+    return (my_getpwuid((unsigned int) -1));
+}
+/*}}}*/
+
+/*
+ * Finish searching rights database for users.
+*/
+/*{{{void my_endpwent()*/
+void my_endpwent()
+{
+    if (contxt) {
+      _ckvmssts(sys$finish_rdb(&contxt));
+      contxt= 0;
+    }
+}
+/*}}}*/
+
+
+/* my_gmtime
+ * If the CRTL has a real gmtime(), use it, else look for the logical
+ * name SYS$TIMEZONE_DIFFERENTIAL used by the native UTC routines on
+ * VMS >= 6.0.  Can be manually defined under earlier versions of VMS
+ * to translate to the number of seconds which must be added to UTC
+ * to get to the local time of the system.
+ * Contributed by Chuck Lane  <lane@duphy4.physics.drexel.edu>
+ */
+
+/*{{{struct tm *my_gmtime(const time_t *time)*/
+/* We #defined 'gmtime' as 'my_gmtime' in vmsish.h.  #undef it here
+ * so we can call the CRTL's routine to see if it works.
+ */
+#undef gmtime
+struct tm *
+my_gmtime(const time_t *time)
+{
+  static int gmtime_emulation_type;
+  static time_t utc_offset_secs;
+  char *p;
+  time_t when;
+
+  if (gmtime_emulation_type == 0) {
+    gmtime_emulation_type++;
+    when = 300000000;
+    if (gmtime(&when) == NULL) {  /* CRTL gmtime() is just a stub */
+      gmtime_emulation_type++;
+      if ((p = my_getenv("SYS$TIMEZONE_DIFFERENTIAL")) == NULL)
+        gmtime_emulation_type++;
+      else
+        utc_offset_secs = (time_t) atol(p);
+    }
+  }
+
+  switch (gmtime_emulation_type) {
+    case 1:
+      return gmtime(time);
+    case 2:
+      when = *time - utc_offset_secs;
+      return localtime(&when);
+    default:
+      warn("gmtime not supported on this system");
+      return NULL;
+  }
+}  /* end of my_gmtime() */
+/* Reset definition for later calls */
+#define gmtime(t) my_gmtime(t)
+/*}}}*/
+
+
+/*
+ * flex_stat, flex_fstat
+ * basic stat, but gets it right when asked to stat
+ * a Unix-style path ending in a directory name (e.g. dir1/dir2/dir3)
+ */
+
+/* encode_dev packs a VMS device name string into an integer to allow
+ * simple comparisons. This can be used, for example, to check whether two
+ * files are located on the same device, by comparing their encoded device
+ * names. Even a string comparison would not do, because stat() reuses the
+ * device name buffer for each call; so without encode_dev, it would be
+ * necessary to save the buffer and use strcmp (this would mean a number of
+ * changes to the standard Perl code, to say nothing of what a Perl script
+ * would have to do.
+ *
+ * The device lock id, if it exists, should be unique (unless perhaps compared
+ * with lock ids transferred from other nodes). We have a lock id if the disk is
+ * mounted cluster-wide, which is when we tend to get long (host-qualified)
+ * device names. Thus we use the lock id in preference, and only if that isn't
+ * available, do we try to pack the device name into an integer (flagged by
+ * the sign bit (LOCKID_MASK) being set).
+ *
+ * Note that encode_dev cannot guarantee an 1-to-1 correspondence twixt device
+ * name and its encoded form, but it seems very unlikely that we will find
+ * two files on different disks that share the same encoded device names,
+ * and even more remote that they will share the same file id (if the test
+ * is to check for the same file).
+ *
+ * A better method might be to use sys$device_scan on the first call, and to
+ * search for the device, returning an index into the cached array.
+ * The number returned would be more intelligable.
+ * This is probably not worth it, and anyway would take quite a bit longer
+ * on the first call.
+ */
+#define LOCKID_MASK 0x80000000     /* Use 0 to force device name use only */
+static dev_t encode_dev (const char *dev)
+{
+  int i;
+  unsigned long int f;
+  dev_t enc;
+  char c;
+  const char *q;
+
+  if (!dev || !dev[0]) return 0;
+
+#if LOCKID_MASK
+  {
+    struct dsc$descriptor_s dev_desc;
+    unsigned long int status, lockid, item = DVI$_LOCKID;
+
+    /* For cluster-mounted disks, the disk lock identifier is unique, so we
+       can try that first. */
+    dev_desc.dsc$w_length =  strlen (dev);
+    dev_desc.dsc$b_dtype =   DSC$K_DTYPE_T;
+    dev_desc.dsc$b_class =   DSC$K_CLASS_S;
+    dev_desc.dsc$a_pointer = (char *) dev;
+    _ckvmssts(lib$getdvi(&item, 0, &dev_desc, &lockid, 0, 0));
+    if (lockid) return (lockid & ~LOCKID_MASK);
+  }
+#endif
+
+  /* Otherwise we try to encode the device name */
+  enc = 0;
+  f = 1;
+  i = 0;
+  for (q = dev + strlen(dev); q--; q >= dev) {
+    if (isdigit (*q))
+      c= (*q) - '0';
+    else if (isalpha (toupper (*q)))
+      c= toupper (*q) - 'A' + (char)10;
+    else
+      continue; /* Skip '$'s */
+    i++;
+    if (i>6) break;     /* 36^7 is too large to fit in an unsigned long int */
+    if (i>1) f *= 36;
+    enc += f * (unsigned long int) c;
+  }
+  return (enc | LOCKID_MASK);  /* May have already overflowed into bit 31 */
+
+}  /* end of encode_dev() */
+
+static char namecache[NAM$C_MAXRSS+1];
+
+static int
+is_null_device(name)
+    const char *name;
+{
+    /* The VMS null device is named "_NLA0:", usually abbreviated as "NL:".
+       The underscore prefix, controller letter, and unit number are
+       independently optional; for our purposes, the colon punctuation
+       is not.  The colon can be trailed by optional directory and/or
+       filename, but two consecutive colons indicates a nodename rather
+       than a device.  [pr]  */
+  if (*name == '_') ++name;
+  if (tolower(*name++) != 'n') return 0;
+  if (tolower(*name++) != 'l') return 0;
+  if (tolower(*name) == 'a') ++name;
+  if (*name == '0') ++name;
+  return (*name++ == ':') && (*name != ':');
+}
+
+/* Do the permissions allow some operation?  Assumes statcache already set. */
+/* Do this via $Check_Access on VMS, since the CRTL stat() returns only a
+ * subset of the applicable information.
+ */
+/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/
+I32
+cando(I32 bit, I32 effective, struct stat *statbufp)
+{
+  if (statbufp == &statcache) 
+    return cando_by_name(bit,effective,namecache);
+  else {
+    char fname[NAM$C_MAXRSS+1];
+    unsigned long int retsts;
+    struct dsc$descriptor_s devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+                            namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+
+    /* If the struct mystat is stale, we're OOL; stat() overwrites the
+       device name on successive calls */
+    devdsc.dsc$a_pointer = statbufp->st_devnam;
+    devdsc.dsc$w_length = strlen(statbufp->st_devnam);
+    namdsc.dsc$a_pointer = fname;
+    namdsc.dsc$w_length = sizeof fname - 1;
+
+    retsts = lib$fid_to_name(&devdsc,&(statbufp->st_ino),&namdsc,
+                             &namdsc.dsc$w_length,0,0);
+    if (retsts & 1) {
+      fname[namdsc.dsc$w_length] = '\0';
+      return cando_by_name(bit,effective,fname);
+    }
+    else if (retsts == SS$_NOSUCHDEV || retsts == SS$_NOSUCHFILE) {
+      warn("Can't get filespec - stale stat buffer?\n");
+      return FALSE;
+    }
+    _ckvmssts(retsts);
+    return FALSE;  /* Should never get to here */
+  }
+}  /* end of cando() */
+/*}}}*/
+
+
+/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/
+I32
+cando_by_name(I32 bit, I32 effective, char *fname)
+{
+  static char usrname[L_cuserid];
+  static struct dsc$descriptor_s usrdsc =
+         {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
+  char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
+  unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
+  unsigned short int retlen;
+  struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+  union prvdef curprv;
+  struct itmlst_3 armlst[3] = {{sizeof access, CHP$_ACCESS, &access, &retlen},
+         {sizeof privused, CHP$_PRIVUSED, &privused, &retlen},{0,0,0,0}};
+  struct itmlst_3 jpilst[2] = {{sizeof curprv, JPI$_CURPRIV, &curprv, &retlen},
+         {0,0,0,0}};
+
+  if (!fname || !*fname) return FALSE;
+  /* Make sure we expand logical names, since sys$check_access doesn't */
+  if (!strpbrk(fname,"/]>:")) {
+    strcpy(fileified,fname);
+    while (!strpbrk(fileified,"/]>:>") && my_trnlnm(fileified,fileified,0)) ;
+    fname = fileified;
+  }
+  if (!do_tovmsspec(fname,vmsname,1)) return FALSE;
+  retlen = namdsc.dsc$w_length = strlen(vmsname);
+  namdsc.dsc$a_pointer = vmsname;
+  if (vmsname[retlen-1] == ']' || vmsname[retlen-1] == '>' ||
+      vmsname[retlen-1] == ':') {
+    if (!do_fileify_dirspec(vmsname,fileified,1)) return FALSE;
+    namdsc.dsc$w_length = strlen(fileified);
+    namdsc.dsc$a_pointer = fileified;
+  }
+
+  if (!usrdsc.dsc$w_length) {
+    cuserid(usrname);
+    usrdsc.dsc$w_length = strlen(usrname);
+  }
+
+  switch (bit) {
+    case S_IXUSR:
+    case S_IXGRP:
+    case S_IXOTH:
+      access = ARM$M_EXECUTE;
+      break;
+    case S_IRUSR:
+    case S_IRGRP:
+    case S_IROTH:
+      access = ARM$M_READ;
+      break;
+    case S_IWUSR:
+    case S_IWGRP:
+    case S_IWOTH:
+      access = ARM$M_WRITE;
+      break;
+    case S_IDUSR:
+    case S_IDGRP:
+    case S_IDOTH:
+      access = ARM$M_DELETE;
+      break;
+    default:
+      return FALSE;
+  }
+
+  retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
+#ifndef SS$_NOSUCHOBJECT  /* Older versions of ssdef.h don't have this */
+#  define SS$_NOSUCHOBJECT 2696
+#endif
+  if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT ||
+      retsts == RMS$_FNF   || retsts == RMS$_DIR         ||
+      retsts == RMS$_DEV) {
+    set_errno(retsts == SS$_NOPRIV ? EACCES : ENOENT); set_vaxc_errno(retsts);
+    return FALSE;
+  }
+  if (retsts == SS$_NORMAL) {
+    if (!privused) return TRUE;
+    /* We can get access, but only by using privs.  Do we have the
+       necessary privs currently enabled? */
+    _ckvmssts(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
+    if ((privused & CHP$M_BYPASS) &&  !curprv.prv$v_bypass)  return FALSE;
+    if ((privused & CHP$M_SYSPRV) &&  !curprv.prv$v_sysprv &&
+                                      !curprv.prv$v_bypass)  return FALSE;
+    if ((privused & CHP$M_GRPPRV) &&  !curprv.prv$v_grpprv &&
+         !curprv.prv$v_sysprv &&      !curprv.prv$v_bypass)  return FALSE;
+    if ((privused & CHP$M_READALL) && !curprv.prv$v_readall) return FALSE;
+    return TRUE;
+  }
+  _ckvmssts(retsts);
+
+  return FALSE;  /* Should never get here */
+
+}  /* end of cando_by_name() */
+/*}}}*/
+
+
+/*{{{ int flex_fstat(int fd, struct stat *statbuf)*/
+int
+flex_fstat(int fd, struct stat *statbuf)
+{
+  char fspec[NAM$C_MAXRSS+1];
+
+  if (!getname(fd,fspec,1)) return -1;
+  return flex_stat(fspec,statbuf);
+
+}  /* end of flex_fstat() */
+/*}}}*/
+
+/*{{{ int flex_stat(char *fspec, struct stat *statbufp)*/
+/* We defined 'stat' as 'mystat' in vmsish.h so that declarations of
+ * 'struct stat' elsewhere in Perl would use our struct.  We go back
+ * to the system version here, since we're actually calling their
+ * stat().
+ */
+#undef stat
+int
+flex_stat(char *fspec, struct mystat *statbufp)
+{
+    char fileified[NAM$C_MAXRSS+1];
+    int retval,myretval;
+    struct mystat tmpbuf;
+
+    
+    if (statbufp == &statcache) do_tovmsspec(fspec,namecache,0);
+    if (is_null_device(fspec)) { /* Fake a stat() for the null device */
+      memset(statbufp,0,sizeof *statbufp);
+      statbufp->st_dev = encode_dev("_NLA0:");
+      statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
+      statbufp->st_uid = 0x00010001;
+      statbufp->st_gid = 0x0001;
+      time((time_t *)&statbufp->st_mtime);
+      statbufp->st_atime = statbufp->st_ctime = statbufp->st_mtime;
+      return 0;
+    }
+
+    if (do_fileify_dirspec(fspec,fileified,0) == NULL) myretval = -1;
+    else {
+      myretval = stat(fileified,(stat_t *) &tmpbuf);
+    }
+    retval = stat(fspec,(stat_t *) statbufp);
+    if (!myretval) {
+      if (retval == -1) {
+        *statbufp = tmpbuf;
+        retval = 0;
+      }
+      else if (!retval) { /* Dir with same name.  Substitute it. */
+        statbufp->st_mode &= ~S_IFDIR;
+        statbufp->st_mode |= tmpbuf.st_mode & S_IFDIR;
+        strcpy(namecache,fileified);
+      }
+    }
+    if (!retval) statbufp->st_dev = encode_dev(statbufp->st_devnam);
+    return retval;
+
+}  /* end of flex_stat() */
+/* Reset definition for later calls */
+#define stat mystat
+/*}}}*/
+
+/*{{{char *my_getlogin()*/
+/* VMS cuserid == Unix getlogin, except calling sequence */
+char *
+my_getlogin()
+{
+    static char user[L_cuserid];
+    return cuserid(user);
+}
+/*}}}*/
+
+
+/*  rmscopy - copy a file using VMS RMS routines
+ *
+ *  Copies contents and attributes of spec_in to spec_out, except owner
+ *  and protection information.  Name and type of spec_in are used as
+ *  defaults for spec_out.  The third parameter specifies whether rmscopy()
+ *  should try to propagate timestamps from the input file to the output file.
+ *  If it is less than 0, no timestamps are preserved.  If it is 0, then
+ *  rmscopy() will behave similarly to the DCL COPY command: timestamps are
+ *  propagated to the output file at creation iff the output file specification
+ *  did not contain an explicit name or type, and the revision date is always
+ *  updated at the end of the copy operation.  If it is greater than 0, then
+ *  it is interpreted as a bitmask, in which bit 0 indicates that timestamps
+ *  other than the revision date should be propagated, and bit 1 indicates
+ *  that the revision date should be propagated.
+ *
+ *  Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure.
+ *
+ *  Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
+ *  Incorporates, with permission, some code from EZCOPY by Tim Adye
+ *  <T.J.Adye@rl.ac.uk>.  Permission is given to distribute this code
+ * as part of the Perl standard distribution under the terms of the
+ * GNU General Public License or the Perl Artistic License.  Copies
+ * of each may be found in the Perl standard distribution.
+ */
+/*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/
+int
+rmscopy(char *spec_in, char *spec_out, int preserve_dates)
+{
+    char vmsin[NAM$C_MAXRSS+1], vmsout[NAM$C_MAXRSS+1], esa[NAM$C_MAXRSS],
+         rsa[NAM$C_MAXRSS], ubf[32256];
+    unsigned long int i, sts, sts2;
+    struct FAB fab_in, fab_out;
+    struct RAB rab_in, rab_out;
+    struct NAM nam;
+    struct XABDAT xabdat;
+    struct XABFHC xabfhc;
+    struct XABRDT xabrdt;
+    struct XABSUM xabsum;
+
+    if (!spec_in  || !*spec_in  || !do_tovmsspec(spec_in,vmsin,1) ||
+        !spec_out || !*spec_out || !do_tovmsspec(spec_out,vmsout,1)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      return 0;
+    }
+
+    fab_in = cc$rms_fab;
+    fab_in.fab$l_fna = vmsin;
+    fab_in.fab$b_fns = strlen(vmsin);
+    fab_in.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;
+    fab_in.fab$b_fac = FAB$M_BIO | FAB$M_GET;
+    fab_in.fab$l_fop = FAB$M_SQO;
+    fab_in.fab$l_nam =  &nam;
+    fab_in.fab$l_xab = (void *) &xabdat;
+
+    nam = cc$rms_nam;
+    nam.nam$l_rsa = rsa;
+    nam.nam$b_rss = sizeof(rsa);
+    nam.nam$l_esa = esa;
+    nam.nam$b_ess = sizeof (esa);
+    nam.nam$b_esl = nam.nam$b_rsl = 0;
+
+    xabdat = cc$rms_xabdat;        /* To get creation date */
+    xabdat.xab$l_nxt = (void *) &xabfhc;
+
+    xabfhc = cc$rms_xabfhc;        /* To get record length */
+    xabfhc.xab$l_nxt = (void *) &xabsum;
+
+    xabsum = cc$rms_xabsum;        /* To get key and area information */
+
+    if (!((sts = sys$open(&fab_in)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_FNF:
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+
+    fab_out = fab_in;
+    fab_out.fab$w_ifi = 0;
+    fab_out.fab$b_fac = FAB$M_BIO | FAB$M_PUT;
+    fab_out.fab$b_shr = FAB$M_SHRGET | FAB$M_UPI;
+    fab_out.fab$l_fop = FAB$M_SQO;
+    fab_out.fab$l_fna = vmsout;
+    fab_out.fab$b_fns = strlen(vmsout);
+    fab_out.fab$l_dna = nam.nam$l_name;
+    fab_out.fab$b_dns = nam.nam$l_name ? nam.nam$b_name + nam.nam$b_type : 0;
+
+    if (preserve_dates == 0) {  /* Act like DCL COPY */
+      nam.nam$b_nop = NAM$M_SYNCHK;
+      fab_out.fab$l_xab = NULL;  /* Don't disturb data from input file */
+      if (!((sts = sys$parse(&fab_out)) & 1)) {
+        set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR);
+        set_vaxc_errno(sts);
+        return 0;
+      }
+      fab_out.fab$l_xab = (void *) &xabdat;
+      if (nam.nam$l_fnb & (NAM$M_EXP_NAME | NAM$M_EXP_TYPE)) preserve_dates = 1;
+    }
+    fab_out.fab$l_nam = (void *) 0;  /* Done with NAM block */
+    if (preserve_dates < 0)   /* Clear all bits; we'll use it as a */
+      preserve_dates =0;      /* bitmask from this point forward   */
+
+    if (!(preserve_dates & 1)) fab_out.fab$l_xab = (void *) &xabfhc;
+    if (!((sts = sys$create(&fab_out)) & 1)) {
+      set_vaxc_errno(sts);
+      switch (sts) {
+        case RMS$_DIR:
+          set_errno(ENOENT); break;
+        case RMS$_DEV:
+          set_errno(ENODEV); break;
+        case RMS$_SYN:
+          set_errno(EINVAL); break;
+        case RMS$_PRV:
+          set_errno(EACCES); break;
+        default:
+          set_errno(EVMSERR);
+      }
+      return 0;
+    }
+    fab_out.fab$l_fop |= FAB$M_DLT;  /* in case we have to bail out */
+    if (preserve_dates & 2) {
+      /* sys$close() will process xabrdt, not xabdat */
+      xabrdt = cc$rms_xabrdt;
+      xabrdt.xab$q_rdt = xabdat.xab$q_rdt;
+      fab_out.fab$l_xab = (void *) &xabrdt;
+    }
+
+    rab_in = cc$rms_rab;
+    rab_in.rab$l_fab = &fab_in;
+    rab_in.rab$l_rop = RAB$M_BIO;
+    rab_in.rab$l_ubf = ubf;
+    rab_in.rab$w_usz = sizeof ubf;
+    if (!((sts = sys$connect(&rab_in)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    rab_out = cc$rms_rab;
+    rab_out.rab$l_fab = &fab_out;
+    rab_out.rab$l_rbf = ubf;
+    if (!((sts = sys$connect(&rab_out)) & 1)) {
+      sys$close(&fab_in); sys$close(&fab_out);
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    while ((sts = sys$read(&rab_in))) {  /* always true  */
+      if (sts == RMS$_EOF) break;
+      rab_out.rab$w_rsz = rab_in.rab$w_rsz;
+      if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) {
+        sys$close(&fab_in); sys$close(&fab_out);
+        set_errno(EVMSERR); set_vaxc_errno(sts);
+        return 0;
+      }
+    }
+
+    fab_out.fab$l_fop &= ~FAB$M_DLT;  /* We got this far; keep the output */
+    sys$close(&fab_in);  sys$close(&fab_out);
+    sts = (fab_in.fab$l_sts & 1) ? fab_out.fab$l_sts : fab_in.fab$l_sts;
+    if (!(sts & 1)) {
+      set_errno(EVMSERR); set_vaxc_errno(sts);
+      return 0;
+    }
+
+    return 1;
+
+}  /* end of rmscopy() */
+/*}}}*/
+
+
+/***  The following glue provides 'hooks' to make some of the routines
+ * from this file available from Perl.  These routines are sufficiently
+ * basic, and are required sufficiently early in the build process,
+ * that's it's nice to have them available to miniperl as well as the
+ * full Perl, so they're set up here instead of in an extension.  The
+ * Perl code which handles importation of these names into a given
+ * package lives in [.VMS]Filespec.pm in @INC.
+ */
+
+void
+rmsexpand_fromperl(CV *cv)
+{
+  dXSARGS;
+  char esa[NAM$C_MAXRSS], rsa[NAM$C_MAXRSS], *cp, *out;
+  struct FAB myfab = cc$rms_fab;
+  struct NAM mynam = cc$rms_nam;
+  STRLEN speclen;
+  unsigned long int retsts, haslower = 0;
+
+  myfab.fab$l_fna = SvPV(ST(0),speclen);
+  myfab.fab$b_fns = speclen;
+  myfab.fab$l_nam = &mynam;
+
+  mynam.nam$l_esa = esa;
+  mynam.nam$b_ess = sizeof esa;
+  mynam.nam$l_rsa = rsa;
+  mynam.nam$b_rss = sizeof rsa;
+
+  retsts = sys$parse(&myfab,0,0);
+  if (!(retsts & 1)) {
+    set_vaxc_errno(retsts);
+    if      (retsts == RMS$_PRV) set_errno(EACCES);
+    else if (retsts == RMS$_DEV) set_errno(ENODEV);
+    else if (retsts == RMS$_DIR) set_errno(ENOTDIR);
+    else                         set_errno(EVMSERR);
+    XSRETURN_UNDEF;
+  }
+  retsts = sys$search(&myfab,0,0);
+  if (!(retsts & 1) && retsts != RMS$_FNF) {
+    set_vaxc_errno(retsts);
+    if      (retsts == RMS$_PRV) set_errno(EACCES);
+    else                         set_errno(EVMSERR);
+    XSRETURN_UNDEF;
+  }
+  /* If the input filespec contained any lowercase characters,
+   * downcase the result for compatibility with Unix-minded code. */
+  for (out = myfab.fab$l_fna; *out; out++)
+    if (islower(*out)) { haslower = 1; break; }
+  if (mynam.nam$b_rsl) { out = rsa; speclen = mynam.nam$b_rsl; }
+  else                 { out = esa; speclen = mynam.nam$b_esl; }
+  if (!(mynam.nam$l_fnb & NAM$M_EXP_VER))
+    speclen = mynam.nam$l_type - out;
+  out[speclen] = '\0';
+  if (haslower) __mystrtolower(out);
+
+  ST(0) = sv_2mortal(newSVpv(out, speclen));
+}
+
+void
+vmsify_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *vmsified;
+
+  if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
+  vmsified = do_tovmsspec(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
+  XSRETURN(1);
+}
+
+void
+unixify_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *unixified;
+
+  if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
+  unixified = do_tounixspec(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
+  XSRETURN(1);
+}
+
+void
+fileify_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *fileified;
+
+  if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
+  fileified = do_fileify_dirspec(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
+  XSRETURN(1);
+}
+
+void
+pathify_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *pathified;
+
+  if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
+  pathified = do_pathify_dirspec(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
+  XSRETURN(1);
+}
+
+void
+vmspath_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *vmspath;
+
+  if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
+  vmspath = do_tovmspath(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
+  XSRETURN(1);
+}
+
+void
+unixpath_fromperl(CV *cv)
+{
+  dXSARGS;
+  char *unixpath;
+
+  if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
+  unixpath = do_tounixpath(SvPV(ST(0),na),NULL,1);
+  ST(0) = sv_newmortal();
+  if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
+  XSRETURN(1);
+}
+
+void
+candelete_fromperl(CV *cv)
+{
+  dXSARGS;
+  char fspec[NAM$C_MAXRSS+1], *fsp;
+  SV *mysv;
+  IO *io;
+
+  if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    fsp = fspec;
+  }
+  else {
+    if (mysv != ST(0) || !(fsp = SvPV(mysv,na)) || !*fsp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+
+  ST(0) = cando_by_name(S_IDUSR,0,fsp) ? &sv_yes : &sv_no;
+  XSRETURN(1);
+}
+
+void
+rmscopy_fromperl(CV *cv)
+{
+  dXSARGS;
+  char inspec[NAM$C_MAXRSS+1], outspec[NAM$C_MAXRSS+1], *inp, *outp;
+  int date_flag;
+  struct dsc$descriptor indsc  = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
+                        outdsc = { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+  unsigned long int sts;
+  SV *mysv;
+  IO *io;
+
+  if (items < 2 || items > 3)
+    croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
+
+  mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    inp = inspec;
+  }
+  else {
+    if (mysv != ST(0) || !(inp = SvPV(mysv,na)) || !*inp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+  mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
+  if (SvTYPE(mysv) == SVt_PVGV) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+    outp = outspec;
+  }
+  else {
+    if (mysv != ST(1) || !(outp = SvPV(mysv,na)) || !*outp) {
+      set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
+      ST(0) = &sv_no;
+      XSRETURN(1);
+    }
+  }
+  date_flag = (items == 3) ? SvIV(ST(2)) : 0;
+
+  ST(0) = rmscopy(inp,outp,date_flag) ? &sv_yes : &sv_no;
+  XSRETURN(1);
+}
+
+void
+init_os_extras()
+{
+  char* file = __FILE__;
+
+  newXSproto("VMS::Filespec::rmsexpand",rmsexpand_fromperl,file,"$");
+  newXSproto("VMS::Filespec::vmsify",vmsify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixify",unixify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::pathify",pathify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::fileify",fileify_fromperl,file,"$");
+  newXSproto("VMS::Filespec::vmspath",vmspath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::unixpath",unixpath_fromperl,file,"$");
+  newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");
+  newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
+  return;
+}
+  
+/*  End of vms.c */
diff --git a/gnu/usr.bin/perl/vms/vms_yfix.pl b/gnu/usr.bin/perl/vms/vms_yfix.pl
new file mode 100644
index 00000000000..33af914b25c
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/vms_yfix.pl
@@ -0,0 +1,56 @@
+# This script takes the output produced from perly.y by byacc and
+# the perly.fixer shell script (i.e. the perly.c and perly.h built
+# for Unix systems) and patches them to produce copies containing
+# appropriate declarations for VMS handling of global symbols.
+#
+# If it finds that the input files are already patches for VMS,
+# it just copies the input to the output.
+#
+# Revised 29-Jan-1996 by Charles Bailey  bailey@genetics.upenn.edu
+
+$VERSION = '1.1';
+
+($cinfile,$hinfile,$coutfile,$houtfile) = @ARGV;
+
+open C,$cinfile or die "Can't read $cinfile: $!\n";
+open COUT, ">$coutfile" or die "Can't create $coutfile: $!\n";
+print COUT <<EOH;
+/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */
+EOH
+while (<C>) {
+  # "y.tab.c" is illegal as a VMS filename; DECC 5.2/VAX preprocessor
+  # doesn't like this.
+  if ( s/^#line\s+(\d+)\s+"y.tab.c"/#line $1 "y_tab.c"/ ) { 1; }
+  else {
+    # add the dEXT tag to definitions of global vars, so we'll insert
+    # a globaldef when perly.c is compiled
+    s/^(short|int|YYSTYPE|char \*)\s*yy/dEXT $1 yy/;
+  }
+  print COUT;
+}
+close C;
+close COUT;
+
+open H,$hinfile  or die "Can't read $hinfile: $!\n";
+open HOUT, ">$houtfile" or die "Can't create $houtfile: $!\n";
+print HOUT <<EOH;
+/* Postprocessed by vms_yfix.pl $VERSION to add VMS declarations of globals */
+EOH
+$hfixed = 0;  # keep -w happy
+while (<H>) {
+  $hfixed = /globalref/ unless $hfixed;  # we've already got a fixed copy
+  next if /^extern YYSTYPE yylval/;  # we've got a Unix version, and this
+                                     # is what we want to replace
+  print HOUT;
+}
+close H;
+
+print HOUT <<'EODECL' unless $hfixed;
+#ifndef vax11c
+  extern YYSTYPE yylval;
+#else
+  globalref YYSTYPE yylval;
+#endif
+EODECL
+
+close HOUT;
diff --git a/gnu/usr.bin/perl/vms/vmsish.h b/gnu/usr.bin/perl/vms/vmsish.h
new file mode 100644
index 00000000000..0685985d56e
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/vmsish.h
@@ -0,0 +1,425 @@
+/*  vmsish.h
+ *
+ * VMS-specific C header file for perl5.
+ *
+ * Last revised: 01-Oct-1995 by Charles Bailey  bailey@genetics.upenn.edu
+ * Version: 5.1.6
+ */
+
+#ifndef __vmsish_h_included
+#define __vmsish_h_included
+
+#include <descrip.h> /* for dirent struct definitions */
+#include <libdef.h>  /* status codes for various places */
+#include <rmsdef.h>  /* at which errno and vaxc$errno are */
+#include <ssdef.h>   /* explicitly set in the perl source code */
+
+/* Suppress compiler warnings from DECC for VMS-specific extensions:
+ * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations
+ * ADDRCONSTEXT: initialization of data with non-constant values
+ *               (e.g. pointer fields of descriptors)
+ */
+#ifdef __DECC
+#  pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT)
+#endif
+
+/* Suppress compiler warnings from DECC for VMS-specific extensions:
+ * GLOBALEXT, NOSHAREEXT: global[dr]ef declarations
+ * ADDRCONSTEXT,NEEDCONSTEXT: initialization of data with non-constant values
+ *                            (e.g. pointer fields of descriptors)
+ */
+#ifdef __DECC
+#  pragma message disable (GLOBALEXT,NOSHAREEXT,ADDRCONSTEXT,NEEDCONSTEXT)
+#endif
+
+/* DEC's C compilers and gcc use incompatible definitions of _to(upp|low)er() */
+#ifdef _toupper
+#  undef _toupper
+#endif
+#define _toupper(c) (((c) < 'a' || (c) > 'z') ? (c) : (c) & ~040)
+#ifdef _tolower
+#  undef _tolower
+#endif
+#define _tolower(c) (((c) < 'A' || (c) > 'Z') ? (c) : (c) | 040)
+/* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this
+ * can go away once DECC 1.3 isn't in use any more. */
+#if defined(__ALPHA) && defined(__DECC)
+#undef abs
+#define abs(__x)        __ABS(__x)
+#undef labs
+#define labs(__x)        __LABS(__x)
+#endif /* __ALPHA && __DECC */
+
+/* Assorted things to look like Unix */
+#ifdef __GNUC__
+#ifndef _IOLBF /* gcc's stdio.h doesn't define this */
+#define _IOLBF 1
+#endif
+#endif
+#include <processes.h> /* for vfork() */
+#include <unixio.h>
+#include <unixlib.h>
+#include <file.h>  /* it's not <sys/file.h>, so don't use I_SYS_FILE */
+
+/* Our own contribution to PerlShr's global symbols . . . */
+#ifdef EMBED
+#  define my_trnlnm		Perl_my_trnlnm
+#  define my_getenv		Perl_my_getenv
+#  define my_crypt		Perl_my_crypt
+#  define waitpid		Perl_waitpid
+#  define my_gconvert		Perl_my_gconvert
+#  define do_rmdir		Perl_do_rmdir
+#  define kill_file		Perl_kill_file
+#  define my_utime		Perl_my_utime
+#  define fileify_dirspec	Perl_fileify_dirspec
+#  define fileify_dirspec_ts	Perl_fileify_dirspec_ts
+#  define pathify_dirspec	Perl_pathify_dirspec
+#  define pathify_dirspec_ts	Perl_pathify_dirspec_ts
+#  define tounixspec		Perl_tounixspec
+#  define tounixspec_ts		Perl_tounixspec_ts
+#  define tovmsspec		Perl_tovmsspec
+#  define tovmsspec_ts		Perl_tovmsspec_ts
+#  define tounixpath		Perl_tounixpath
+#  define tounixpath_ts		Perl_tounixpath_ts
+#  define tovmspath		Perl_tovmspath
+#  define tovmspath_ts		Perl_tovmspath_ts
+#  define getredirection	Perl_getredirection
+#  define opendir		Perl_opendir
+#  define readdir		Perl_readdir
+#  define telldir		Perl_telldir
+#  define seekdir		Perl_seekdir
+#  define closedir		Perl_closedir
+#  define vmsreaddirversions	Perl_vmsreaddirversions
+#  define getredirection	Perl_getredirection
+#  define my_gmtime		Perl_my_gmtime
+#  define cando_by_name		Perl_cando_by_name
+#  define flex_fstat		Perl_flex_fstat
+#  define flex_stat		Perl_flex_stat
+#  define trim_unixpath		Perl_trim_unixpath
+#  define vms_do_aexec		Perl_vms_do_aexec
+#  define vms_do_exec		Perl_vms_do_exec
+#  define do_aspawn		Perl_do_aspawn
+#  define do_spawn		Perl_do_spawn
+#  define my_fwrite		Perl_my_fwrite
+#  define my_getpwnam		Perl_my_getpwnam
+#  define my_getpwuid		Perl_my_getpwuid
+#  define my_getpwent		Perl_my_getpwent
+#  define my_endpwent		Perl_my_endpwent
+#  define my_getlogin		Perl_my_getlogin
+#  define rmscopy		Perl_rmscopy
+#  define init_os_extras	Perl_init_os_extras
+#endif
+
+/* Delete if at all possible, changing protections if necessary. */
+#define unlink kill_file
+
+/*  The VMS C RTL has vfork() but not fork().  Both actually work in a way
+ *  that's somewhere between Unix vfork() and VMS lib$spawn(), so it's
+ *  probably not a good idea to use them much.  That said, we'll try to
+ *  use vfork() in either case.
+ */
+#define fork vfork
+
+/* Macros to set errno using the VAX thread-safe calls, if present */
+#if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
+#  define set_errno(v)      (cma$tis_errno_set_value(v))
+#  define set_vaxc_errno(v) (vaxc$errno = (v))
+#else
+#  define set_errno(v)      (errno = (v))
+#  define set_vaxc_errno(v) (vaxc$errno = (v))
+#endif
+
+/* Handy way to vet calls to VMS system services and RTL routines. */
+#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
+  if (!((__ckvms_sts=(call))&1)) { \
+  set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
+  croak("Fatal VMS error (status=%d) at %s, line %d", \
+  __ckvms_sts,__FILE__,__LINE__); } } STMT_END
+
+#ifdef VMS_DO_SOCKETS
+#include "sockadapt.h"
+#endif
+
+#define BIT_BUCKET "_NLA0:"
+#define PERL_SYS_INIT(c,v)  getredirection((c),(v))
+#define PERL_SYS_TERM()
+#define dXSUB_SYS int dummy
+#define HAS_KILL
+#define HAS_WAIT
+
+/* VMS:
+ *	This symbol, if defined, indicates that the program is running under
+ *	VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
+ * Just in case, however . . . */
+#ifndef VMS
+#define VMS		/**/
+#endif
+
+/* HAS_IOCTL:
+ *	This symbol, if defined, indicates that the ioctl() routine is
+ *	available to set I/O characteristics
+ */
+#undef	HAS_IOCTL		/**/
+ 
+/* HAS_UTIME:
+ *	This symbol, if defined, indicates that the routine utime() is
+ *	available to update the access and modification times of files.
+ */
+#define HAS_UTIME		/**/
+
+/* HAS_GROUP
+ *	This symbol, if defined, indicates that the getgrnam(),
+ *	getgrgid(), and getgrent() routines are available to 
+ *	get group entries.
+ */
+#undef HAS_GROUP		/**/
+
+/* HAS_PASSWD
+ *	This symbol, if defined, indicates that the getpwnam(),
+ *	getpwuid(), and getpwent() routines are available to 
+ *	get password entries.
+ */
+#define HAS_PASSWD		/**/
+
+#define HAS_KILL
+#define HAS_WAIT
+  
+/*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+#define fwrite1 my_fwrite
+
+/* Use our own rmdir() */
+#define rmdir(name) do_rmdir(name)
+
+/* Assorted fiddling with sigs . . . */
+# include <signal.h>
+#define ABORT() abort()
+
+/* Used with our my_utime() routine in vms.c */
+struct utimbuf {
+  time_t actime;
+  time_t modtime;
+};
+#define utime my_utime
+
+/* This is what times() returns, but <times.h> calls it tbuffer_t on VMS */
+
+struct tms {
+  clock_t tms_utime;    /* user time */
+  clock_t tms_stime;    /* system time - always 0 on VMS */
+  clock_t tms_cutime;   /* user time, children */
+  clock_t tms_cstime;   /* system time, children - always 0 on VMS */
+};
+
+/* Prior to VMS 7.0, the CRTL gmtime() routine was a stub which always
+ * returned NULL.  Substitute our own routine, which uses the logical
+ * SYS$TIMEZONE_DIFFERENTIAL, whcih the native UTC support routines
+ * in VMS 6.0 or later use.*
+ */
+#define gmtime(t) my_gmtime(t)
+
+/* VMS doesn't use a real sys_nerr, but we need this when scanning for error
+ * messages in text strings . . .
+ */
+
+#define sys_nerr EVMSERR  /* EVMSERR is as high as we can go. */
+
+/* Look up new %ENV values on the fly */
+#define DYNAMIC_ENV_FETCH 1
+#define ENV_HV_NAME "%EnV%VmS%"
+
+/* Thin jacket around cuserid() tomatch Unix' calling sequence */
+#define getlogin my_getlogin
+
+/* Ditto for sys$hash_passwrod() . . . */
+#define crypt  my_crypt
+
+/* Use our own stat() clones, which handle Unix-style directory names */
+#define Stat(name,bufptr) flex_stat(name,bufptr)
+#define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
+
+/* By default, flush data all the way to disk, not just to RMS buffers */
+#define Fflush(fp) ((fflush(fp) || fsync(fileno(fp))) ? EOF : 0)
+
+/* Setup for the dirent routines:
+ * opendir(), closedir(), readdir(), seekdir(), telldir(), and
+ * vmsreaddirversions(), and preprocessor stuff on which these depend:
+ *    Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
+ *    This code has no copyright.
+ */
+    /* Data structure returned by READDIR(). */
+struct dirent {
+    char	d_name[256];		/* File name		*/
+    int		d_namlen;			/* Length of d_name */
+    int		vms_verscount;		/* Number of versions	*/
+    int		vms_versions[20];	/* Version numbers	*/
+};
+
+    /* Handle returned by opendir(), used by the other routines.  You
+     * are not supposed to care what's inside this structure. */
+typedef struct _dirdesc {
+    long			context;
+    int				vms_wantversions;
+    unsigned long int           count;
+    char			*pattern;
+    struct dirent		entry;
+    struct dsc$descriptor_s	pat;
+} DIR;
+
+#define rewinddir(dirp)		seekdir((dirp), 0)
+
+/* used for our emulation of getpw* */
+struct passwd {
+        char    *pw_name;    /* Username */
+        char    *pw_passwd;
+        Uid_t   pw_uid;      /* UIC member number */
+        Gid_t   pw_gid;      /* UIC group  number */
+        char    *pw_comment; /* Default device/directory (Unix-style) */
+        char    *pw_gecos;   /* Owner */
+        char    *pw_dir;     /* Default device/directory (VMS-style) */
+        char    *pw_shell;   /* Default CLI name (eg. DCL) */
+};
+#define pw_unixdir pw_comment  /* Default device/directory (Unix-style) */
+#define getpwnam my_getpwnam
+#define getpwuid my_getpwuid
+#define getpwent my_getpwent
+#define endpwent my_endpwent
+#define setpwent my_endpwent
+
+/* Our own stat_t substitute, since we play with st_dev and st_ino -
+ * we want atomic types so Unix-bound code which compares these fields
+ * for two files will work most of the time under VMS.
+ * N.B. 1. The st_ino hack assumes that sizeof(unsigned short[3]) ==
+ * sizeof(unsigned) + sizeof(unsigned short).  We can't use a union type
+ * to map the unsigned int we want and the unsigned short[3] the CRTL
+ * returns into the same member, since gcc has different ideas than DECC
+ * and VAXC about sizing union types.
+ * N.B 2. The routine cando() in vms.c assumes that &stat.st_ino is the
+ * address of a FID.
+ */
+/* First, grab the system types, so we don't clobber them later */
+#include <stat.h>
+/* Since we've got to match the size of the CRTL's stat_t, we need
+ * to mimic DECC's alignment settings.
+ */
+#if defined(__DECC) || defined(__DECCXX)
+#  pragma __member_alignment __save
+#  pragma __nomember_alignment
+#endif
+#if defined(__DECC) 
+#  pragma __message __save
+#  pragma __message disable (__MISALGNDSTRCT)
+#  pragma __message disable (__MISALGNDMEM)
+#endif
+struct mystat
+{
+        char *st_devnam;  /* pointer to device name */
+        unsigned st_ino;    /* hack - CRTL uses unsigned short[3] for */
+        unsigned short rvn; /* FID (num,seq,rvn) */
+        unsigned short st_mode;	/* file "mode" i.e. prot, dir, reg, etc. */
+        int	st_nlink;	/* for compatibility - not really used */
+        unsigned st_uid;	/* from ACP - QIO uic field */
+        unsigned short st_gid;	/* group number extracted from st_uid */
+        dev_t   st_rdev;	/* for compatibility - always zero */
+        off_t   st_size;	/* file size in bytes */
+        unsigned st_atime;	/* file access time; always same as st_mtime */
+        unsigned st_mtime;	/* last modification time */
+        unsigned st_ctime;	/* file creation time */
+        char	st_fab_rfm;	/* record format */
+        char	st_fab_rat;	/* record attributes */
+        char	st_fab_fsz;	/* fixed header size */
+        unsigned st_dev;	/* encoded device name */
+};
+#define stat mystat
+typedef unsigned mydev_t;
+#define dev_t mydev_t
+typedef unsigned myino_t;
+#define ino_t myino_t
+#if defined(__DECC) || defined(__DECCXX)
+#  pragma __member_alignment __restore
+#endif
+#if defined(__DECC) 
+#  pragma __message __restore
+#endif
+/* Cons up a 'delete' bit for testing access */
+#define S_IDUSR (S_IWUSR | S_IXUSR)
+#define S_IDGRP (S_IWGRP | S_IXGRP)
+#define S_IDOTH (S_IWOTH | S_IXOTH)
+
+/* Prototypes for functions unique to vms.c.  Don't include replacements
+ * for routines in the mainline source files excluded by #ifndef VMS;
+ * their prototypes are already in proto.h.
+ *
+ * In order to keep Gen_ShrFls.Pl happy, functions which are to be made
+ * available to images linked to PerlShr.Exe must be declared between the
+ * __VMS_PROTOTYPES__ and __VMS_SEPYTOTORP__ lines, and must be in the form
+ *    <data type><TAB>name<WHITESPACE>_((<prototype args>));
+ */
+/* prototype section start marker; `typedef' passes through cpp */
+typedef char  __VMS_PROTOTYPES__;
+int	my_trnlnm _((char *, char *, unsigned long int));
+char *	my_getenv _((char *));
+char *	my_crypt _((const char *, const char *));
+unsigned long int	waitpid _((unsigned long int, int *, int));
+char *	my_gconvert _((double, int, int, char *));
+int	do_rmdir _((char *));
+int	kill_file _((char *));
+int	my_utime _((char *, struct utimbuf *));
+char *	fileify_dirspec _((char *, char *));
+char *	fileify_dirspec_ts _((char *, char *));
+char *	pathify_dirspec _((char *, char *));
+char *	pathify_dirspec_ts _((char *, char *));
+char *	tounixspec _((char *, char *));
+char *	tounixspec_ts _((char *, char *));
+char *	tovmsspec _((char *, char *));
+char *	tovmsspec_ts _((char *, char *));
+char *	tounixpath _((char *, char *));
+char *	tounixpath_ts _((char *, char *));
+char *	tovmspath _((char *, char *));
+char *	tovmspath_ts _((char *, char *));
+void	getredirection _(());
+DIR *	opendir _((char *));
+struct dirent *	readdir _((DIR *));
+long	telldir _((DIR *));
+void	seekdir _((DIR *, long));
+void	closedir _((DIR *));
+void	vmsreaddirversions _((DIR *, int));
+void	getredirection _((int *, char ***));
+struct tm *my_gmtime _((const time_t *));
+I32	cando_by_name _((I32, I32, char *));
+int	flex_fstat _((int, struct stat *));
+int	flex_stat _((char *, struct stat *));
+int	trim_unixpath _((char *, char*));
+bool	vms_do_aexec _((SV *, SV **, SV **));
+bool	vms_do_exec _((char *));
+unsigned long int	do_aspawn _((SV *, SV **, SV **));
+unsigned long int	do_spawn _((char *));
+int	my_fwrite _((void *, size_t, size_t, FILE *));
+struct passwd *	my_getpwnam _((char *name));
+struct passwd *	my_getpwuid _((Uid_t uid));
+struct passwd *	my_getpwent _(());
+void	my_endpwent _(());
+char *	my_getlogin _(());
+int	rmscopy _((char *, char *, int));
+void	init_os_extras _(());
+typedef char __VMS_SEPYTOTORP__;
+/* prototype section end marker; `typedef' passes through cpp */
+
+#ifndef VMS_DO_SOCKETS
+/* This relies on tricks in perl.h to pick up that these manifest constants
+ * are undefined and set up conversion routines.  It will then redefine
+ * these manifest constants, so the actual values will match config.h
+ */
+#undef HAS_HTONS
+#undef HAS_NTOHS
+#undef HAS_HTONL
+#undef HAS_NTOHL
+#endif
+
+#define TMPPATH "sys$scratch:perl-eXXXXXX"
+
+#endif  /* __vmsish_h_included */
diff --git a/gnu/usr.bin/perl/vms/writemain.pl b/gnu/usr.bin/perl/vms/writemain.pl
new file mode 100644
index 00000000000..eb059f810a7
--- /dev/null
+++ b/gnu/usr.bin/perl/vms/writemain.pl
@@ -0,0 +1,70 @@
+#!./miniperl
+#
+# Create perlmain.c from miniperlmain.c, adding code to boot the
+# extensions listed on the command line.  In addition, create a
+# linker options file which causes the bootstrap routines for
+# these extension to be universal symbols in PerlShr.Exe.
+#
+# Last modified 29-Nov-1994 by Charles Bailey  bailey@genetics.upenn.edu
+#
+
+if (-f 'miniperlmain.c') { $dir = ''; }
+elsif (-f '../miniperlmain.c') { $dir = '../'; }
+else { die "$0: Can't find miniperlmain.c\n"; }
+
+open (IN,"${dir}miniperlmain.c")
+  || die "$0: Can't open ${dir}miniperlmain.c: $!\n";
+open (OUT,">${dir}perlmain.c")
+  || die "$0: Can't open ${dir}perlmain.c: $!\n";
+
+while (<IN>) {
+  print OUT;
+  last if /Do not delete this line--writemain depends on it/;
+}
+$ok = !eof(IN);
+close IN;
+
+if (!$ok) {
+  close OUT;
+  unlink "${dir}perlmain.c";
+  die "$0: Can't find marker line in ${dir}miniperlmain.c - aborting\n";
+}
+
+
+print OUT <<'EOH';
+
+static void
+xs_init()
+{
+    dXSUB_SYS;
+EOH
+
+if (@ARGV) {
+  # Allow for multiple names in one quoted group
+  @exts = split(/\s+/, join(' ',@ARGV));
+}
+
+if (@exts) {
+  print OUT "    char *file = __FILE__;\n";
+  foreach $ext (@exts) {
+    my($subname) = $ext;
+    $subname =~ s/::/__/g;
+    print OUT "extern void	boot_${subname} _((CV* cv));\n"
+  }
+  foreach $ext (@exts) {
+    my($subname) = $ext;
+    $subname =~ s/::/__/g;
+    print "Adding $ext . . .\n";
+    if ($ext eq 'DynaLoader') {
+      # Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+      # boot_DynaLoader is called directly in DynaLoader.pm
+      print OUT "    newXS(\"${ext}::boot_${ext}\", boot_${subname}, file);\n"
+    }
+    else {
+      print OUT "    newXS(\"${ext}::bootstrap\", boot_${subname}, file);\n"
+    }
+  }
+}
+
+print OUT "}\n";
+close OUT;
diff --git a/gnu/usr.bin/perl/writemain.SH b/gnu/usr.bin/perl/writemain.SH
new file mode 100644
index 00000000000..4884a387a17
--- /dev/null
+++ b/gnu/usr.bin/perl/writemain.SH
@@ -0,0 +1,104 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting writemain (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+$spitshell >writemain <<!GROK!THIS!
+$startsh
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>writemain <<'!NO!SUBS!'
+# This script takes the plain miniperlmain.c and writes out perlmain.c
+# which includes all the extensions.
+# The command line arguments name extensions to be used.
+#  E.g.:  sh writemain SDBM_File POSIX > perlmain.c
+#
+
+orig="$*"
+args=''
+: Remove any .a suffixes and any leading path components
+for file in `echo $orig | sed 's/\.a//g'` ; do
+	case "$file" in
+	ext/*)	file=`echo $file | sed 's:ext/\(.*\)/[^/]*:\1:'`
+		;;
+	lib/auto/*)	file=`echo $file | sed 's:lib/auto/\(.*\)/[^/]*:\1:'`
+		;;
+	*/*)
+		file=`expr X$file : 'X.*/\(.*\)'`
+		;;
+	esac
+	args="$args $file"
+done
+
+
+sed '/Do not delete this line--writemain depends on it/q' miniperlmain.c
+
+
+if test X"$args" != "X" ; then
+    for ext in $args ; do
+: $ext will either be 'Name' or 'Name1/Name2' etc
+: convert ext into cname and mname
+mname=`echo $ext   | sed 's!/!::!g'`
+cname=`echo $mname | sed 's!:!_!g'`
+
+echo "EXTERN_C void boot_${cname} _((CV* cv));"
+    done
+fi
+
+cat << 'EOP'
+
+static void
+xs_init()
+{
+  dXSUB_SYS;
+EOP
+
+if test X"$args" != "X" ; then
+    echo "    char *file = __FILE__;"
+    ai=''
+
+    for ext in $args ; do
+
+	: $ext will either be 'Name' or 'Name1/Name2' etc
+	: convert ext into cname and mname
+	mname=`echo $ext   | sed 's!/!::!g'`
+	cname=`echo $mname | sed 's!:!_!g'`
+
+	echo "    {"
+	if test "$ext" = "DynaLoader"; then
+	    : Must NOT install 'DynaLoader::boot_DynaLoader' as 'bootstrap'!
+	    : boot_DynaLoader is called directly in DynaLoader.pm
+	    echo "        newXS(\"${mname}::boot_${ext}\", boot_${cname}, file);"
+	else
+	    echo "        newXS(\"${mname}::bootstrap\", boot_${cname}, file);"
+	fi
+	echo "    }"
+    done
+fi
+
+cat << 'EOP'
+}
+EOP
+
+!NO!SUBS!
+chmod 755 writemain
+$eunicefix writemain
diff --git a/gnu/usr.bin/perl/x2p/EXTERN.h b/gnu/usr.bin/perl/x2p/EXTERN.h
new file mode 100644
index 00000000000..e4abe5f87b5
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/EXTERN.h
@@ -0,0 +1,17 @@
+/* $RCSfile: EXTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:05 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	EXTERN.h,v $
+ */
+
+#undef EXT
+#define EXT extern
+
+#undef INIT
+#define INIT(x)
+
+#undef DOINIT
diff --git a/gnu/usr.bin/perl/x2p/INTERN.h b/gnu/usr.bin/perl/x2p/INTERN.h
new file mode 100644
index 00000000000..aa3af58c8dc
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/INTERN.h
@@ -0,0 +1,17 @@
+/* $RCSfile: INTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:06 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	INTERN.h,v $
+ */
+
+#undef EXT
+#define EXT
+
+#undef INIT
+#define INIT(x) = x
+
+#define DOINIT
diff --git a/gnu/usr.bin/perl/x2p/Makefile.SH b/gnu/usr.bin/perl/x2p/Makefile.SH
new file mode 100644
index 00000000000..16e282d4970
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/Makefile.SH
@@ -0,0 +1,159 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+
+echo "Extracting x2p/Makefile (with variable substitutions)"
+rm -f Makefile
+cat >Makefile <<!GROK!THIS!
+# $RCSfile: Makefile.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:07 $
+#
+# $Log:	Makefile.SH,v $
+
+CC = $cc
+BYACC = $byacc
+LDFLAGS = $ldflags
+SMALL = $small
+LARGE = $large $split
+mallocsrc = $mallocsrc
+mallocobj = $mallocobj
+shellflags = $shellflags
+
+libs = $libs
+
+# These variables will be used in a future version to make
+# the make file more portable to non-unix systems.
+AR = $ar
+EXE_EXT = $exe_ext
+LIB_EXT = $lib_ext
+OBJ_EXT = $obj_ext
+PATH_SEP = $path_sep
+
+FIRSTMAKEFILE = $firstmakefile
+
+.SUFFIXES: .c \$(OBJ_EXT)
+
+!GROK!THIS!
+
+cat >>Makefile <<'!NO!SUBS!'
+
+CCCMD = `sh $(shellflags) cflags $@`
+
+public = a2p s2p find2perl
+
+private = 
+
+manpages = a2p.man s2p.man
+
+util =
+
+sh = Makefile.SH cflags.SH
+shextract = Makefile cflags
+
+pl = find2perl.PL s2p.PL
+plextract = find2perl s2p
+
+addedbyconf = $(shextract) $(plextract)
+
+h = EXTERN.h INTERN.h ../config.h handy.h hash.h a2p.h str.h util.h
+
+c = hash.c $(mallocsrc) str.c util.c walk.c
+
+obj = hash$(OBJ_EXT) $(mallocobj) str$(OBJ_EXT) util$(OBJ_EXT) walk$(OBJ_EXT)
+
+lintflags = -phbvxac
+
+# grrr
+SHELL = /bin/sh
+
+.c$(OBJ_EXT):
+	$(CCCMD) $*.c
+
+all: $(public) $(private) $(util)
+	touch all
+
+a2p: $(obj) a2p$(OBJ_EXT)
+	$(CC) $(LDFLAGS) $(obj) a2p$(OBJ_EXT) $(libs) -o a2p
+
+# I now supply a2p.c with the kits, so the following section is
+# used only if you force byacc to run by saying
+# make  run_byacc
+
+run_byacc:	FORCE
+	@ echo Expect many shift/reduce and reduce/reduce conflicts
+	$(BYACC) a2p.y
+	mv y.tab.c a2p.c
+
+# We don't want to regenerate a2p.c, but it might appear out-of-date
+# after a patch is applied or a new distribution is made.
+a2p.c: a2p.y
+	-@touch a2p.c
+
+a2p$(OBJ_EXT): a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
+	$(CCCMD) $(LARGE) a2p.c
+
+clean:
+	rm -f a2p *$(OBJ_EXT)
+
+realclean: clean
+	rm -f *.orig core $(addedbyconf) all malloc.c
+	rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old
+
+# The following lint has practically everything turned on.  Unfortunately,
+# you have to wade through a lot of mumbo jumbo that can't be suppressed.
+# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
+# for that spot.
+
+lint:
+	lint $(lintflags) $(defs) $(c) > a2p.fuzz
+
+depend: $(mallocsrc) ../makedepend
+	sh ../makedepend
+
+clist:
+	echo $(c) | tr ' ' '\012' >.clist
+
+hlist:
+	echo $(h) | tr ' ' '\012' >.hlist
+
+shlist:
+	echo $(sh) | tr ' ' '\012' >.shlist
+
+# These should be automatically generated
+
+$(plextract):
+	../miniperl -I../lib $@.PL
+
+malloc.c: ../malloc.c
+	rm -f malloc.c
+	sed <../malloc.c >malloc.c \
+	    -e 's/"perl.h"/"..\/perl.h"/' \
+	    -e 's/my_exit/exit/'
+
+# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
+$(obj):
+	@ echo "You haven't done a "'"make depend" yet!'; exit 1
+makedepend: depend
+!NO!SUBS!
+$eunicefix Makefile
+case `pwd` in
+*SH)
+    $rm -f ../Makefile
+    $ln Makefile ../Makefile
+    ;;
+esac
+rm -f $firstmakefile
diff --git a/gnu/usr.bin/perl/x2p/a2p.c b/gnu/usr.bin/perl/x2p/a2p.c
new file mode 100644
index 00000000000..c6d21e3e4de
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.c
@@ -0,0 +1,2666 @@
+#ifndef lint
+static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91";
+#endif
+#define YYBYACC 1
+#line 2 "a2p.y"
+/* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	a2p.y,v $
+ */
+
+#include "INTERN.h"
+#include "a2p.h"
+
+int root;
+int begins = Nullop;
+int ends = Nullop;
+
+#line 24 "y.tab.c"
+#define BEGIN 257
+#define END 258
+#define REGEX 259
+#define SEMINEW 260
+#define NEWLINE 261
+#define COMMENT 262
+#define FUN1 263
+#define FUNN 264
+#define GRGR 265
+#define PRINT 266
+#define PRINTF 267
+#define SPRINTF 268
+#define SPLIT 269
+#define IF 270
+#define ELSE 271
+#define WHILE 272
+#define FOR 273
+#define IN 274
+#define EXIT 275
+#define NEXT 276
+#define BREAK 277
+#define CONTINUE 278
+#define RET 279
+#define GETLINE 280
+#define DO 281
+#define SUB 282
+#define GSUB 283
+#define MATCH 284
+#define FUNCTION 285
+#define USERFUN 286
+#define DELETE 287
+#define ASGNOP 288
+#define OROR 289
+#define ANDAND 290
+#define NUMBER 291
+#define VAR 292
+#define SUBSTR 293
+#define INDEX 294
+#define MATCHOP 295
+#define RELOP 296
+#define OR 297
+#define STRING 298
+#define UMINUS 299
+#define NOT 300
+#define INCR 301
+#define DECR 302
+#define FIELD 303
+#define VFIELD 304
+#define YYERRCODE 256
+short yylhs[] = {                                        -1,
+    0,    3,    6,    6,    2,    2,    7,    7,    7,    7,
+    7,    7,    9,    8,    8,   11,   11,   11,   11,   11,
+   15,   15,   15,   15,   14,   14,   14,   14,   13,   13,
+   13,   13,   12,   12,   12,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   16,   16,   16,   16,   16,   16,   16,   16,   16,
+   16,   17,   17,   17,   17,   10,   10,   10,   18,   18,
+   18,    1,    1,   19,   19,   19,   19,    4,    4,   20,
+   20,   21,   21,   21,   21,    5,    5,   22,   22,   22,
+   22,   25,   25,   23,   23,   23,   23,   23,   23,   23,
+   23,   23,   23,   23,   23,   23,   26,   26,   26,   24,
+   24,   24,   24,   24,   24,   24,   24,
+};
+short yylen[] = {                                         2,
+    2,    6,    5,    2,    3,    0,    1,    5,   10,    4,
+    1,    1,    1,    1,    3,    1,    1,    1,    1,    5,
+    3,    4,    4,    2,    3,    3,    3,    3,    3,    3,
+    1,    3,    1,    2,    3,    1,    1,    1,    3,    3,
+    3,    3,    3,    3,    3,    5,    2,    2,    2,    2,
+    2,    2,    3,    1,    2,    3,    4,    3,    4,    1,
+    3,    4,    4,    4,    2,    8,    6,    8,    8,    6,
+    6,    6,    6,    6,    6,    6,    6,    8,    8,    8,
+    8,    1,    4,    1,    2,    1,    1,    0,    4,    4,
+    3,    2,    0,    1,    1,    1,    1,    2,    0,    1,
+    1,    2,    2,    2,    2,    2,    0,    3,    2,    2,
+    1,    1,    0,    1,    4,    2,    4,    2,    1,    1,
+    1,    2,    1,    1,    2,    5,    1,    1,    1,    6,
+    9,    6,    7,   10,    9,    6,    5,
+};
+short yydefred[] = {                                     93,
+    0,    0,   95,   96,   97,   94,    0,   92,    0,    0,
+   31,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   37,    0,    0,    0,   38,    0,    0,    0,    0,
+    0,   84,    0,   99,    0,   11,    0,   93,    0,    0,
+    0,   17,   18,   19,    0,    0,   99,   99,    0,    0,
+    0,   65,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   24,   49,
+   50,    0,    0,    0,    0,    0,    0,    4,    0,   99,
+    0,   99,   99,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   47,   48,
+    0,    0,   61,    0,    0,    0,    0,   99,   99,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  100,  101,    0,   98,   53,   32,   28,   21,
+    0,    0,    0,    0,    0,   30,    0,    0,    0,    0,
+   45,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   62,   63,   91,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   13,   64,   83,    0,    0,   99,
+    0,    0,    0,    0,    0,    0,  120,  119,  123,    0,
+   99,    0,   99,   10,   99,    0,  106,    0,  111,    0,
+    0,    0,   22,   59,   93,    3,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   99,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   99,   99,   99,   99,   99,    8,    0,    0,   70,    0,
+   75,    0,   74,    0,   77,    0,   76,    0,   72,   73,
+    0,   67,    0,   71,  128,  127,  129,    0,    0,    0,
+    0,    0,  112,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   99,    0,
+    0,    0,   99,   99,   99,    0,    0,    0,   99,   69,
+   68,   79,   78,   81,   80,    0,   66,    0,    0,    0,
+    0,    0,    0,  126,    0,    0,    0,  132,  136,    0,
+    0,    0,    9,   99,   99,    0,  133,    0,    0,   99,
+  131,  135,    0,  134,
+};
+short yydgoto[] = {                                       1,
+    2,    7,   36,   73,  125,   37,   38,   39,  164,   52,
+   53,   41,   42,   43,   44,   45,   46,   55,    8,  126,
+  225,  187,  188,  189,  254,  248,
+};
+short yysindex[] = {                                      0,
+    0,  -48,    0,    0,    0,    0, 6619,    0, -121, -110,
+    0,   -4,   32, 4183,   38,   30,   51,   64,   68, -260,
+   70,    0,  -61,   82,   83,    0, 4448, 4448, 4448, -183,
+ -183,    0, 4448,    0, 4448,    0, -188,    0,    3,   22,
+ 6884,    0,    0,    0,   34, -213,    0,    0, 2061, 4183,
+ 4183,    0,  -49, 5612,   85, 4448, 4448,   14, 4713, 6753,
+ 4448,   87, 4183, 4183, 4448, 4448,  -77,  -77,    0,    0,
+    0,   18, -192,  -36,   91,   92,   95,    0,  -48,    0,
+ 4448,    0,    0, 4448, 6980, 4448, 4448, 4448,   34, -154,
+ 4448, 4448, 4448, 4448, 4448, 4448, -135, 4448,    0,    0,
+ -192, -192,    0, 5658,  106, 5612,   11,    0,    0, 5704,
+  186, 4448,  113, 5751,  115, 5805, 5885, 4183,  114,   67,
+ 5931, 5978,    0,    0, 4572,    0,    0,    0,    0,    0,
+ -192, 6032, 1964, 1964,  -49,    0, 3230,  186,  186,  186,
+    0,   97,   97,  -77,  -77,  -77,  -77, -183,  -49, 4665,
+ 4765,    0,    0,    0, 1964, 1964, -131,  186, 4448, 4448,
+ 4448, 4448, 7026,  121,    0,    0,    0, 4448, 4448,    0,
+ 4183, 4183,  124,  125,  132, 4448,    0,    0,    0, 4448,
+    0, -117,    0,    0,    0, 6884,    0,  -44,    0, 4837,
+ 4448, -114,    0,    0,    0,    0, 6884, 6884,   13, 3635,
+ 5295, 5367, 5506,  137, 6078,    0, 5560, 6243, -192,  -59,
+  -59, 4448, 4448, 5241, 6884, 6884, 3701,   93, -192, -192,
+    0,    0,    0,    0,    0,    0, 6884,  -48,    0, 7084,
+    0, 4448,    0, 4448,    0, 4448,    0, 4448,    0,    0,
+ -119,    0, 4448,    0,    0,    0,    0, 4448, 4448,  -34,
+  -16, 6343,    0,  123,  -89, 4183, 4930, -192, -192, -192,
+ -192, -192,  144, 6389, 6435, 6508, 6554, 6700,    0, 6819,
+ 6884, 6884,    0,    0,    0, 6930,  146,   94,    0,    0,
+    0,    0,    0,    0,    0, -192,    0, 3701, 3701, 3701,
+ 5241,  -53, 4448,    0, -192, 5030,  -83,    0,    0,  148,
+ 5241,  -13,    0,    0,    0,  149,    0, 3701, 3701,    0,
+    0,    0, 3701,    0,
+};
+short yyrindex[] = {                                      0,
+    0, 2015,    0,    0,    0,    0,  192,    0,    0,    0,
+    0,   56,    0, 3424,    0, 2619,    0,    0,    0,    0,
+    0,    0,    1,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0, 2147,    0, 2195, 1676,
+ 3509,    0,    0,    0, 1782, 1340,    0,    0,    0,  152,
+    0,    0,    0, 3829,  111,    0,    0,  381,    0,    0,
+    0,    0,  152,  101,    0,    0,  564,  834,    0,    0,
+    0,  436, 5102,    0,  -47,   39,   42,    0, 2245,    0,
+    0,    0,    0,    0,    0,    0,    0,    0, 1830,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+ 5102, 5102,    0,   72,    0,   17,    0,    0,    0,   72,
+ 2718,    0,   74,   72,   74,   72,   72,  152,    0,    0,
+   72,   72,    0,    0,    0,    0,    0,    0,    0,    0,
+ 5102,   72,    0,    0, 1882,    0, 3464, 3057, 3097, 3145,
+    0, 1468, 1734,  888,  942, 1016, 1286, 2564, 1395,    0,
+    0,    0,    0,    0,    0,    0,    0, 3185,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+  538,  538,    0,    0,    0,  122,    0,    0,    0,  241,
+    0,    0,    0,    0,    0,  -41,    0,    0,    0,    0,
+    0,  491,    0,    0,    0,    0, 3549, 3594,    0,   72,
+   72,   72,   72,   74,   72,    0,   72,   72, 3866,  296,
+  357,    0,    0,  136,  -10,  169,    0,    0, 5102, 3970,
+    0,    0,    0,    0,    0,    0, 3784, 2294,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,  -51,    0,    0,    0,  101,    0, 4038, 4135, 4235,
+ 4307, 4400,   74,   72,   72,   72,   72,   72,    0,   72,
+  507,  553,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0, 5102,    0,    0,    0,    0,
+  155,    0,    0,    0, 4500,    0, 5195,    0,    0,    0,
+  155,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,
+};
+short yygindex[] = {                                      0,
+  -18,    0,    0, 7251,  -19,    0,    0,    0,    0,  -31,
+   33, 2875,  -14,  -12,   16, 7373,   76,  147,    0,    0,
+    0,  231, -205,    0, -267,   -9,
+};
+#define YYTABLESIZE 7645
+short yytable[] = {                                     114,
+   82,   47,  246,  269,  127,  301,  273,  114,  253,   81,
+    6,   16,   48,   81,  224,   17,   96,  114,  105,   79,
+   75,   16,   76,  300,  274,   62,   81,  307,   81,   64,
+  122,  119,  120,  306,   97,   49,   75,   82,   76,   40,
+   82,   82,   82,   82,   82,   82,   81,   82,  122,   81,
+   77,  154,   16,  229,  109,   60,  230,   16,   82,   82,
+   82,   69,   82,   82,  247,   84,   77,   74,  123,  124,
+   95,   50,   78,  112,   98,   93,   91,   56,   92,   16,
+   94,  150,  151,   74,   81,  253,  165,   99,  100,   57,
+   59,   58,   60,   82,   82,  253,   60,   60,   60,   60,
+   60,   18,   60,   60,   19,   70,   71,   61,   23,   63,
+   87,  190,   82,   60,   60,   60,  135,   60,   60,   32,
+   33,   65,   66,   82,   82,   80,  118,   96,  109,   97,
+  149,  128,  129,   95,   16,  130,   31,  141,   93,  210,
+  211,  123,  124,   94,  148,   97,  153,   87,   60,   60,
+   87,   87,   87,   87,  166,   87,  159,   87,  161,  167,
+  199,  206,  121,  212,  213,  192,  193,   60,   87,   87,
+   87,  214,   87,   87,  218,   83,  228,  239,   60,   60,
+  121,  276,  277,  256,  280,  293,  294,  304,  305,  310,
+   96,    1,   88,   88,  113,  113,    0,  107,    0,  257,
+    0,  249,    0,   87,   87,  245,    0,    0,   97,  125,
+    0,    3,    4,    5,    0,  221,  222,  223,  114,  114,
+  114,    0,   87,  194,  278,   35,    0,  125,   27,    0,
+   28,   16,    0,   87,   87,   82,   83,   16,   16,   82,
+   83,   17,   17,    0,  250,  251,    0,   16,   16,  122,
+  122,  122,   82,   83,   82,   83,    0,   82,   82,   82,
+   82,   82,   82,   82,   82,   82,  296,    0,   82,   82,
+    0,    0,   82,   83,   82,   82,   83,    0,   16,   16,
+   82,  124,   82,   82,   82,   82,   82,    0,   82,   82,
+   82,   82,   82,   82,   82,   82,   82,    0,   82,  124,
+   82,   82,   82,   82,   82,   16,   16,   90,  292,    0,
+   82,   83,   60,   60,   60,   60,   60,   60,   60,   60,
+   60,   23,    0,   60,   60,  302,    0,   18,   18,   60,
+   19,   19,   32,   33,    0,   60,  116,   60,   60,   60,
+   60,   60,    0,   60,   60,   60,   60,   60,   60,   60,
+   60,   60,    0,   60,  116,   60,   60,   60,   60,   60,
+   16,   16,   31,   31,    0,    0,    0,   87,   87,   87,
+   87,   87,   87,   87,   87,   87,    0,    0,   87,   87,
+   55,  121,  121,  121,   87,    0,    0,    0,    0,    0,
+   87,    0,   87,   87,   87,   87,   87,  118,   87,   87,
+   87,   87,   87,   87,   87,   87,   87,    0,   87,    0,
+   87,   87,   87,   87,   87,  118,    0,   55,    0,    0,
+   55,   55,   55,   55,   55,   55,    0,   55,  125,  125,
+  125,    0,    0,    0,    0,   85,    0,    0,   55,   55,
+    0,    0,   55,   55,   11,    0,    0,  255,   12,   13,
+    0,    0,    0,   14,   15,    0,    0,   16,   16,    0,
+    0,    0,    0,    0,    0,   16,    0,   17,   18,   19,
+    0,   21,   85,   55,   55,   33,   85,   85,   85,   85,
+   85,    0,   85,   26,    0,   29,   30,   31,   32,   33,
+   23,    0,   55,   85,   85,   33,    0,   33,   33,    0,
+  124,  124,  124,   55,   55,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  297,  298,
+  299,    0,    0,    0,    0,    0,    0,   23,   85,   85,
+   23,   23,   23,   23,   23,   23,    0,   23,  311,  312,
+    0,    0,    0,  314,    0,    0,    0,  115,   23,   23,
+   23,    0,   23,   23,    0,  116,  116,  116,   85,   85,
+    0,    0,    0,   52,    0,  115,    0,    0,    0,   16,
+    0,    0,    0,    0,    0,    0,    0,    0,   88,    0,
+    0,    0,    0,   23,   23,    0,    0,    0,    0,    0,
+    0,    0,    0,  117,    0,    0,   88,    0,    0,   88,
+   52,    0,   23,   33,   52,   52,   52,   52,   52,    0,
+   52,  117,    0,   23,   23,   16,  118,  118,  118,    0,
+    0,   52,   52,   33,    0,   33,   33,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   55,   55,   55,
+   55,   55,   55,   55,   55,   55,    0,    0,   55,   55,
+    0,    0,    0,    0,   55,    0,   52,    0,    0,    0,
+   55,   88,   55,   55,   55,   55,   55,    0,   55,   55,
+   55,   55,   55,   55,   55,   55,   55,    0,   55,    0,
+   55,   55,   55,   55,   55,    0,   52,   52,    0,    0,
+    0,    0,   85,   85,   33,   85,   85,   85,   33,   33,
+   85,    0,    0,   33,   33,    0,    0,    0,    0,   85,
+    0,    0,    0,    0,    0,   33,    0,   33,   33,   33,
+   85,   33,    0,   85,   33,   33,   33,   33,   33,   33,
+   33,   33,    0,   33,    0,   33,   33,   33,   33,   33,
+    0,    0,    0,    0,    0,    0,    0,   23,   23,   23,
+   23,   23,   23,   23,   23,   23,    0,    0,   23,   23,
+    0,    0,    0,    0,   23,    0,  115,  115,  115,    0,
+   23,    0,   23,   23,   23,   23,   23,    0,   23,   23,
+    0,   23,   23,   23,   23,   23,   23,    0,   23,    0,
+   23,   23,   23,   23,   23,   16,   16,   88,   88,   88,
+    0,    0,   88,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,  117,  117,  117,    0,    0,    0,    0,    0,
+   52,   52,   33,   52,   52,   52,   33,   33,   52,    0,
+    0,   33,   33,   51,    0,    0,    0,   52,    0,    0,
+    0,   16,   16,   33,    0,   33,   33,   33,   52,   33,
+    0,   52,   33,   33,   33,   33,   33,   33,   33,   33,
+    0,   33,    0,   33,   33,   33,   33,   33,    0,    0,
+   51,    0,    0,   33,   51,   51,   51,   51,   51,    0,
+   51,    0,    0,    0,    0,    0,    0,   41,    0,    0,
+    0,   51,   51,   33,    0,   33,   33,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   41,    0,   51,   33,   41,   41,
+   41,   41,   41,    0,   41,    0,    0,    0,    0,    0,
+    0,   42,    0,    0,    0,   41,   41,   33,    0,   33,
+   33,    0,    0,    0,    0,    0,   51,   51,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   42,    0,
+   41,   33,   42,   42,   42,   42,   42,    0,   42,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   42,
+   42,   33,    0,   33,   33,    0,    0,    0,    0,    0,
+   41,   41,    0,    0,    0,   43,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   42,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   43,    0,    0,   33,   43,   43,   43,   43,
+   43,    0,   43,    0,   42,   42,    0,    0,    0,    0,
+    0,    0,    0,   43,   43,   33,    0,   33,   33,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   51,   51,   33,   51,   51,   51,   33,   33,   51,    0,
+    0,   33,   33,    0,    0,    0,    0,   51,   43,    0,
+    0,    0,    0,   33,    0,   33,   33,   33,   51,   33,
+    0,   51,   33,   33,   33,   33,   33,   33,   33,   33,
+    0,   33,    0,   33,   33,   33,   33,   33,   43,   43,
+    0,    0,    0,    0,   41,   41,   33,   41,   41,   41,
+   33,   33,   41,    0,    0,   33,   33,    0,    0,    0,
+    0,   41,    0,    0,    0,    0,    0,   33,    0,   33,
+   33,   33,   41,   33,    0,   41,   33,   33,   33,   33,
+   33,   33,   33,   33,    0,   33,    0,   33,   33,   33,
+   33,   33,    0,    0,    0,    0,    0,    0,   42,   42,
+   33,   42,   42,   42,   33,   33,   42,    0,    0,   33,
+   33,    0,    0,    0,    0,   42,    0,    0,    0,    0,
+    0,   33,    0,   33,   33,   33,   42,   33,    0,   42,
+   33,   33,   33,   33,   33,   33,   33,   33,    0,   33,
+    0,   33,   33,   33,   33,   33,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   43,   43,   33,   43,   43,   43,   33,   33,
+   43,    0,    0,   33,   33,   44,    0,    0,    0,   43,
+    0,    0,    0,    0,    0,   33,    0,   33,   33,   33,
+   43,   33,    0,   43,   33,   33,   33,   33,   33,   33,
+   33,   33,    0,   33,    0,   33,   33,   33,   33,   33,
+    0,    0,   44,    0,    0,   33,   44,   44,   44,   44,
+   44,    0,   44,    0,    0,    0,    0,    0,    0,   36,
+    0,    0,    0,   44,   44,   33,    0,   33,   33,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   36,    0,   44,   36,
+   36,   36,   36,   36,   36,    0,   36,    0,    0,    0,
+    0,    0,    0,    0,   35,    0,    0,   36,   36,   36,
+    0,   36,   36,    0,    0,    0,    0,    0,   44,   44,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   35,   36,   36,   35,   35,   35,   35,   35,   35,
+    0,   35,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   36,   35,   35,   35,    0,   35,    0,    0,    0,
+    0,    0,   36,   36,    0,    0,    0,   39,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   35,   35,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   35,   33,   39,    0,
+   39,   39,   39,    0,    0,    0,    0,   35,   35,    0,
+    0,    0,    0,    0,    0,   39,   39,   33,    0,   33,
+   33,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   44,   44,   33,   44,   44,   44,   33,   33,
+   44,    0,    0,   33,   33,    0,    0,    0,    0,   44,
+   39,    0,    0,    0,    0,   33,    0,   33,   33,   33,
+   44,   33,    0,   44,   33,   33,   33,   33,   33,   33,
+   33,   33,    0,   33,    0,   33,   33,   33,   33,   33,
+   39,   39,    0,    0,    0,    0,   36,   36,   36,   36,
+   36,   36,   36,   36,   36,    0,    0,   36,   36,    0,
+    0,    0,    0,   36,    0,    0,    0,    0,    0,   36,
+    0,   36,   36,   36,   36,   36,    0,    0,   36,   36,
+   36,   36,   36,   36,   36,   36,    0,   36,    0,   36,
+    0,    0,   36,   36,    0,    0,    0,    0,    0,    0,
+    0,   35,   35,   35,   35,   35,   35,   35,   35,   35,
+    0,    0,   35,   35,    0,    0,    0,    0,   35,    0,
+    0,    0,    0,    0,   35,   14,   35,   35,   35,   35,
+   35,    0,   35,    0,    0,   35,   35,   35,   35,   35,
+   35,    0,   35,    0,   35,   35,   35,   35,   35,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   14,    0,    0,   14,    0,
+   14,    0,    0,    0,   39,   39,   33,   39,   39,   39,
+   33,   33,   39,   40,   14,   33,   33,    0,    0,    0,
+    0,   39,    0,    0,    0,    0,    0,   33,    0,   33,
+   33,   33,   39,   33,    0,   39,   33,   33,   33,   33,
+   33,   33,   33,   33,    0,   33,    0,   33,   33,   33,
+   33,   33,    0,   33,   40,    0,   40,   40,   40,    0,
+    0,   33,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   40,   40,   33,    0,   33,   33,    0,   14,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   33,   33,    0,    0,   33,   40,    0,    0,   34,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   33,
+   33,   33,    0,   33,   33,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   40,   40,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   33,
+   34,    0,    0,   34,   33,    0,    0,    0,    0,    0,
+    0,   15,    0,    0,    0,    0,    0,   34,   34,   33,
+    0,   33,   33,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   33,   33,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   15,   34,    0,   15,    0,   15,    0,    0,    0,
+    0,    0,   14,   14,   14,   14,   14,   14,   14,   14,
+   15,    0,    0,   14,   14,    0,    0,    0,    0,    0,
+    0,    0,   34,   34,    0,   14,    0,   14,   14,   14,
+   14,   14,    0,    0,    0,    0,   14,   14,   14,   14,
+    0,    0,    0,   14,    0,   14,   14,   14,   14,   14,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   40,   40,   33,   40,   40,   40,   33,   33,   40,    0,
+    0,   33,   33,   35,   15,    0,   27,   40,   28,    0,
+    0,    0,    0,   33,    6,   33,   33,   33,   40,   33,
+    0,   40,   33,   33,   33,   33,   33,   33,   33,   33,
+    0,   33,    0,   33,   33,   33,   33,   33,   33,   33,
+   33,   33,   33,   33,   33,   33,   33,    0,    0,   33,
+   33,    0,    0,    0,    6,    0,    0,    6,    0,    6,
+    0,   33,    0,   33,   33,   33,   33,   33,    0,   33,
+   33,   33,   33,   33,   33,   33,   33,   33,    0,   33,
+    0,   33,   33,   33,   33,   33,   34,   34,   33,   34,
+   34,   34,   33,   33,   34,    0,    0,   33,   33,    0,
+   35,  103,    0,   27,    0,   28,    0,    0,    0,   33,
+    0,   33,   33,   33,   34,   33,    0,   34,   33,   33,
+   33,   33,   33,   33,   33,   33,    0,   33,    0,   33,
+   33,   33,   33,   33,    0,    0,    0,    6,   15,   15,
+   15,   15,   15,   15,   15,   15,   12,    0,    0,   15,
+   15,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   15,    0,   15,   15,   15,   15,   15,    0,    0,
+    0,    0,   15,   15,   15,   15,    0,    0,    0,   15,
+    0,   15,   15,   15,   15,   15,   12,    0,    0,   12,
+    0,   12,    0,    0,    7,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   12,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   11,    0,  123,  124,   12,   13,    0,    0,
+    0,   14,   15,    0,    7,    0,    0,    7,    0,    7,
+    0,    0,    0,   16,    5,   17,   18,   19,    0,   21,
+    0,    0,    0,    7,   22,   23,   24,   25,    0,    0,
+    0,   26,    0,   29,   30,   31,   32,   33,    0,   12,
+    0,    6,    6,    6,    0,    0,    0,    6,    6,    0,
+    0,    0,    6,    6,    5,    0,    0,    5,    0,    5,
+    0,    0,    0,    2,    6,    0,    6,    6,    6,    6,
+    6,    0,    0,    0,    0,    6,    6,    6,    6,    0,
+    0,    0,    6,    0,    6,    6,    6,    6,    6,   11,
+    0,    0,    0,   12,   13,    0,    0,    0,   14,   15,
+    0,    0,    0,    2,    0,    0,    2,    0,    2,    0,
+   16,    0,   17,   18,   19,    0,   21,    0,    0,    0,
+    0,   22,   23,   24,   25,    0,    0,    0,   26,    0,
+   29,   30,   31,   32,   33,    0,    0,    5,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   12,   12,   12,   12,    0,   12,   12,
+   12,    0,    0,    0,   12,   12,    2,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   12,    0,   12,   12,
+   12,   12,   12,    0,    0,    0,    0,   12,   12,   12,
+   12,    0,    0,    0,   12,    0,   12,   12,   12,   12,
+   12,    7,    7,    7,    7,    7,    7,    7,    7,    0,
+    0,    0,    7,    7,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    7,    0,    7,    7,    7,    7,
+    7,    0,    0,    0,    0,    7,    7,    7,    7,    0,
+    0,    0,    7,    0,    7,    7,    7,    7,    7,    0,
+    0,    5,    5,    5,    0,    0,    0,    5,    5,    0,
+    0,    0,    5,    5,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    5,    0,    5,    5,    5,    5,
+    5,    0,    0,    0,    0,    5,    5,    5,    5,    0,
+    0,    0,    5,    0,    5,    5,    5,    5,    5,    0,
+    2,    2,    2,    0,    0,    0,    2,    2,    0,    0,
+    0,    2,    2,   58,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    2,    0,    2,    2,    2,    2,    2,
+    0,    0,    0,    0,    2,    2,    2,    2,    0,    0,
+    0,    2,    0,    2,    2,    2,    2,    2,    0,    0,
+   58,    0,    0,   58,   58,   58,   58,   58,   58,    0,
+   58,    0,    0,    0,    0,    0,    0,    0,   54,    0,
+    0,   58,   58,   58,    0,   58,   58,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   54,   58,   58,   54,   54,
+   54,   54,   54,   54,    0,   54,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   58,   54,   54,    0,    0,
+   54,   54,    0,    0,    0,    0,   58,   58,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   54,   54,    0,    0,    0,    0,   56,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   54,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   54,   54,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   56,    0,    0,    0,   56,   56,
+    0,   56,    0,    0,   56,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   56,   56,   56,    0,   56,
+   16,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   56,   56,    0,    0,    0,    0,    0,    0,    0,    0,
+   58,   58,   58,   58,   58,   58,   58,   58,   58,   56,
+    0,   58,   58,    0,    0,    0,    0,   58,    0,    0,
+   56,   56,    0,   58,    0,   58,   58,   58,   58,   58,
+    0,   58,   58,   58,   58,    0,   58,   58,   58,   58,
+    0,   58,    0,   58,   58,   58,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   54,   54,   54,   54,   54,
+   54,   54,   54,   54,    0,    0,   54,   54,   54,    0,
+    0,    0,   54,    0,    0,    0,    0,    0,   54,    0,
+   54,   54,   54,   54,   54,    0,   54,   54,   54,   54,
+    0,   54,   54,   54,   54,    0,   54,    0,   54,   54,
+   54,    0,    0,  104,   54,  106,    0,    0,    0,    0,
+  110,  111,    0,  114,  116,  117,    0,   54,   54,  121,
+  122,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,  132,    0,    0,    0,  137,
+  138,  139,  140,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   56,   56,    0,   56,   56,   56,
+    0,    0,   56,    0,    0,    0,  158,    0,    0,    0,
+    0,   56,   54,    0,    0,    0,    0,    0,    0,  186,
+    0,    0,   56,    0,    0,   56,   16,   16,   56,   56,
+   56,   56,   56,   56,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  186,  186,    0,    0,    0,  197,
+  198,    0,    0,  200,  201,  202,  203,  205,    0,    0,
+    0,    0,  207,  208,    0,   54,   54,    0,    0,    0,
+  215,    0,    0,    0,  216,    0,   25,    0,    0,    0,
+    0,    0,    0,    0,  186,  227,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  252,    0,
+    0,  186,    0,   25,    0,    0,   27,   25,   25,    0,
+   25,    0,    0,   25,  264,    0,  265,    0,  266,    0,
+  267,    0,  268,    0,   25,   25,   25,  270,   25,   16,
+    0,    0,  271,  272,    0,    0,    0,    0,    0,    0,
+   54,  186,    0,   27,    0,    0,    0,   27,   27,    0,
+   27,    0,    0,   27,   26,    0,    0,    0,    0,   25,
+   25,    0,    0,    0,   27,   27,   27,    0,   27,   16,
+    0,    0,  186,  186,  186,  186,    0,    0,   25,    0,
+  186,    0,    0,    0,    0,  186,    0,    0,    0,   25,
+   25,   26,  186,  186,   57,   26,   26,  186,   26,   27,
+   27,   26,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   26,   26,   26,    0,   26,   16,   27,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   27,
+   27,   57,    0,    0,    0,   57,   57,    0,   57,    0,
+    0,   57,    0,    0,    0,    0,    0,   26,   26,    0,
+    0,    0,   57,   57,   57,    0,   57,   16,    0,    0,
+    0,    0,    0,    0,    0,    0,   26,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   26,   26,   35,
+    0,    0,   27,    0,   28,    0,    0,   57,   57,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   87,
+    0,   88,    0,    0,    0,    0,   57,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   57,   57,    0,
+    0,    0,    0,   25,   25,    0,   25,   25,   25,    0,
+    0,   25,    0,    0,    0,    0,    0,    0,    0,    0,
+   25,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   25,    0,    0,   25,   16,   16,   25,   25,   25,
+   25,   25,   25,   27,   27,    0,   27,   27,   27,    0,
+    0,   27,    0,    0,    0,    0,    0,    0,    0,    0,
+   27,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   27,    0,    0,   27,   16,   16,   27,   27,   27,
+   27,   27,   27,    0,    0,    0,    0,    0,    0,    0,
+    0,   26,   26,    0,   26,   26,   26,    0,    0,   26,
+    0,    0,    0,    0,    0,    0,    0,    0,   26,    0,
+    0,    0,    0,   88,    0,    0,    0,    0,    0,   26,
+    0,    0,   26,   16,   16,   26,   26,   26,   26,   26,
+   26,   57,   57,    0,   57,   57,   57,    0,    0,   57,
+    0,    0,    0,    0,    0,    0,    0,    0,   57,    0,
+   88,    0,    0,   29,   88,   88,    0,   88,    0,   57,
+   88,    0,   57,   16,   16,   57,   57,   57,   57,   57,
+   57,   88,   88,   88,    0,   88,   88,    0,   11,    0,
+    0,    0,   12,   13,    0,    0,    0,   14,   15,    0,
+   29,    0,    0,    0,   29,   29,    0,   29,   16,   16,
+   29,   17,   18,   19,    0,   21,   88,   88,    0,    0,
+    0,   29,   29,    0,    0,   86,   16,   26,    0,   29,
+   30,   31,   32,   33,    0,   88,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   16,   88,   88,   89,   16,
+   16,    0,   16,    0,    0,   16,   29,   29,    0,    0,
+    0,    0,    0,    0,    0,    0,   16,   16,    0,    0,
+    0,   16,    0,    0,    0,   29,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   89,   29,   29,    0,   89,
+   89,    0,   89,   90,    0,   89,    0,    0,    0,    0,
+    0,   16,   16,    0,    0,    0,   89,   89,    0,    0,
+    0,   16,    0,    0,    0,    0,    0,    0,    0,    0,
+   16,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   90,   16,   16,    0,   90,   90,    0,   90,    0,    0,
+   90,   89,   89,    0,    0,    0,    0,    0,    0,    0,
+    0,   90,   90,    0,    0,    0,   16,    0,    0,    0,
+   89,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   89,   89,    0,   35,  231,    0,   27,  232,   28,
+   88,   88,    0,   88,   88,   88,   90,   90,   88,    0,
+    0,    0,    0,    0,   87,    0,   88,   88,    0,    0,
+    0,    0,    0,    0,    0,   90,    0,    0,   88,    0,
+    0,   88,   88,   88,    0,    0,   90,   90,   88,   88,
+   29,   29,    0,   29,   29,   29,    0,    0,   29,    0,
+    0,    0,    0,    0,    0,    0,    0,   29,    0,    0,
+   35,    0,    0,   27,    0,   28,    0,    0,   29,    0,
+    0,   29,   16,   16,   29,   29,   29,   29,   29,  185,
+    0,    0,    0,    0,    0,   16,   16,    0,   16,   16,
+   16,    0,    0,   16,    0,    0,    0,    0,    0,    0,
+    0,    0,   16,   20,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   16,    0,    0,   16,   16,   16,    0,
+    0,    0,    0,    0,    0,   89,   89,    0,   89,   89,
+   89,    0,    0,   89,    0,    0,    0,    0,    0,    0,
+   20,    0,   89,  183,   20,   20,    0,   20,   86,    0,
+   20,    0,    0,   89,    0,    0,   89,   16,   16,    0,
+    0,   20,   20,    0,    0,    0,   16,    0,    0,    0,
+   90,   90,    0,   90,   90,   90,    0,    0,   90,    0,
+    0,    0,    0,    0,    0,   86,    0,   90,    0,   86,
+   86,    0,    0,    0,    0,   86,   20,   20,   90,    0,
+    0,   90,   16,   16,    0,    0,   86,   86,    0,    0,
+    0,   16,    0,   11,    0,   20,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,  110,   20,   20,  110,    0,
+  110,    0,    0,    0,   16,    0,   17,   18,   19,    0,
+   21,   86,   86,    0,  110,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,   29,   30,   31,   32,   33,    0,
+   86,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   86,   86,    0,    0,    0,    0,    0,    0,   11,
+  170,  123,  124,   12,   13,    0,  171,  172,   14,   15,
+  173,    0,  174,  175,    0,  176,  177,  178,  179,  180,
+   16,  181,   17,   18,   19,    0,   21,  182,  110,    0,
+  110,   22,   23,   24,   25,    0,    0,    0,   26,    0,
+   29,   30,   31,   32,   33,    0,    0,    0,    0,  109,
+    0,    0,  109,    0,  109,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  109,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   20,   20,    0,   20,   20,   20,    0,    0,   20,    0,
+    0,    0,    0,    0,    0,    0,    0,   20,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   20,    0,
+    0,   20,   16,   16,    0,    0,    0,  103,    0,    0,
+  103,    0,  103,    0,    0,   86,   86,    0,   86,   86,
+   86,    0,  109,   86,  109,    0,  103,    0,    0,    0,
+    0,    0,   86,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   86,    0,    0,   86,   16,   16,    0,
+    0,    0,    0,    0,  110,  110,    0,    0,  110,  110,
+    0,  110,  110,  110,  110,  110,  110,  110,  110,    0,
+  110,  110,  110,  110,  110,  110,  110,  110,  110,  110,
+    0,  110,  110,    0,    0,    0,  110,  110,  110,  110,
+  103,    0,  103,  110,    0,  110,  110,  110,  110,  110,
+    0,    0,    0,    0,  104,    0,    0,  104,    0,  104,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  104,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   51,    0,    0,   27,    0,   28,  109,  109,
+    0,    0,  109,  109,    0,  109,  109,  109,  109,  109,
+  109,  109,  109,    0,  109,  109,  109,  109,  109,  109,
+  109,  109,  109,  109,    0,  109,  109,  104,    0,  104,
+  109,  109,  109,  109,    0,    0,    0,  109,    0,  109,
+  109,  109,  109,  109,  105,    0,    0,  105,    0,  105,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  105,    0,    0,  103,  103,    0,    0,
+  103,  103,    0,  103,  103,  103,  103,  103,  103,  103,
+  103,    0,  103,  103,  103,  103,  103,  103,  103,  103,
+  103,  103,    0,  103,  103,    0,    0,    0,  103,  103,
+  103,  103,    0,    0,    0,  103,    0,  103,  103,  103,
+  103,  103,    0,    0,    0,    0,  102,    0,    0,  102,
+    0,  102,    0,    0,    0,    0,    0,  105,    0,  105,
+    0,    0,    0,    0,    0,  102,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  104,  104,    0,    0,  104,  104,    0,
+  104,  104,  104,  104,  104,  104,  104,  104,    0,  104,
+  104,  104,  104,  104,  104,  104,  104,  104,  104,    0,
+  104,  104,    0,    0,    0,  104,  104,  104,  104,  102,
+    0,  102,  104,    0,  104,  104,  104,  104,  104,  108,
+    0,   11,  108,    0,  108,   12,   13,    0,    0,    0,
+   14,   15,    0,    0,    0,    0,    0,    0,  108,    0,
+    0,    0,   16,    0,   17,   18,   19,    0,   21,    0,
+    0,    0,    0,   22,   23,   24,   25,    0,    0,    0,
+   26,    0,   29,   30,   31,   32,   33,   35,    0,    0,
+   27,    0,   28,  105,  105,    0,    0,  105,  105,    0,
+  105,  105,  105,  105,  105,  105,  105,  105,    0,  105,
+  105,  105,  105,  105,  105,  105,  105,  105,  105,    0,
+  105,  105,  108,    0,  108,  105,  105,  105,  105,    0,
+    0,    0,  105,    0,  105,  105,  105,  105,  105,  137,
+    0,    0,  137,    0,  137,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  137,    0,
+    0,    0,    0,    0,    0,  102,  102,    0,    0,  102,
+  102,    0,  102,  102,  102,  102,  102,  102,  102,  102,
+    0,  102,  102,  102,  102,  102,  102,  102,  102,  102,
+  102,    0,  102,  102,    0,    0,    0,  102,  102,  102,
+  102,    0,    0,    0,  102,    0,  102,  102,  102,  102,
+  102,   35,    0,    0,   27,    0,   28,    0,    0,    0,
+    0,    0,  137,    0,  137,    0,    0,    0,    0,    0,
+  185,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  108,  108,
+    0,    0,  108,  108,    0,  108,  108,  108,  108,  108,
+  108,  108,  108,    0,  108,  108,  108,  108,  108,  108,
+  108,  108,  108,  108,    0,  108,  108,    0,    0,    0,
+  108,  108,  108,  108,  183,    0,  184,  108,    0,  108,
+  108,  108,  108,  108,   35,    0,   11,   27,    0,   28,
+   12,   13,    0,    0,    0,   14,   15,    0,    0,    0,
+    0,    0,    0,  185,    0,    0,    0,   16,    0,   17,
+   18,   19,    0,   21,    0,    0,    0,    0,   22,   23,
+   24,   25,    0,    0,    0,   26,    0,   29,   30,   31,
+   32,   33,   35,    0,    0,   27,    0,   28,  137,  137,
+    0,    0,  137,  137,    0,  137,  137,  137,  137,  137,
+  137,  137,  137,    0,  137,  137,  137,  137,  137,  137,
+  137,  137,  137,  137,    0,  137,  137,  183,    0,  195,
+  137,  137,  137,  137,    0,    0,    0,  137,    0,  137,
+  137,  137,  137,  137,   35,    0,    0,   27,    0,   28,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  185,    0,    0,    0,    0,    0,    0,
+   11,  170,    0,    0,   12,   13,    0,  171,  172,   14,
+   15,  173,    0,  174,  175,    0,  176,  177,  178,  179,
+  180,   16,  181,   17,   18,   19,    0,   21,  182,    0,
+    0,    0,   22,   23,   24,   25,    0,    0,    0,   26,
+    0,   29,   30,   31,   32,   33,   35,    0,    0,   27,
+    0,   28,    0,    0,    0,    0,    0,  183,    0,  196,
+    0,    0,    0,    0,    0,  185,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   11,  170,    0,    0,   12,   13,    0,
+  171,  172,   14,   15,  173,    0,  174,  175,    0,  176,
+  177,  178,  179,  180,   16,  181,   17,   18,   19,    0,
+   21,  182,    0,    0,    0,   22,   23,   24,   25,  183,
+    0,  226,   26,    0,   29,   30,   31,   32,   33,   35,
+    0,  113,   27,    0,   28,   12,   13,    0,    0,    0,
+   14,   15,    0,    0,    0,    0,    0,    0,  185,    0,
+    0,    0,   16,    0,   17,   18,   19,    0,   21,    0,
+    0,    0,    0,   22,   23,   24,   25,    0,    0,    0,
+   26,    0,   29,   30,   31,   32,   33,    0,    0,    0,
+    0,    0,    0,   11,  170,    0,    0,   12,   13,    0,
+  171,  172,   14,   15,  173,    0,  174,  175,    0,  176,
+  177,  178,  179,  180,   16,  181,   17,   18,   19,    0,
+   21,  182,  183,    0,  279,   22,   23,   24,   25,    0,
+    0,    0,   26,    0,   29,   30,   31,   32,   33,   35,
+    0,    0,   27,    0,   28,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,  185,    0,
+    0,    0,    0,    0,    0,   11,  170,    0,    0,   12,
+   13,    0,  171,  172,   14,   15,  173,    0,  174,  175,
+    0,  176,  177,  178,  179,  180,   16,  181,   17,   18,
+   19,    0,   21,  182,    0,    0,    0,   22,   23,   24,
+   25,    0,    0,    0,   26,    0,   29,   30,   31,   32,
+   33,  107,    0,    0,  107,    0,  107,    0,    0,    0,
+    0,    0,  183,    0,  303,    0,    0,    0,    0,    0,
+  107,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   11,  170,
+    0,    0,   12,   13,    0,  171,  172,   14,   15,  173,
+    0,  174,  175,    0,  176,  177,  178,  179,  180,   16,
+  181,   17,   18,   19,    0,   21,  182,    0,    0,    0,
+   22,   23,   24,   25,  107,    0,  107,   26,    0,   29,
+   30,   31,   32,   33,  130,    0,    0,  130,    0,  130,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  130,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   35,    0,    0,   27,    0,   28,    0,    0,   11,  170,
+    0,    0,   12,   13,    0,  171,  172,   14,   15,  173,
+    0,  174,  175,    0,  176,  177,  178,  179,  180,   16,
+  181,   17,   18,   19,    0,   21,  182,  130,    0,  130,
+   22,   23,   24,   25,    0,    0,    0,   26,    0,   29,
+   30,   31,   32,   33,   35,  233,    0,   27,  234,   28,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   87,    0,   88,    0,    0,    0,
+  107,  107,    0,    0,  107,  107,    0,  107,  107,  107,
+  107,  107,    0,  107,  107,    0,  107,  107,  107,  107,
+  107,  107,  107,  107,  107,  107,    0,  107,  107,    0,
+    0,    0,  107,  107,  107,  107,    0,    0,    0,  107,
+    0,  107,  107,  107,  107,  107,   35,  235,    0,   27,
+  236,   28,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   87,    0,   88,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,  130,  130,    0,    0,  130,  130,    0,
+  130,  130,  130,  130,  130,    0,  130,  130,    0,  130,
+  130,  130,  130,  130,  130,  130,  130,  130,  130,    0,
+  130,  130,    0,    0,    0,  130,  130,  130,  130,    0,
+    0,    0,  130,    0,  130,  130,  130,  130,  130,   11,
+    0,    0,    0,   12,   13,    0,  171,  172,   14,   15,
+    0,    0,    0,    0,    0,  176,  177,  178,  179,  180,
+   16,    0,   17,   18,   19,    0,   21,  182,    0,    0,
+    0,   22,   23,   24,   25,    0,    0,    0,   26,    0,
+   29,   30,   31,   32,   33,   35,  237,    0,   27,  238,
+   28,    0,    0,   11,    0,    0,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,   87,    0,   88,    0,    0,
+    0,    0,    0,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,    0,    0,    0,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,   29,   30,   31,   32,   33,   35,
+  242,    0,   27,  243,   28,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   87,
+    0,   88,    0,    0,    0,   11,    0,    0,    0,   12,
+   13,    0,    0,    0,   14,   15,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   16,    0,   17,   18,
+   19,   35,   21,    0,   27,  108,   28,   22,   23,   24,
+   25,   85,   86,    0,   26,    0,   29,   30,   31,   32,
+   33,   87,    0,   88,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   35,  152,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   87,    0,   88,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   35,    0,    0,   27,  157,   28,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   87,   11,   88,    0,    0,   12,   13,
+    0,    0,    0,   14,   15,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,   16,    0,   17,   18,   19,
+   35,   21,    0,   27,  160,   28,   22,   23,   24,   25,
+   85,   86,    0,   26,    0,   29,   30,   31,   32,   33,
+   87,    0,   88,    0,    0,    0,    0,    0,   11,    0,
+    0,    0,   12,   13,    0,    0,    0,   14,   15,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   16,
+    0,   17,   18,   19,   35,   21,    0,   27,  162,   28,
+   22,   23,   24,   25,   85,   86,    0,   26,    0,   29,
+   30,   31,   32,   33,   87,    0,   88,    0,    0,    0,
+   11,    0,    0,    0,   12,   13,    0,    0,    0,   14,
+   15,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,   16,    0,   17,   18,   19,    0,   21,    0,    0,
+    0,    0,   22,   23,   24,   25,   85,   86,    0,   26,
+    0,   29,   30,   31,   32,   33,   11,    0,    0,    0,
+   12,   13,    0,    0,   35,   14,   15,   27,  163,   28,
+    0,    0,    0,    0,    0,    0,    0,   16,    0,   17,
+   18,   19,    0,   21,   87,    0,   88,    0,   22,   23,
+   24,   25,   85,   86,    0,   26,    0,   29,   30,   31,
+   32,   33,   11,    0,    0,    0,   12,   13,    0,    0,
+   35,   14,   15,   27,  168,   28,    0,    0,    0,    0,
+    0,    0,    0,   16,    0,   17,   18,   19,    0,   21,
+   87,    0,   88,    0,   22,   23,   24,   25,   85,   86,
+    0,   26,    0,   29,   30,   31,   32,   33,    0,   11,
+    0,    0,    0,   12,   13,    0,    0,   35,   14,   15,
+   27,  169,   28,    0,    0,    0,    0,    0,    0,    0,
+   16,    0,   17,   18,   19,    0,   21,   87,    0,   88,
+    0,   22,   23,   24,   25,   85,   86,    0,   26,    0,
+   29,   30,   31,   32,   33,    0,    0,    0,    0,    0,
+    0,    0,    0,   11,    0,    0,    0,   12,   13,    0,
+    0,   35,   14,   15,   27,    0,   28,    0,    0,    0,
+    0,    0,    0,    0,   16,    0,   17,   18,   19,  191,
+   21,   87,    0,   88,    0,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,   29,   30,   31,   32,   33,    0,
+    0,    0,    0,    0,    0,    0,    0,   35,  240,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   87,    0,   88,
+    0,    0,    0,   11,    0,    0,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,    0,    0,    0,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,   29,   30,   31,   32,   33,   11,
+    0,    0,    0,   12,   13,    0,    0,    0,   14,   15,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+   16,    0,   17,   18,   19,    0,   21,    0,    0,    0,
+    0,   22,   23,   24,   25,   85,   86,    0,   26,    0,
+   29,   30,   31,   32,   33,    0,   11,    0,    0,    0,
+   12,   13,    0,    0,    0,   14,   15,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   16,    0,   17,
+   18,   19,    0,   21,    0,    0,    0,    0,   22,   23,
+   24,   25,   85,   86,    0,   26,    0,   29,   30,   31,
+   32,   33,   35,  244,    0,   27,    0,   28,    0,    0,
+   11,    0,    0,    0,   12,   13,    0,    0,    0,   14,
+   15,    0,   87,    0,   88,    0,    0,    0,    0,    0,
+    0,   16,    0,   17,   18,   19,    0,   21,    0,    0,
+    0,    0,   22,   23,   24,   25,   85,   86,    0,   26,
+    0,   29,   30,   31,   32,   33,   11,    0,    0,    0,
+   12,   13,    0,    0,    0,   14,   15,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   16,    0,   17,
+   18,   19,    0,   21,    0,    0,    0,    0,   22,   23,
+   24,   25,   85,   86,    0,   26,    0,   29,   30,   31,
+   32,   33,   35,  275,    0,   27,    0,   28,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   87,    0,   88,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   35,  281,
+    0,   27,    0,   28,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   87,    0,
+   88,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   35,  282,    0,   27,    0,   28,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   87,    0,   88,    0,    0,    0,
+    0,   11,    0,    0,    0,   12,   13,    0,    0,    0,
+   14,   15,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   16,    0,   17,   18,   19,    0,   21,    0,
+    0,    0,    0,   22,   23,   24,   25,   85,   86,    0,
+   26,    0,   29,   30,   31,   32,   33,   35,  283,    0,
+   27,    0,   28,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   87,    0,   88,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   35,  284,    0,   27,    0,   28,    0,
+    0,   11,    0,    0,    0,   12,   13,    0,    0,    0,
+   14,   15,    0,   87,    0,   88,    0,    0,    0,    0,
+    0,    0,   16,    0,   17,   18,   19,    0,   21,    0,
+    0,    0,    0,   22,   23,   24,   25,   85,   86,    0,
+   26,    0,   29,   30,   31,   32,   33,   11,    0,    0,
+    0,   12,   13,    0,    0,    0,   14,   15,   35,    0,
+    0,   27,    0,   28,    0,    0,    0,    0,   16,    0,
+   17,   18,   19,    0,   21,    0,    0,    0,    0,   22,
+   23,   24,   25,   85,   86,    0,   26,    0,   29,   30,
+   31,   32,   33,   11,    0,    0,    0,   12,   13,    0,
+    0,    0,   14,   15,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   16,    0,   17,   18,   19,    0,
+   21,    0,    0,    0,    0,   22,   23,   24,   25,   85,
+   86,    0,   26,    0,   29,   30,   31,   32,   33,   35,
+  285,   34,   27,    0,   28,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   87,
+    0,   88,    0,    0,    0,    0,   11,    0,    0,    0,
+   12,   13,    0,    0,    0,   14,   15,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,   16,    0,   17,
+   18,   19,   35,   21,    0,   27,    0,   28,   22,   23,
+   24,   25,   85,   86,    0,   26,    0,   29,   30,   31,
+   32,   33,   11,    0,    0,    0,   12,   13,    0,    0,
+    0,   14,   15,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   16,    0,   17,   18,   19,    0,   21,
+    0,    0,    0,    0,   22,   23,   24,   25,   85,   86,
+    0,   26,    0,   29,   30,   31,   32,   33,   35,  287,
+    0,   27,    0,   28,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    9,   10,   11,   87,    0,
+   88,   12,   13,    0,    0,    0,   14,   15,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   16,    0,
+   17,   18,   19,   20,   21,    0,    0,    0,    0,   22,
+   23,   24,   25,    0,    0,    0,   26,    0,   29,   30,
+   31,   32,   33,   35,    0,    0,   27,    0,   28,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   87,    0,   88,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   11,    0,
+    0,    0,   12,   13,    0,    0,    0,   14,   15,   35,
+    0,    0,   27,    0,   28,    0,    0,    0,    0,   16,
+    0,   17,   18,   19,    0,   21,    0,    0,  291,    0,
+   22,   23,   24,   25,   85,   86,    0,   26,    0,   29,
+   30,   31,   32,   33,    0,    0,    0,    0,    0,    0,
+    0,  115,    0,    0,    0,   12,   13,    0,    0,   35,
+   14,   15,   27,    0,   28,    0,    0,    0,    0,    0,
+    0,    0,   16,    0,   17,   18,   19,    0,   21,    0,
+    0,    0,    0,   22,   23,   24,   25,    0,    0,    0,
+   26,    0,   29,   30,   31,   32,   33,    0,    0,    0,
+    0,    0,    0,    0,    0,   35,    0,    0,   27,    0,
+   28,    0,    0,    0,    0,    0,    0,   11,    0,    0,
+    0,   12,   13,    0,    0,    0,   14,   15,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,   16,    0,
+   17,   18,   19,    0,   21,    0,    0,    0,    0,   22,
+   23,   24,   25,   85,   86,    0,   26,    0,   29,   30,
+   31,   32,   33,   35,    0,    0,   27,    0,   28,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,   11,    0,    0,    0,   12,   13,    0,    0,
+    0,   14,   15,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,   16,    0,   17,   18,   19,    0,   21,
+    0,    0,    0,    0,   22,   23,   24,   25,   85,   86,
+    0,   26,    0,   29,   30,   31,   32,   33,   11,    0,
+    0,    0,   12,   13,    0,    0,    0,   14,   15,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   16,
+    0,   17,   18,   19,    0,   21,    0,    0,    0,    0,
+   22,   23,   24,   25,    0,    0,    0,   26,    0,   29,
+   30,   31,   32,   33,    0,    0,    0,    0,  136,    0,
+    0,    0,   12,   13,    0,    0,    0,   14,   15,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   16,
+    0,   17,   18,   19,    0,   21,    0,    0,    0,    0,
+   22,   23,   24,   25,    0,    0,    0,   26,    0,   29,
+   30,   31,   32,   33,  204,    0,    0,    0,   12,   13,
+    0,    0,    0,   14,   15,    0,    0,  101,  102,    0,
+    0,    0,    0,    0,    0,   16,    0,   17,   18,   19,
+    0,   21,    0,    0,    0,    0,   22,   23,   24,   25,
+    0,    0,    0,   26,    0,   29,   30,   31,   32,   33,
+  131,    0,  133,  134,    0,    0,    0,    0,    0,    0,
+    0,    0,  263,    0,    0,    0,   12,   13,    0,    0,
+    0,   14,   15,    0,    0,    0,    0,    0,  155,  156,
+    0,    0,    0,   16,    0,   17,   18,   19,    0,   21,
+    0,    0,    0,    0,   22,   23,   24,   25,    0,    0,
+    0,   26,    0,   29,   30,   31,   32,   33,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   67,
+   68,    0,    0,    0,    0,   72,    0,    0,    0,    0,
+    0,    0,    0,   89,    0,    0,    0,    0,    0,    0,
+  209,    0,    0,    0,    0,    0,   89,    0,    0,    0,
+    0,  217,    0,  219,    0,  220,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,  241,    0,    0,    0,
+    0,    0,    0,  142,  143,  144,  145,  146,  147,    0,
+    0,  258,  259,  260,  261,  262,   89,    0,   89,    0,
+    0,    0,   89,   89,    0,    0,   89,    0,   89,   89,
+    0,    0,    0,   89,   89,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   89,    0,    0,    0,    0,   89,
+   89,   89,   89,    0,    0,    0,    0,    0,    0,  286,
+    0,    0,    0,  288,  289,  290,    0,    0,    0,  295,
+   89,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,  308,  309,    0,    0,   89,    0,
+  313,    0,    0,    0,    0,    0,    0,    0,    0,   89,
+   89,    0,   89,   89,   89,   89,    0,   89,    0,   89,
+   89,    0,    0,    0,    0,    0,    0,   89,   89,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,   89,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,   89,    0,    0,    0,    0,    0,
+    0,    0,    0,    0,    0,    0,   89,   89,   89,   89,
+   89,    0,   89,   89,   89,
+};
+short yycheck[] = {                                      41,
+    0,  123,   62,  123,   41,   59,   41,   59,  214,   63,
+   59,   63,  123,   63,   59,   63,   94,   59,   50,   38,
+   35,   63,   35,  291,   41,  286,   63,   41,   63,   91,
+   41,   63,   64,  301,  112,   40,   51,   37,   51,    7,
+   40,   41,   42,   43,   44,   45,   63,   47,   59,   63,
+   35,   41,   63,   41,   44,    0,   44,   41,   58,   59,
+   60,   29,   62,   63,  124,   44,   51,   35,  261,  262,
+   37,   40,  261,   60,  288,   42,   43,   40,   45,   63,
+   47,  101,  102,   51,   63,  291,  118,  301,  302,   60,
+   40,   16,   37,   93,   94,  301,   41,   42,   43,   44,
+   45,   63,   47,   40,   63,   30,   31,   40,  292,   40,
+    0,  131,  112,   58,   59,   60,   84,   62,   63,  303,
+  304,   40,   40,  123,  124,  123,   40,   94,   44,  112,
+   98,   41,   41,   37,   63,   41,   63,  292,   42,  171,
+  172,  261,  262,   47,  280,  112,   41,   37,   93,   94,
+   40,   41,   42,   43,   41,   45,   44,   47,   44,   93,
+  292,   41,   41,   40,   40,  133,  134,  112,   58,   59,
+   60,   40,   62,   63,  292,  290,  195,   41,  123,  124,
+   59,   59,  272,   91,   41,   40,   93,  271,   41,   41,
+   94,    0,   41,   93,   59,   41,   -1,   51,   -1,  219,
+   -1,  211,   -1,   93,   94,  265,   -1,   -1,  112,   41,
+   -1,  260,  261,  262,   -1,  260,  261,  262,  260,  261,
+  262,   -1,  112,  148,  256,   40,   -1,   59,   43,   -1,
+   45,   63,   -1,  123,  124,  289,  290,  289,  290,  289,
+  290,  289,  290,   -1,  212,  213,   -1,  289,  290,  260,
+  261,  262,  289,  290,  289,  290,   -1,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,  286,   -1,  268,  269,
+   -1,   -1,  289,  290,  274,  289,  290,   -1,  289,  290,
+  280,   41,  282,  283,  284,  285,  286,   -1,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,   -1,  298,   59,
+  300,  301,  302,  303,  304,  289,  290,  274,  276,   -1,
+  289,  290,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,  292,   -1,  268,  269,  293,   -1,  289,  290,  274,
+  289,  290,  303,  304,   -1,  280,   41,  282,  283,  284,
+  285,  286,   -1,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,   59,  300,  301,  302,  303,  304,
+  289,  290,  289,  290,   -1,   -1,   -1,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,   -1,   -1,  268,  269,
+    0,  260,  261,  262,  274,   -1,   -1,   -1,   -1,   -1,
+  280,   -1,  282,  283,  284,  285,  286,   41,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   59,   -1,   37,   -1,   -1,
+   40,   41,   42,   43,   44,   45,   -1,   47,  260,  261,
+  262,   -1,   -1,   -1,   -1,    0,   -1,   -1,   58,   59,
+   -1,   -1,   62,   63,  259,   -1,   -1,  217,  263,  264,
+   -1,   -1,   -1,  268,  269,   -1,   -1,  289,  290,   -1,
+   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+   -1,  286,   37,   93,   94,   40,   41,   42,   43,   44,
+   45,   -1,   47,  298,   -1,  300,  301,  302,  303,  304,
+    0,   -1,  112,   58,   59,   60,   -1,   62,   63,   -1,
+  260,  261,  262,  123,  124,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  288,  289,
+  290,   -1,   -1,   -1,   -1,   -1,   -1,   37,   93,   94,
+   40,   41,   42,   43,   44,   45,   -1,   47,  308,  309,
+   -1,   -1,   -1,  313,   -1,   -1,   -1,   41,   58,   59,
+   60,   -1,   62,   63,   -1,  260,  261,  262,  123,  124,
+   -1,   -1,   -1,    0,   -1,   59,   -1,   -1,   -1,   63,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   41,   -1,
+   -1,   -1,   -1,   93,   94,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   41,   -1,   -1,   59,   -1,   -1,   62,
+   37,   -1,  112,   40,   41,   42,   43,   44,   45,   -1,
+   47,   59,   -1,  123,  124,   63,  260,  261,  262,   -1,
+   -1,   58,   59,   60,   -1,   62,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,   -1,   -1,  268,  269,
+   -1,   -1,   -1,   -1,  274,   -1,   93,   -1,   -1,   -1,
+  280,  124,  282,  283,  284,  285,  286,   -1,  288,  289,
+  290,  291,  292,  293,  294,  295,  296,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,  123,  124,   -1,   -1,
+   -1,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,  274,
+   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+  285,  286,   -1,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,   -1,  300,  301,  302,  303,  304,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,  259,
+  260,  261,  262,  263,  264,  265,   -1,   -1,  268,  269,
+   -1,   -1,   -1,   -1,  274,   -1,  260,  261,  262,   -1,
+  280,   -1,  282,  283,  284,  285,  286,   -1,  288,  289,
+   -1,  291,  292,  293,  294,  295,  296,   -1,  298,   -1,
+  300,  301,  302,  303,  304,  289,  290,  260,  261,  262,
+   -1,   -1,  265,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  260,  261,  262,   -1,   -1,   -1,   -1,   -1,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,   -1,
+   -1,  268,  269,    0,   -1,   -1,   -1,  274,   -1,   -1,
+   -1,  289,  290,  280,   -1,  282,  283,  284,  285,  286,
+   -1,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,   -1,
+   37,   -1,   -1,   40,   41,   42,   43,   44,   45,   -1,
+   47,   -1,   -1,   -1,   -1,   -1,   -1,    0,   -1,   -1,
+   -1,   58,   59,   60,   -1,   62,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   37,   -1,   93,   40,   41,   42,
+   43,   44,   45,   -1,   47,   -1,   -1,   -1,   -1,   -1,
+   -1,    0,   -1,   -1,   -1,   58,   59,   60,   -1,   62,
+   63,   -1,   -1,   -1,   -1,   -1,  123,  124,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   37,   -1,
+   93,   40,   41,   42,   43,   44,   45,   -1,   47,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,
+   59,   60,   -1,   62,   63,   -1,   -1,   -1,   -1,   -1,
+  123,  124,   -1,   -1,   -1,    0,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   93,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   37,   -1,   -1,   40,   41,   42,   43,   44,
+   45,   -1,   47,   -1,  123,  124,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   58,   59,   60,   -1,   62,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,   -1,
+   -1,  268,  269,   -1,   -1,   -1,   -1,  274,   93,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,  285,  286,
+   -1,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,  123,  124,
+   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,  262,
+  263,  264,  265,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,  274,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,  285,  286,   -1,  288,  289,  290,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,  257,  258,
+  259,  260,  261,  262,  263,  264,  265,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   -1,  274,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,  285,  286,   -1,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,  298,
+   -1,  300,  301,  302,  303,  304,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,   -1,   -1,  268,  269,    0,   -1,   -1,   -1,  274,
+   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+  285,  286,   -1,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,   -1,  300,  301,  302,  303,  304,
+   -1,   -1,   37,   -1,   -1,   40,   41,   42,   43,   44,
+   45,   -1,   47,   -1,   -1,   -1,   -1,   -1,   -1,    0,
+   -1,   -1,   -1,   58,   59,   60,   -1,   62,   63,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   37,   -1,   93,   40,
+   41,   42,   43,   44,   45,   -1,   47,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,    0,   -1,   -1,   58,   59,   60,
+   -1,   62,   63,   -1,   -1,   -1,   -1,   -1,  123,  124,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   37,   93,   94,   40,   41,   42,   43,   44,   45,
+   -1,   47,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  112,   58,   59,   60,   -1,   62,   -1,   -1,   -1,
+   -1,   -1,  123,  124,   -1,   -1,   -1,    0,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  112,   40,   41,   -1,
+   43,   44,   45,   -1,   -1,   -1,   -1,  123,  124,   -1,
+   -1,   -1,   -1,   -1,   -1,   58,   59,   60,   -1,   62,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+  265,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,  274,
+   93,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+  285,  286,   -1,  288,  289,  290,  291,  292,  293,  294,
+  295,  296,   -1,  298,   -1,  300,  301,  302,  303,  304,
+  123,  124,   -1,   -1,   -1,   -1,  257,  258,  259,  260,
+  261,  262,  263,  264,  265,   -1,   -1,  268,  269,   -1,
+   -1,   -1,   -1,  274,   -1,   -1,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,  285,  286,   -1,   -1,  289,  290,
+  291,  292,  293,  294,  295,  296,   -1,  298,   -1,  300,
+   -1,   -1,  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  257,  258,  259,  260,  261,  262,  263,  264,  265,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,  274,   -1,
+   -1,   -1,   -1,   -1,  280,    0,  282,  283,  284,  285,
+  286,   -1,  288,   -1,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,
+   45,   -1,   -1,   -1,  257,  258,  259,  260,  261,  262,
+  263,  264,  265,    0,   59,  268,  269,   -1,   -1,   -1,
+   -1,  274,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,  285,  286,   -1,  288,  289,  290,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   -1,   40,   41,   -1,   43,   44,   45,   -1,
+   -1,    0,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   60,   -1,   62,   63,   -1,  123,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   40,   41,   -1,   -1,   44,   93,   -1,   -1,    0,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   58,
+   59,   60,   -1,   62,   63,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  123,  124,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,
+   41,   -1,   -1,   44,   93,   -1,   -1,   -1,   -1,   -1,
+   -1,    0,   -1,   -1,   -1,   -1,   -1,   58,   59,   60,
+   -1,   62,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  123,  124,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   40,   93,   -1,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,  257,  258,  259,  260,  261,  262,  263,  264,
+   59,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  123,  124,   -1,  280,   -1,  282,  283,  284,
+  285,  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,
+   -1,   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,   -1,
+   -1,  268,  269,   40,  123,   -1,   43,  274,   45,   -1,
+   -1,   -1,   -1,  280,    0,  282,  283,  284,  285,  286,
+   -1,  288,  289,  290,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,  257,  258,
+  259,  260,  261,  262,  263,  264,  265,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,   45,
+   -1,  280,   -1,  282,  283,  284,  285,  286,   -1,  288,
+  289,  290,  291,  292,  293,  294,  295,  296,   -1,  298,
+   -1,  300,  301,  302,  303,  304,  257,  258,  259,  260,
+  261,  262,  263,  264,  265,   -1,   -1,  268,  269,   -1,
+   40,   41,   -1,   43,   -1,   45,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,  285,  286,   -1,  288,  289,  290,
+  291,  292,  293,  294,  295,  296,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   -1,   -1,   -1,  123,  257,  258,
+  259,  260,  261,  262,  263,  264,    0,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,  285,  286,   -1,   -1,
+   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,
+   -1,  300,  301,  302,  303,  304,   40,   -1,   -1,   43,
+   -1,   45,   -1,   -1,    0,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  259,   -1,  261,  262,  263,  264,   -1,   -1,
+   -1,  268,  269,   -1,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,  280,    0,  282,  283,  284,   -1,  286,
+   -1,   -1,   -1,   59,  291,  292,  293,  294,   -1,   -1,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,  123,
+   -1,  257,  258,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,    0,  280,   -1,  282,  283,  284,  285,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,  259,
+   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,
+   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,   45,   -1,
+  280,   -1,  282,  283,  284,   -1,  286,   -1,   -1,   -1,
+   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,   -1,  123,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  257,  258,  259,  260,   -1,  262,  263,
+  264,   -1,   -1,   -1,  268,  269,  123,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
+  284,  285,  286,   -1,   -1,   -1,   -1,  291,  292,  293,
+  294,   -1,   -1,   -1,  298,   -1,  300,  301,  302,  303,
+  304,  257,  258,  259,  260,  261,  262,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,  285,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,
+   -1,  257,  258,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,  285,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,
+  257,  258,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,
+   -1,  268,  269,    0,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,  285,  286,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,   -1,
+   37,   -1,   -1,   40,   41,   42,   43,   44,   45,   -1,
+   47,   -1,   -1,   -1,   -1,   -1,   -1,   -1,    0,   -1,
+   -1,   58,   59,   60,   -1,   62,   63,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   37,   93,   94,   40,   41,
+   42,   43,   44,   45,   -1,   47,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  112,   58,   59,   -1,   -1,
+   62,   63,   -1,   -1,   -1,   -1,  123,  124,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   93,   94,   -1,   -1,   -1,   -1,    0,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  112,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,  124,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   37,   -1,   -1,   -1,   41,   42,
+   -1,   44,   -1,   -1,   47,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   58,   59,   60,   -1,   62,
+   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   93,   94,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,  258,  259,  260,  261,  262,  263,  264,  265,  112,
+   -1,  268,  269,   -1,   -1,   -1,   -1,  274,   -1,   -1,
+  123,  124,   -1,  280,   -1,  282,  283,  284,  285,  286,
+   -1,  288,  289,  290,  291,   -1,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,  258,  259,  260,  261,
+  262,  263,  264,  265,   -1,   -1,  268,  269,   14,   -1,
+   -1,   -1,  274,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,  285,  286,   -1,  288,  289,  290,  291,
+   -1,  293,  294,  295,  296,   -1,  298,   -1,  300,  301,
+  302,   -1,   -1,   49,   50,   51,   -1,   -1,   -1,   -1,
+   56,   57,   -1,   59,   60,   61,   -1,   63,   64,   65,
+   66,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   81,   -1,   -1,   -1,   85,
+   86,   87,   88,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  257,  258,   -1,  260,  261,  262,
+   -1,   -1,  265,   -1,   -1,   -1,  112,   -1,   -1,   -1,
+   -1,  274,  118,   -1,   -1,   -1,   -1,   -1,   -1,  125,
+   -1,   -1,  285,   -1,   -1,  288,  289,  290,  291,  292,
+  293,  294,  295,  296,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  150,  151,   -1,   -1,   -1,  155,
+  156,   -1,   -1,  159,  160,  161,  162,  163,   -1,   -1,
+   -1,   -1,  168,  169,   -1,  171,  172,   -1,   -1,   -1,
+  176,   -1,   -1,   -1,  180,   -1,    0,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  190,  191,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  214,   -1,
+   -1,  217,   -1,   37,   -1,   -1,    0,   41,   42,   -1,
+   44,   -1,   -1,   47,  230,   -1,  232,   -1,  234,   -1,
+  236,   -1,  238,   -1,   58,   59,   60,  243,   62,   63,
+   -1,   -1,  248,  249,   -1,   -1,   -1,   -1,   -1,   -1,
+  256,  257,   -1,   37,   -1,   -1,   -1,   41,   42,   -1,
+   44,   -1,   -1,   47,    0,   -1,   -1,   -1,   -1,   93,
+   94,   -1,   -1,   -1,   58,   59,   60,   -1,   62,   63,
+   -1,   -1,  288,  289,  290,  291,   -1,   -1,  112,   -1,
+  296,   -1,   -1,   -1,   -1,  301,   -1,   -1,   -1,  123,
+  124,   37,  308,  309,    0,   41,   42,  313,   44,   93,
+   94,   47,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   58,   59,   60,   -1,   62,   63,  112,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,
+  124,   37,   -1,   -1,   -1,   41,   42,   -1,   44,   -1,
+   -1,   47,   -1,   -1,   -1,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   58,   59,   60,   -1,   62,   63,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  112,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,  124,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   93,   94,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,
+   -1,   62,   -1,   -1,   -1,   -1,  112,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  123,  124,   -1,
+   -1,   -1,   -1,  257,  258,   -1,  260,  261,  262,   -1,
+   -1,  265,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  274,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  285,   -1,   -1,  288,  289,  290,  291,  292,  293,
+  294,  295,  296,  257,  258,   -1,  260,  261,  262,   -1,
+   -1,  265,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  274,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  285,   -1,   -1,  288,  289,  290,  291,  292,  293,
+  294,  295,  296,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  257,  258,   -1,  260,  261,  262,   -1,   -1,  265,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  274,   -1,
+   -1,   -1,   -1,    0,   -1,   -1,   -1,   -1,   -1,  285,
+   -1,   -1,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,  257,  258,   -1,  260,  261,  262,   -1,   -1,  265,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  274,   -1,
+   37,   -1,   -1,    0,   41,   42,   -1,   44,   -1,  285,
+   47,   -1,  288,  289,  290,  291,  292,  293,  294,  295,
+  296,   58,   59,   60,   -1,   62,   63,   -1,  259,   -1,
+   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,   -1,
+   37,   -1,   -1,   -1,   41,   42,   -1,   44,    0,  280,
+   47,  282,  283,  284,   -1,  286,   93,   94,   -1,   -1,
+   -1,   58,   59,   -1,   -1,  296,   63,  298,   -1,  300,
+  301,  302,  303,  304,   -1,  112,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   37,  123,  124,    0,   41,
+   42,   -1,   44,   -1,   -1,   47,   93,   94,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,  112,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   37,  123,  124,   -1,   41,
+   42,   -1,   44,    0,   -1,   47,   -1,   -1,   -1,   -1,
+   -1,   93,   94,   -1,   -1,   -1,   58,   59,   -1,   -1,
+   -1,   63,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  112,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   37,  123,  124,   -1,   41,   42,   -1,   44,   -1,   -1,
+   47,   93,   94,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+  112,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,  124,   -1,   40,   41,   -1,   43,   44,   45,
+  257,  258,   -1,  260,  261,  262,   93,   94,  265,   -1,
+   -1,   -1,   -1,   -1,   60,   -1,   62,  274,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  112,   -1,   -1,  285,   -1,
+   -1,  288,  289,  290,   -1,   -1,  123,  124,  295,  296,
+  257,  258,   -1,  260,  261,  262,   -1,   -1,  265,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  274,   -1,   -1,
+   40,   -1,   -1,   43,   -1,   45,   -1,   -1,  285,   -1,
+   -1,  288,  289,  290,  291,  292,  293,  294,  295,   59,
+   -1,   -1,   -1,   -1,   -1,  257,  258,   -1,  260,  261,
+  262,   -1,   -1,  265,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  274,    0,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  285,   -1,   -1,  288,  289,  290,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,  258,   -1,  260,  261,
+  262,   -1,   -1,  265,   -1,   -1,   -1,   -1,   -1,   -1,
+   37,   -1,  274,  123,   41,   42,   -1,   44,    0,   -1,
+   47,   -1,   -1,  285,   -1,   -1,  288,  289,  290,   -1,
+   -1,   58,   59,   -1,   -1,   -1,   63,   -1,   -1,   -1,
+  257,  258,   -1,  260,  261,  262,   -1,   -1,  265,   -1,
+   -1,   -1,   -1,   -1,   -1,   37,   -1,  274,   -1,   41,
+   42,   -1,   -1,   -1,   -1,   47,   93,   94,  285,   -1,
+   -1,  288,  289,  290,   -1,   -1,   58,   59,   -1,   -1,
+   -1,   63,   -1,  259,   -1,  112,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   40,  123,  124,   43,   -1,
+   45,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   93,   94,   -1,   59,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,
+  112,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  123,  124,   -1,   -1,   -1,   -1,   -1,   -1,  259,
+  260,  261,  262,  263,  264,   -1,  266,  267,  268,  269,
+  270,   -1,  272,  273,   -1,  275,  276,  277,  278,  279,
+  280,  281,  282,  283,  284,   -1,  286,  287,  123,   -1,
+  125,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,   -1,   -1,   -1,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  257,  258,   -1,  260,  261,  262,   -1,   -1,  265,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  274,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  285,   -1,
+   -1,  288,  289,  290,   -1,   -1,   -1,   40,   -1,   -1,
+   43,   -1,   45,   -1,   -1,  257,  258,   -1,  260,  261,
+  262,   -1,  123,  265,  125,   -1,   59,   -1,   -1,   -1,
+   -1,   -1,  274,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  285,   -1,   -1,  288,  289,  290,   -1,
+   -1,   -1,   -1,   -1,  259,  260,   -1,   -1,  263,  264,
+   -1,  266,  267,  268,  269,  270,  271,  272,  273,   -1,
+  275,  276,  277,  278,  279,  280,  281,  282,  283,  284,
+   -1,  286,  287,   -1,   -1,   -1,  291,  292,  293,  294,
+  123,   -1,  125,  298,   -1,  300,  301,  302,  303,  304,
+   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   40,   -1,   -1,   43,   -1,   45,  259,  260,
+   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,  270,
+  271,  272,  273,   -1,  275,  276,  277,  278,  279,  280,
+  281,  282,  283,  284,   -1,  286,  287,  123,   -1,  125,
+  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   59,   -1,   -1,  259,  260,   -1,   -1,
+  263,  264,   -1,  266,  267,  268,  269,  270,  271,  272,
+  273,   -1,  275,  276,  277,  278,  279,  280,  281,  282,
+  283,  284,   -1,  286,  287,   -1,   -1,   -1,  291,  292,
+  293,  294,   -1,   -1,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,
+   -1,   45,   -1,   -1,   -1,   -1,   -1,  123,   -1,  125,
+   -1,   -1,   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  259,  260,   -1,   -1,  263,  264,   -1,
+  266,  267,  268,  269,  270,  271,  272,  273,   -1,  275,
+  276,  277,  278,  279,  280,  281,  282,  283,  284,   -1,
+  286,  287,   -1,   -1,   -1,  291,  292,  293,  294,  123,
+   -1,  125,  298,   -1,  300,  301,  302,  303,  304,   40,
+   -1,  259,   43,   -1,   45,  263,  264,   -1,   -1,   -1,
+  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,
+   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,
+  298,   -1,  300,  301,  302,  303,  304,   40,   -1,   -1,
+   43,   -1,   45,  259,  260,   -1,   -1,  263,  264,   -1,
+  266,  267,  268,  269,  270,  271,  272,  273,   -1,  275,
+  276,  277,  278,  279,  280,  281,  282,  283,  284,   -1,
+  286,  287,  123,   -1,  125,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -1,
+   -1,   -1,   -1,   -1,   -1,  259,  260,   -1,   -1,  263,
+  264,   -1,  266,  267,  268,  269,  270,  271,  272,  273,
+   -1,  275,  276,  277,  278,  279,  280,  281,  282,  283,
+  284,   -1,  286,  287,   -1,   -1,   -1,  291,  292,  293,
+  294,   -1,   -1,   -1,  298,   -1,  300,  301,  302,  303,
+  304,   40,   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,  123,   -1,  125,   -1,   -1,   -1,   -1,   -1,
+   59,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  259,  260,
+   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,  270,
+  271,  272,  273,   -1,  275,  276,  277,  278,  279,  280,
+  281,  282,  283,  284,   -1,  286,  287,   -1,   -1,   -1,
+  291,  292,  293,  294,  123,   -1,  125,  298,   -1,  300,
+  301,  302,  303,  304,   40,   -1,  259,   43,   -1,   45,
+  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -1,   59,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,   -1,   -1,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   40,   -1,   -1,   43,   -1,   45,  259,  260,
+   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,  270,
+  271,  272,  273,   -1,  275,  276,  277,  278,  279,  280,
+  281,  282,  283,  284,   -1,  286,  287,  123,   -1,  125,
+  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,   -1,   -1,
+  259,  260,   -1,   -1,  263,  264,   -1,  266,  267,  268,
+  269,  270,   -1,  272,  273,   -1,  275,  276,  277,  278,
+  279,  280,  281,  282,  283,  284,   -1,  286,  287,   -1,
+   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,
+   -1,  300,  301,  302,  303,  304,   40,   -1,   -1,   43,
+   -1,   45,   -1,   -1,   -1,   -1,   -1,  123,   -1,  125,
+   -1,   -1,   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  259,  260,   -1,   -1,  263,  264,   -1,
+  266,  267,  268,  269,  270,   -1,  272,  273,   -1,  275,
+  276,  277,  278,  279,  280,  281,  282,  283,  284,   -1,
+  286,  287,   -1,   -1,   -1,  291,  292,  293,  294,  123,
+   -1,  125,  298,   -1,  300,  301,  302,  303,  304,   40,
+   -1,  259,   43,   -1,   45,  263,  264,   -1,   -1,   -1,
+  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,
+   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,
+  298,   -1,  300,  301,  302,  303,  304,   -1,   -1,   -1,
+   -1,   -1,   -1,  259,  260,   -1,   -1,  263,  264,   -1,
+  266,  267,  268,  269,  270,   -1,  272,  273,   -1,  275,
+  276,  277,  278,  279,  280,  281,  282,  283,  284,   -1,
+  286,  287,  123,   -1,  125,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   59,   -1,
+   -1,   -1,   -1,   -1,   -1,  259,  260,   -1,   -1,  263,
+  264,   -1,  266,  267,  268,  269,  270,   -1,  272,  273,
+   -1,  275,  276,  277,  278,  279,  280,  281,  282,  283,
+  284,   -1,  286,  287,   -1,   -1,   -1,  291,  292,  293,
+  294,   -1,   -1,   -1,  298,   -1,  300,  301,  302,  303,
+  304,   40,   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,  123,   -1,  125,   -1,   -1,   -1,   -1,   -1,
+   59,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  259,  260,
+   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,  270,
+   -1,  272,  273,   -1,  275,  276,  277,  278,  279,  280,
+  281,  282,  283,  284,   -1,  286,  287,   -1,   -1,   -1,
+  291,  292,  293,  294,  123,   -1,  125,  298,   -1,  300,
+  301,  302,  303,  304,   40,   -1,   -1,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   59,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   40,   -1,   -1,   43,   -1,   45,   -1,   -1,  259,  260,
+   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,  270,
+   -1,  272,  273,   -1,  275,  276,  277,  278,  279,  280,
+  281,  282,  283,  284,   -1,  286,  287,  123,   -1,  125,
+  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   40,   41,   -1,   43,   44,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   60,   -1,   62,   -1,   -1,   -1,
+  259,  260,   -1,   -1,  263,  264,   -1,  266,  267,  268,
+  269,  270,   -1,  272,  273,   -1,  275,  276,  277,  278,
+  279,  280,  281,  282,  283,  284,   -1,  286,  287,   -1,
+   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,
+   -1,  300,  301,  302,  303,  304,   40,   41,   -1,   43,
+   44,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   60,   -1,   62,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  259,  260,   -1,   -1,  263,  264,   -1,
+  266,  267,  268,  269,  270,   -1,  272,  273,   -1,  275,
+  276,  277,  278,  279,  280,  281,  282,  283,  284,   -1,
+  286,  287,   -1,   -1,   -1,  291,  292,  293,  294,   -1,
+   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,  259,
+   -1,   -1,   -1,  263,  264,   -1,  266,  267,  268,  269,
+   -1,   -1,   -1,   -1,   -1,  275,  276,  277,  278,  279,
+  280,   -1,  282,  283,  284,   -1,  286,  287,   -1,   -1,
+   -1,  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   40,   41,   -1,   43,   44,
+   45,   -1,   -1,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   60,   -1,   62,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,   40,
+   41,   -1,   43,   44,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,
+   -1,   62,   -1,   -1,   -1,  259,   -1,   -1,   -1,  263,
+  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,
+  284,   40,  286,   -1,   43,   44,   45,  291,  292,  293,
+  294,  295,  296,   -1,  298,   -1,  300,  301,  302,  303,
+  304,   60,   -1,   62,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,   -1,   62,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   40,   -1,   -1,   43,   44,   45,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   60,  259,   62,   -1,   -1,  263,  264,
+   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+   40,  286,   -1,   43,   44,   45,  291,  292,  293,  294,
+  295,  296,   -1,  298,   -1,  300,  301,  302,  303,  304,
+   60,   -1,   62,   -1,   -1,   -1,   -1,   -1,  259,   -1,
+   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,   40,  286,   -1,   43,   44,   45,
+  291,  292,  293,  294,  295,  296,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   60,   -1,   62,   -1,   -1,   -1,
+  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,
+  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,   -1,
+   -1,   -1,  291,  292,  293,  294,  295,  296,   -1,  298,
+   -1,  300,  301,  302,  303,  304,  259,   -1,   -1,   -1,
+  263,  264,   -1,   -1,   40,  268,  269,   43,   44,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,  286,   60,   -1,   62,   -1,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,
+   40,  268,  269,   43,   44,   45,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,
+   60,   -1,   62,   -1,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,  259,
+   -1,   -1,   -1,  263,  264,   -1,   -1,   40,  268,  269,
+   43,   44,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  280,   -1,  282,  283,  284,   -1,  286,   60,   -1,   62,
+   -1,  291,  292,  293,  294,  295,  296,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   40,  268,  269,   43,   -1,   45,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   58,
+  286,   60,   -1,   62,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,   -1,   62,
+   -1,   -1,   -1,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,  259,
+   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+  280,   -1,  282,  283,  284,   -1,  286,   -1,   -1,   -1,
+   -1,  291,  292,  293,  294,  295,  296,   -1,  298,   -1,
+  300,  301,  302,  303,  304,   -1,  259,   -1,   -1,   -1,
+  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   40,   41,   -1,   43,   -1,   45,   -1,   -1,
+  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,  268,
+  269,   -1,   60,   -1,   62,   -1,   -1,   -1,   -1,   -1,
+   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,   -1,
+   -1,   -1,  291,  292,  293,  294,  295,  296,   -1,  298,
+   -1,  300,  301,  302,  303,  304,  259,   -1,   -1,   -1,
+  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,   40,   41,   -1,   43,   -1,   45,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   60,   -1,   62,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   40,   41,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,   -1,
+   62,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   40,   41,   -1,   43,   -1,   45,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   60,   -1,   62,   -1,   -1,   -1,
+   -1,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,
+  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,
+   -1,   -1,   -1,  291,  292,  293,  294,  295,  296,   -1,
+  298,   -1,  300,  301,  302,  303,  304,   40,   41,   -1,
+   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,   -1,   62,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   40,   41,   -1,   43,   -1,   45,   -1,
+   -1,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   -1,
+  268,  269,   -1,   60,   -1,   62,   -1,   -1,   -1,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,
+   -1,   -1,   -1,  291,  292,  293,  294,  295,  296,   -1,
+  298,   -1,  300,  301,  302,  303,  304,  259,   -1,   -1,
+   -1,  263,  264,   -1,   -1,   -1,  268,  269,   40,   -1,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,
+  292,  293,  294,  295,  296,   -1,  298,   -1,  300,  301,
+  302,  303,  304,  259,   -1,   -1,   -1,  263,  264,   -1,
+   -1,   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,
+  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,  295,
+  296,   -1,  298,   -1,  300,  301,  302,  303,  304,   40,
+   41,  123,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   60,
+   -1,   62,   -1,   -1,   -1,   -1,  259,   -1,   -1,   -1,
+  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,
+  283,  284,   40,  286,   -1,   43,   -1,   45,  291,  292,
+  293,  294,  295,  296,   -1,  298,   -1,  300,  301,  302,
+  303,  304,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,
+   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   40,   41,
+   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,  257,  258,  259,   60,   -1,
+   62,  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,  285,  286,   -1,   -1,   -1,   -1,  291,
+  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,  301,
+  302,  303,  304,   40,   -1,   -1,   43,   -1,   45,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   60,   -1,   62,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  259,   -1,
+   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,   40,
+   -1,   -1,   43,   -1,   45,   -1,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,   -1,  286,   -1,   -1,   59,   -1,
+  291,  292,  293,  294,  295,  296,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,   40,
+  268,  269,   43,   -1,   45,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,   -1,
+   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,   -1,
+  298,   -1,  300,  301,  302,  303,  304,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   40,   -1,   -1,   43,   -1,
+   45,   -1,   -1,   -1,   -1,   -1,   -1,  259,   -1,   -1,
+   -1,  263,  264,   -1,   -1,   -1,  268,  269,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,   -1,
+  282,  283,  284,   -1,  286,   -1,   -1,   -1,   -1,  291,
+  292,  293,  294,  295,  296,   -1,  298,   -1,  300,  301,
+  302,  303,  304,   40,   -1,   -1,   43,   -1,   45,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,
+   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,  295,  296,
+   -1,  298,   -1,  300,  301,  302,  303,  304,  259,   -1,
+   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,   -1,  286,   -1,   -1,   -1,   -1,
+  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,
+  301,  302,  303,  304,   -1,   -1,   -1,   -1,  259,   -1,
+   -1,   -1,  263,  264,   -1,   -1,   -1,  268,  269,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  280,
+   -1,  282,  283,  284,   -1,  286,   -1,   -1,   -1,   -1,
+  291,  292,  293,  294,   -1,   -1,   -1,  298,   -1,  300,
+  301,  302,  303,  304,  259,   -1,   -1,   -1,  263,  264,
+   -1,   -1,   -1,  268,  269,   -1,   -1,   47,   48,   -1,
+   -1,   -1,   -1,   -1,   -1,  280,   -1,  282,  283,  284,
+   -1,  286,   -1,   -1,   -1,   -1,  291,  292,  293,  294,
+   -1,   -1,   -1,  298,   -1,  300,  301,  302,  303,  304,
+   80,   -1,   82,   83,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,  259,   -1,   -1,   -1,  263,  264,   -1,   -1,
+   -1,  268,  269,   -1,   -1,   -1,   -1,   -1,  108,  109,
+   -1,   -1,   -1,  280,   -1,  282,  283,  284,   -1,  286,
+   -1,   -1,   -1,   -1,  291,  292,  293,  294,   -1,   -1,
+   -1,  298,   -1,  300,  301,  302,  303,  304,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   27,
+   28,   -1,   -1,   -1,   -1,   33,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   41,   -1,   -1,   -1,   -1,   -1,   -1,
+  170,   -1,   -1,   -1,   -1,   -1,   54,   -1,   -1,   -1,
+   -1,  181,   -1,  183,   -1,  185,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  206,   -1,   -1,   -1,
+   -1,   -1,   -1,   91,   92,   93,   94,   95,   96,   -1,
+   -1,  221,  222,  223,  224,  225,  104,   -1,  106,   -1,
+   -1,   -1,  110,  111,   -1,   -1,  114,   -1,  116,  117,
+   -1,   -1,   -1,  121,  122,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  132,   -1,   -1,   -1,   -1,  137,
+  138,  139,  140,   -1,   -1,   -1,   -1,   -1,   -1,  269,
+   -1,   -1,   -1,  273,  274,  275,   -1,   -1,   -1,  279,
+  158,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  304,  305,   -1,   -1,  186,   -1,
+  310,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  197,
+  198,   -1,  200,  201,  202,  203,   -1,  205,   -1,  207,
+  208,   -1,   -1,   -1,   -1,   -1,   -1,  215,  216,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,  227,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,  252,   -1,   -1,   -1,   -1,   -1,
+   -1,   -1,   -1,   -1,   -1,   -1,  264,  265,  266,  267,
+  268,   -1,  270,  271,  272,
+};
+#define YYFINAL 1
+#ifndef YYDEBUG
+#define YYDEBUG 0
+#endif
+#define YYMAXTOKEN 304
+#if YYDEBUG
+char *yyname[] = {
+"end-of-file",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,"'%'",0,0,"'('","')'","'*'","'+'","','","'-'",0,"'/'",0,0,0,0,0,0,0,0,0,0,
+"':'","';'","'<'",0,"'>'","'?'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,"'['",0,"']'","'^'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"'p'",0,0,0,0,0,0,0,
+0,0,0,"'{'","'|'","'}'",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,"BEGIN","END","REGEX","SEMINEW",
+"NEWLINE","COMMENT","FUN1","FUNN","GRGR","PRINT","PRINTF","SPRINTF","SPLIT",
+"IF","ELSE","WHILE","FOR","IN","EXIT","NEXT","BREAK","CONTINUE","RET","GETLINE",
+"DO","SUB","GSUB","MATCH","FUNCTION","USERFUN","DELETE","ASGNOP","OROR",
+"ANDAND","NUMBER","VAR","SUBSTR","INDEX","MATCHOP","RELOP","OR","STRING",
+"UMINUS","NOT","INCR","DECR","FIELD","VFIELD",
+};
+char *yyrule[] = {
+"$accept : program",
+"program : junk hunks",
+"begin : BEGIN '{' maybe states '}' junk",
+"end : END '{' maybe states '}'",
+"end : end NEWLINE",
+"hunks : hunks hunk junk",
+"hunks :",
+"hunk : patpat",
+"hunk : patpat '{' maybe states '}'",
+"hunk : FUNCTION USERFUN '(' arg_list ')' maybe '{' maybe states '}'",
+"hunk : '{' maybe states '}'",
+"hunk : begin",
+"hunk : end",
+"arg_list : expr_list",
+"patpat : cond",
+"patpat : cond ',' cond",
+"cond : expr",
+"cond : match",
+"cond : rel",
+"cond : compound_cond",
+"cond : cond '?' expr ':' expr",
+"compound_cond : '(' compound_cond ')'",
+"compound_cond : cond ANDAND maybe cond",
+"compound_cond : cond OROR maybe cond",
+"compound_cond : NOT cond",
+"rel : expr RELOP expr",
+"rel : expr '>' expr",
+"rel : expr '<' expr",
+"rel : '(' rel ')'",
+"match : expr MATCHOP expr",
+"match : expr MATCHOP REGEX",
+"match : REGEX",
+"match : '(' match ')'",
+"expr : term",
+"expr : expr term",
+"expr : variable ASGNOP cond",
+"term : variable",
+"term : NUMBER",
+"term : STRING",
+"term : term '+' term",
+"term : term '-' term",
+"term : term '*' term",
+"term : term '/' term",
+"term : term '%' term",
+"term : term '^' term",
+"term : term IN VAR",
+"term : cond '?' expr ':' expr",
+"term : variable INCR",
+"term : variable DECR",
+"term : INCR variable",
+"term : DECR variable",
+"term : '-' term",
+"term : '+' term",
+"term : '(' cond ')'",
+"term : GETLINE",
+"term : GETLINE variable",
+"term : GETLINE '<' expr",
+"term : GETLINE variable '<' expr",
+"term : term 'p' GETLINE",
+"term : term 'p' GETLINE variable",
+"term : FUN1",
+"term : FUN1 '(' ')'",
+"term : FUN1 '(' expr ')'",
+"term : FUNN '(' expr_list ')'",
+"term : USERFUN '(' expr_list ')'",
+"term : SPRINTF expr_list",
+"term : SUBSTR '(' expr ',' expr ',' expr ')'",
+"term : SUBSTR '(' expr ',' expr ')'",
+"term : SPLIT '(' expr ',' VAR ',' expr ')'",
+"term : SPLIT '(' expr ',' VAR ',' REGEX ')'",
+"term : SPLIT '(' expr ',' VAR ')'",
+"term : INDEX '(' expr ',' expr ')'",
+"term : MATCH '(' expr ',' REGEX ')'",
+"term : MATCH '(' expr ',' expr ')'",
+"term : SUB '(' expr ',' expr ')'",
+"term : SUB '(' REGEX ',' expr ')'",
+"term : GSUB '(' expr ',' expr ')'",
+"term : GSUB '(' REGEX ',' expr ')'",
+"term : SUB '(' expr ',' expr ',' expr ')'",
+"term : SUB '(' REGEX ',' expr ',' expr ')'",
+"term : GSUB '(' expr ',' expr ',' expr ')'",
+"term : GSUB '(' REGEX ',' expr ',' expr ')'",
+"variable : VAR",
+"variable : VAR '[' expr_list ']'",
+"variable : FIELD",
+"variable : VFIELD term",
+"expr_list : expr",
+"expr_list : clist",
+"expr_list :",
+"clist : expr ',' maybe expr",
+"clist : clist ',' maybe expr",
+"clist : '(' clist ')'",
+"junk : junk hunksep",
+"junk :",
+"hunksep : ';'",
+"hunksep : SEMINEW",
+"hunksep : NEWLINE",
+"hunksep : COMMENT",
+"maybe : maybe nlstuff",
+"maybe :",
+"nlstuff : NEWLINE",
+"nlstuff : COMMENT",
+"separator : ';' maybe",
+"separator : SEMINEW maybe",
+"separator : NEWLINE maybe",
+"separator : COMMENT maybe",
+"states : states statement",
+"states :",
+"statement : simple separator maybe",
+"statement : ';' maybe",
+"statement : SEMINEW maybe",
+"statement : compound",
+"simpnull : simple",
+"simpnull :",
+"simple : expr",
+"simple : PRINT expr_list redir expr",
+"simple : PRINT expr_list",
+"simple : PRINTF expr_list redir expr",
+"simple : PRINTF expr_list",
+"simple : BREAK",
+"simple : NEXT",
+"simple : EXIT",
+"simple : EXIT expr",
+"simple : CONTINUE",
+"simple : RET",
+"simple : RET expr",
+"simple : DELETE VAR '[' expr_list ']'",
+"redir : '>'",
+"redir : GRGR",
+"redir : '|'",
+"compound : IF '(' cond ')' maybe statement",
+"compound : IF '(' cond ')' maybe statement ELSE maybe statement",
+"compound : WHILE '(' cond ')' maybe statement",
+"compound : DO maybe statement WHILE '(' cond ')'",
+"compound : FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement",
+"compound : FOR '(' simpnull ';' ';' simpnull ')' maybe statement",
+"compound : FOR '(' expr ')' maybe statement",
+"compound : '{' maybe states '}' maybe",
+};
+#endif
+#ifndef YYSTYPE
+typedef int YYSTYPE;
+#endif
+#define yyclearin (yychar=(-1))
+#define yyerrok (yyerrflag=0)
+#ifdef YYSTACKSIZE
+#ifndef YYMAXDEPTH
+#define YYMAXDEPTH YYSTACKSIZE
+#endif
+#else
+#ifdef YYMAXDEPTH
+#define YYSTACKSIZE YYMAXDEPTH
+#else
+#define YYSTACKSIZE 500
+#define YYMAXDEPTH 500
+#endif
+#endif
+int yydebug;
+int yynerrs;
+int yyerrflag;
+int yychar;
+short *yyssp;
+YYSTYPE *yyvsp;
+YYSTYPE yyval;
+YYSTYPE yylval;
+short yyss[YYSTACKSIZE];
+YYSTYPE yyvs[YYSTACKSIZE];
+#define yystacksize YYSTACKSIZE
+#line 396 "a2p.y"
+#include "a2py.c"
+#line 1945 "y.tab.c"
+#define YYABORT goto yyabort
+#define YYACCEPT goto yyaccept
+#define YYERROR goto yyerrlab
+int
+yyparse()
+{
+    register int yym, yyn, yystate;
+#if YYDEBUG
+    register char *yys;
+    extern char *getenv();
+
+    if (yys = getenv("YYDEBUG"))
+    {
+        yyn = *yys;
+        if (yyn >= '0' && yyn <= '9')
+            yydebug = yyn - '0';
+    }
+#endif
+
+    yynerrs = 0;
+    yyerrflag = 0;
+    yychar = (-1);
+
+    yyssp = yyss;
+    yyvsp = yyvs;
+    *yyssp = yystate = 0;
+
+yyloop:
+    if (yyn = yydefred[yystate]) goto yyreduce;
+    if (yychar < 0)
+    {
+        if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            printf("yydebug: state %d, reading %d (%s)\n", yystate,
+                    yychar, yys);
+        }
+#endif
+    }
+    if ((yyn = yysindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("yydebug: state %d, shifting to state %d\n",
+                    yystate, yytable[yyn]);
+#endif
+        if (yyssp >= yyss + yystacksize - 1)
+        {
+            goto yyoverflow;
+        }
+        *++yyssp = yystate = yytable[yyn];
+        *++yyvsp = yylval;
+        yychar = (-1);
+        if (yyerrflag > 0)  --yyerrflag;
+        goto yyloop;
+    }
+    if ((yyn = yyrindex[yystate]) && (yyn += yychar) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yychar)
+    {
+        yyn = yytable[yyn];
+        goto yyreduce;
+    }
+    if (yyerrflag) goto yyinrecovery;
+#ifdef lint
+    goto yynewerror;
+#endif
+yynewerror:
+    yyerror("syntax error");
+#ifdef lint
+    goto yyerrlab;
+#endif
+yyerrlab:
+    ++yynerrs;
+yyinrecovery:
+    if (yyerrflag < 3)
+    {
+        yyerrflag = 3;
+        for (;;)
+        {
+            if ((yyn = yysindex[*yyssp]) && (yyn += YYERRCODE) >= 0 &&
+                    yyn <= YYTABLESIZE && yycheck[yyn] == YYERRCODE)
+            {
+#if YYDEBUG
+                if (yydebug)
+                    printf("yydebug: state %d, error recovery shifting\
+ to state %d\n", *yyssp, yytable[yyn]);
+#endif
+                if (yyssp >= yyss + yystacksize - 1)
+                {
+                    goto yyoverflow;
+                }
+                *++yyssp = yystate = yytable[yyn];
+                *++yyvsp = yylval;
+                goto yyloop;
+            }
+            else
+            {
+#if YYDEBUG
+                if (yydebug)
+                    printf("yydebug: error recovery discarding state %d\n",
+                            *yyssp);
+#endif
+                if (yyssp <= yyss) goto yyabort;
+                --yyssp;
+                --yyvsp;
+            }
+        }
+    }
+    else
+    {
+        if (yychar == 0) goto yyabort;
+#if YYDEBUG
+        if (yydebug)
+        {
+            yys = 0;
+            if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+            if (!yys) yys = "illegal-symbol";
+            printf("yydebug: state %d, error recovery discards token %d (%s)\n",
+                    yystate, yychar, yys);
+        }
+#endif
+        yychar = (-1);
+        goto yyloop;
+    }
+yyreduce:
+#if YYDEBUG
+    if (yydebug)
+        printf("yydebug: state %d, reducing by rule %d (%s)\n",
+                yystate, yyn, yyrule[yyn]);
+#endif
+    yym = yylen[yyn];
+    yyval = yyvsp[1-yym];
+    switch (yyn)
+    {
+case 1:
+#line 51 "a2p.y"
+{ root = oper4(OPROG,yyvsp[-1],begins,yyvsp[0],ends); }
+break;
+case 2:
+#line 55 "a2p.y"
+{ begins = oper4(OJUNK,begins,yyvsp[-3],yyvsp[-2],yyvsp[0]); in_begin = FALSE;
+		    yyval = Nullop; }
+break;
+case 3:
+#line 60 "a2p.y"
+{ ends = oper3(OJUNK,ends,yyvsp[-2],yyvsp[-1]); yyval = Nullop; }
+break;
+case 4:
+#line 62 "a2p.y"
+{ yyval = yyvsp[-1]; }
+break;
+case 5:
+#line 66 "a2p.y"
+{ yyval = oper3(OHUNKS,yyvsp[-2],yyvsp[-1],yyvsp[0]); }
+break;
+case 6:
+#line 68 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 7:
+#line 72 "a2p.y"
+{ yyval = oper1(OHUNK,yyvsp[0]); need_entire = TRUE; }
+break;
+case 8:
+#line 74 "a2p.y"
+{ yyval = oper2(OHUNK,yyvsp[-4],oper2(OJUNK,yyvsp[-2],yyvsp[-1])); }
+break;
+case 9:
+#line 76 "a2p.y"
+{ fixfargs(yyvsp[-8],yyvsp[-6],0); yyval = oper5(OUSERDEF,yyvsp[-8],yyvsp[-6],yyvsp[-4],yyvsp[-2],yyvsp[-1]); }
+break;
+case 10:
+#line 78 "a2p.y"
+{ yyval = oper2(OHUNK,Nullop,oper2(OJUNK,yyvsp[-2],yyvsp[-1])); }
+break;
+case 13:
+#line 84 "a2p.y"
+{ yyval = rememberargs(yyval); }
+break;
+case 14:
+#line 88 "a2p.y"
+{ yyval = oper1(OPAT,yyvsp[0]); }
+break;
+case 15:
+#line 90 "a2p.y"
+{ yyval = oper2(ORANGE,yyvsp[-2],yyvsp[0]); }
+break;
+case 20:
+#line 98 "a2p.y"
+{ yyval = oper3(OCOND,yyvsp[-4],yyvsp[-2],yyvsp[0]); }
+break;
+case 21:
+#line 103 "a2p.y"
+{ yyval = oper1(OCPAREN,yyvsp[-1]); }
+break;
+case 22:
+#line 105 "a2p.y"
+{ yyval = oper3(OCANDAND,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 23:
+#line 107 "a2p.y"
+{ yyval = oper3(OCOROR,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 24:
+#line 109 "a2p.y"
+{ yyval = oper1(OCNOT,yyvsp[0]); }
+break;
+case 25:
+#line 113 "a2p.y"
+{ yyval = oper3(ORELOP,yyvsp[-1],yyvsp[-2],yyvsp[0]); }
+break;
+case 26:
+#line 115 "a2p.y"
+{ yyval = oper3(ORELOP,string(">",1),yyvsp[-2],yyvsp[0]); }
+break;
+case 27:
+#line 117 "a2p.y"
+{ yyval = oper3(ORELOP,string("<",1),yyvsp[-2],yyvsp[0]); }
+break;
+case 28:
+#line 119 "a2p.y"
+{ yyval = oper1(ORPAREN,yyvsp[-1]); }
+break;
+case 29:
+#line 123 "a2p.y"
+{ yyval = oper3(OMATCHOP,yyvsp[-1],yyvsp[-2],yyvsp[0]); }
+break;
+case 30:
+#line 125 "a2p.y"
+{ yyval = oper3(OMATCHOP,yyvsp[-1],yyvsp[-2],oper1(OREGEX,yyvsp[0])); }
+break;
+case 31:
+#line 127 "a2p.y"
+{ yyval = oper1(OREGEX,yyvsp[0]); }
+break;
+case 32:
+#line 129 "a2p.y"
+{ yyval = oper1(OMPAREN,yyvsp[-1]); }
+break;
+case 33:
+#line 133 "a2p.y"
+{ yyval = yyvsp[0]; }
+break;
+case 34:
+#line 135 "a2p.y"
+{ yyval = oper2(OCONCAT,yyvsp[-1],yyvsp[0]); }
+break;
+case 35:
+#line 137 "a2p.y"
+{ yyval = oper3(OASSIGN,yyvsp[-1],yyvsp[-2],yyvsp[0]);
+			if ((ops[yyvsp[-2]].ival & 255) == OFLD)
+			    lval_field = TRUE;
+			if ((ops[yyvsp[-2]].ival & 255) == OVFLD)
+			    lval_field = TRUE;
+		}
+break;
+case 36:
+#line 146 "a2p.y"
+{ yyval = yyvsp[0]; }
+break;
+case 37:
+#line 148 "a2p.y"
+{ yyval = oper1(ONUM,yyvsp[0]); }
+break;
+case 38:
+#line 150 "a2p.y"
+{ yyval = oper1(OSTR,yyvsp[0]); }
+break;
+case 39:
+#line 152 "a2p.y"
+{ yyval = oper2(OADD,yyvsp[-2],yyvsp[0]); }
+break;
+case 40:
+#line 154 "a2p.y"
+{ yyval = oper2(OSUBTRACT,yyvsp[-2],yyvsp[0]); }
+break;
+case 41:
+#line 156 "a2p.y"
+{ yyval = oper2(OMULT,yyvsp[-2],yyvsp[0]); }
+break;
+case 42:
+#line 158 "a2p.y"
+{ yyval = oper2(ODIV,yyvsp[-2],yyvsp[0]); }
+break;
+case 43:
+#line 160 "a2p.y"
+{ yyval = oper2(OMOD,yyvsp[-2],yyvsp[0]); }
+break;
+case 44:
+#line 162 "a2p.y"
+{ yyval = oper2(OPOW,yyvsp[-2],yyvsp[0]); }
+break;
+case 45:
+#line 164 "a2p.y"
+{ yyval = oper2(ODEFINED,aryrefarg(yyvsp[0]),yyvsp[-2]); }
+break;
+case 46:
+#line 166 "a2p.y"
+{ yyval = oper3(OCOND,yyvsp[-4],yyvsp[-2],yyvsp[0]); }
+break;
+case 47:
+#line 168 "a2p.y"
+{ yyval = oper1(OPOSTINCR,yyvsp[-1]); }
+break;
+case 48:
+#line 170 "a2p.y"
+{ yyval = oper1(OPOSTDECR,yyvsp[-1]); }
+break;
+case 49:
+#line 172 "a2p.y"
+{ yyval = oper1(OPREINCR,yyvsp[0]); }
+break;
+case 50:
+#line 174 "a2p.y"
+{ yyval = oper1(OPREDECR,yyvsp[0]); }
+break;
+case 51:
+#line 176 "a2p.y"
+{ yyval = oper1(OUMINUS,yyvsp[0]); }
+break;
+case 52:
+#line 178 "a2p.y"
+{ yyval = oper1(OUPLUS,yyvsp[0]); }
+break;
+case 53:
+#line 180 "a2p.y"
+{ yyval = oper1(OPAREN,yyvsp[-1]); }
+break;
+case 54:
+#line 182 "a2p.y"
+{ yyval = oper0(OGETLINE); }
+break;
+case 55:
+#line 184 "a2p.y"
+{ yyval = oper1(OGETLINE,yyvsp[0]); }
+break;
+case 56:
+#line 186 "a2p.y"
+{ yyval = oper3(OGETLINE,Nullop,string("<",1),yyvsp[0]);
+		    if (ops[yyvsp[0]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 57:
+#line 189 "a2p.y"
+{ yyval = oper3(OGETLINE,yyvsp[-2],string("<",1),yyvsp[0]);
+		    if (ops[yyvsp[0]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 58:
+#line 192 "a2p.y"
+{ yyval = oper3(OGETLINE,Nullop,string("|",1),yyvsp[-2]);
+		    if (ops[yyvsp[-2]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 59:
+#line 195 "a2p.y"
+{ yyval = oper3(OGETLINE,yyvsp[0],string("|",1),yyvsp[-3]);
+		    if (ops[yyvsp[-3]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 60:
+#line 198 "a2p.y"
+{ yyval = oper0(yyvsp[0]); need_entire = do_chop = TRUE; }
+break;
+case 61:
+#line 200 "a2p.y"
+{ yyval = oper1(yyvsp[-2],Nullop); need_entire = do_chop = TRUE; }
+break;
+case 62:
+#line 202 "a2p.y"
+{ yyval = oper1(yyvsp[-3],yyvsp[-1]); }
+break;
+case 63:
+#line 204 "a2p.y"
+{ yyval = oper1(yyvsp[-3],yyvsp[-1]); }
+break;
+case 64:
+#line 206 "a2p.y"
+{ yyval = oper2(OUSERFUN,yyvsp[-3],yyvsp[-1]); }
+break;
+case 65:
+#line 208 "a2p.y"
+{ yyval = oper1(OSPRINTF,yyvsp[0]); }
+break;
+case 66:
+#line 210 "a2p.y"
+{ yyval = oper3(OSUBSTR,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 67:
+#line 212 "a2p.y"
+{ yyval = oper2(OSUBSTR,yyvsp[-3],yyvsp[-1]); }
+break;
+case 68:
+#line 214 "a2p.y"
+{ yyval = oper3(OSPLIT,yyvsp[-5],aryrefarg(numary(yyvsp[-3])),yyvsp[-1]); }
+break;
+case 69:
+#line 216 "a2p.y"
+{ yyval = oper3(OSPLIT,yyvsp[-5],aryrefarg(numary(yyvsp[-3])),oper1(OREGEX,yyvsp[-1]));}
+break;
+case 70:
+#line 218 "a2p.y"
+{ yyval = oper2(OSPLIT,yyvsp[-3],aryrefarg(numary(yyvsp[-1]))); }
+break;
+case 71:
+#line 220 "a2p.y"
+{ yyval = oper2(OINDEX,yyvsp[-3],yyvsp[-1]); }
+break;
+case 72:
+#line 222 "a2p.y"
+{ yyval = oper2(OMATCH,yyvsp[-3],oper1(OREGEX,yyvsp[-1])); }
+break;
+case 73:
+#line 224 "a2p.y"
+{ yyval = oper2(OMATCH,yyvsp[-3],yyvsp[-1]); }
+break;
+case 74:
+#line 226 "a2p.y"
+{ yyval = oper2(OSUB,yyvsp[-3],yyvsp[-1]); }
+break;
+case 75:
+#line 228 "a2p.y"
+{ yyval = oper2(OSUB,oper1(OREGEX,yyvsp[-3]),yyvsp[-1]); }
+break;
+case 76:
+#line 230 "a2p.y"
+{ yyval = oper2(OGSUB,yyvsp[-3],yyvsp[-1]); }
+break;
+case 77:
+#line 232 "a2p.y"
+{ yyval = oper2(OGSUB,oper1(OREGEX,yyvsp[-3]),yyvsp[-1]); }
+break;
+case 78:
+#line 234 "a2p.y"
+{ yyval = oper3(OSUB,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 79:
+#line 236 "a2p.y"
+{ yyval = oper3(OSUB,oper1(OREGEX,yyvsp[-5]),yyvsp[-3],yyvsp[-1]); }
+break;
+case 80:
+#line 238 "a2p.y"
+{ yyval = oper3(OGSUB,yyvsp[-5],yyvsp[-3],yyvsp[-1]); }
+break;
+case 81:
+#line 240 "a2p.y"
+{ yyval = oper3(OGSUB,oper1(OREGEX,yyvsp[-5]),yyvsp[-3],yyvsp[-1]); }
+break;
+case 82:
+#line 244 "a2p.y"
+{ yyval = oper1(OVAR,yyvsp[0]); }
+break;
+case 83:
+#line 246 "a2p.y"
+{ yyval = oper2(OVAR,aryrefarg(yyvsp[-3]),yyvsp[-1]); }
+break;
+case 84:
+#line 248 "a2p.y"
+{ yyval = oper1(OFLD,yyvsp[0]); }
+break;
+case 85:
+#line 250 "a2p.y"
+{ yyval = oper1(OVFLD,yyvsp[0]); }
+break;
+case 88:
+#line 257 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 89:
+#line 261 "a2p.y"
+{ yyval = oper3(OCOMMA,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 90:
+#line 263 "a2p.y"
+{ yyval = oper3(OCOMMA,yyvsp[-3],yyvsp[-1],yyvsp[0]); }
+break;
+case 91:
+#line 265 "a2p.y"
+{ yyval = yyvsp[-1]; }
+break;
+case 92:
+#line 269 "a2p.y"
+{ yyval = oper2(OJUNK,yyvsp[-1],yyvsp[0]); }
+break;
+case 93:
+#line 271 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 94:
+#line 275 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+break;
+case 95:
+#line 277 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+break;
+case 96:
+#line 279 "a2p.y"
+{ yyval = oper0(ONEWLINE); }
+break;
+case 97:
+#line 281 "a2p.y"
+{ yyval = oper1(OCOMMENT,yyvsp[0]); }
+break;
+case 98:
+#line 285 "a2p.y"
+{ yyval = oper2(OJUNK,yyvsp[-1],yyvsp[0]); }
+break;
+case 99:
+#line 287 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 100:
+#line 291 "a2p.y"
+{ yyval = oper0(ONEWLINE); }
+break;
+case 101:
+#line 293 "a2p.y"
+{ yyval = oper1(OCOMMENT,yyvsp[0]); }
+break;
+case 102:
+#line 298 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSEMICOLON),yyvsp[0]); }
+break;
+case 103:
+#line 300 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0]); }
+break;
+case 104:
+#line 302 "a2p.y"
+{ yyval = oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0]); }
+break;
+case 105:
+#line 304 "a2p.y"
+{ yyval = oper2(OJUNK,oper1(OSCOMMENT,yyvsp[-1]),yyvsp[0]); }
+break;
+case 106:
+#line 308 "a2p.y"
+{ yyval = oper2(OSTATES,yyvsp[-1],yyvsp[0]); }
+break;
+case 107:
+#line 310 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 108:
+#line 315 "a2p.y"
+{ yyval = oper2(OJUNK,oper2(OSTATE,yyvsp[-2],yyvsp[-1]),yyvsp[0]); }
+break;
+case 109:
+#line 317 "a2p.y"
+{ yyval = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),yyvsp[0])); }
+break;
+case 110:
+#line 319 "a2p.y"
+{ yyval = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),yyvsp[0])); }
+break;
+case 113:
+#line 325 "a2p.y"
+{ yyval = Nullop; }
+break;
+case 115:
+#line 331 "a2p.y"
+{ yyval = oper3(OPRINT,yyvsp[-2],yyvsp[-1],yyvsp[0]);
+		    do_opens = TRUE;
+		    saw_ORS = saw_OFS = TRUE;
+		    if (!yyvsp[-2]) need_entire = TRUE;
+		    if (ops[yyvsp[0]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 116:
+#line 337 "a2p.y"
+{ yyval = oper1(OPRINT,yyvsp[0]);
+		    if (!yyvsp[0]) need_entire = TRUE;
+		    saw_ORS = saw_OFS = TRUE;
+		}
+break;
+case 117:
+#line 342 "a2p.y"
+{ yyval = oper3(OPRINTF,yyvsp[-2],yyvsp[-1],yyvsp[0]);
+		    do_opens = TRUE;
+		    if (!yyvsp[-2]) need_entire = TRUE;
+		    if (ops[yyvsp[0]].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+break;
+case 118:
+#line 347 "a2p.y"
+{ yyval = oper1(OPRINTF,yyvsp[0]);
+		    if (!yyvsp[0]) need_entire = TRUE;
+		}
+break;
+case 119:
+#line 351 "a2p.y"
+{ yyval = oper0(OBREAK); }
+break;
+case 120:
+#line 353 "a2p.y"
+{ yyval = oper0(ONEXT); }
+break;
+case 121:
+#line 355 "a2p.y"
+{ yyval = oper0(OEXIT); }
+break;
+case 122:
+#line 357 "a2p.y"
+{ yyval = oper1(OEXIT,yyvsp[0]); }
+break;
+case 123:
+#line 359 "a2p.y"
+{ yyval = oper0(OCONTINUE); }
+break;
+case 124:
+#line 361 "a2p.y"
+{ yyval = oper0(ORETURN); }
+break;
+case 125:
+#line 363 "a2p.y"
+{ yyval = oper1(ORETURN,yyvsp[0]); }
+break;
+case 126:
+#line 365 "a2p.y"
+{ yyval = oper2(ODELETE,aryrefarg(yyvsp[-3]),yyvsp[-1]); }
+break;
+case 127:
+#line 369 "a2p.y"
+{ yyval = oper1(OREDIR,string(">",1)); }
+break;
+case 128:
+#line 371 "a2p.y"
+{ yyval = oper1(OREDIR,string(">>",2)); }
+break;
+case 129:
+#line 373 "a2p.y"
+{ yyval = oper1(OREDIR,string("|",1)); }
+break;
+case 130:
+#line 378 "a2p.y"
+{ yyval = oper2(OIF,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 131:
+#line 380 "a2p.y"
+{ yyval = oper3(OIF,yyvsp[-6],bl(yyvsp[-3],yyvsp[-4]),bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 132:
+#line 382 "a2p.y"
+{ yyval = oper2(OWHILE,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 133:
+#line 384 "a2p.y"
+{ yyval = oper2(ODO,bl(yyvsp[-4],yyvsp[-5]),yyvsp[-1]); }
+break;
+case 134:
+#line 386 "a2p.y"
+{ yyval = oper4(OFOR,yyvsp[-7],yyvsp[-5],yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 135:
+#line 388 "a2p.y"
+{ yyval = oper4(OFOR,yyvsp[-6],string("",0),yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 136:
+#line 390 "a2p.y"
+{ yyval = oper2(OFORIN,yyvsp[-3],bl(yyvsp[0],yyvsp[-1])); }
+break;
+case 137:
+#line 392 "a2p.y"
+{ yyval = oper3(OBLOCK,oper2(OJUNK,yyvsp[-3],yyvsp[-2]),Nullop,yyvsp[0]); }
+break;
+#line 2611 "y.tab.c"
+    }
+    yyssp -= yym;
+    yystate = *yyssp;
+    yyvsp -= yym;
+    yym = yylhs[yyn];
+    if (yystate == 0 && yym == 0)
+    {
+#if YYDEBUG
+        if (yydebug)
+            printf("yydebug: after reduction, shifting from state 0 to\
+ state %d\n", YYFINAL);
+#endif
+        yystate = YYFINAL;
+        *++yyssp = YYFINAL;
+        *++yyvsp = yyval;
+        if (yychar < 0)
+        {
+            if ((yychar = yylex()) < 0) yychar = 0;
+#if YYDEBUG
+            if (yydebug)
+            {
+                yys = 0;
+                if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
+                if (!yys) yys = "illegal-symbol";
+                printf("yydebug: state %d, reading %d (%s)\n",
+                        YYFINAL, yychar, yys);
+            }
+#endif
+        }
+        if (yychar == 0) goto yyaccept;
+        goto yyloop;
+    }
+    if ((yyn = yygindex[yym]) && (yyn += yystate) >= 0 &&
+            yyn <= YYTABLESIZE && yycheck[yyn] == yystate)
+        yystate = yytable[yyn];
+    else
+        yystate = yydgoto[yym];
+#if YYDEBUG
+    if (yydebug)
+        printf("yydebug: after reduction, shifting from state %d \
+to state %d\n", *yyssp, yystate);
+#endif
+    if (yyssp >= yyss + yystacksize - 1)
+    {
+        goto yyoverflow;
+    }
+    *++yyssp = yystate;
+    *++yyvsp = yyval;
+    goto yyloop;
+yyoverflow:
+    yyerror("yacc stack overflow");
+yyabort:
+    return (1);
+yyaccept:
+    return (0);
+}
diff --git a/gnu/usr.bin/perl/x2p/a2p.h b/gnu/usr.bin/perl/x2p/a2p.h
new file mode 100644
index 00000000000..77d55ced7a2
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.h
@@ -0,0 +1,426 @@
+/* $RCSfile: a2p.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:09 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	a2p.h,v $
+ */
+
+#include "../embed.h"
+#define VOIDUSED 1
+#include "../config.h"
+
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
+/* Use all the "standard" definitions? */
+#if defined(STANDARD_C) && defined(I_STDLIB)
+#   include <stdlib.h>
+#endif /* STANDARD_C */
+
+#include <stdio.h>
+
+#ifdef I_MATH
+#include <math.h>
+#endif
+
+#ifdef I_SYS_TYPES
+#  include <sys/types.h>
+#endif
+
+
+#ifdef USE_NEXT_CTYPE 
+#include <appkit/NXCType.h>
+#else
+#include <ctype.h>
+#endif
+
+#define MEM_SIZE Size_t
+
+#if defined(I_STRING) || defined(__cplusplus)
+#   include <string.h>
+#else
+#   include <strings.h>
+#endif
+
+#ifndef HAS_BCOPY
+#   define bcopy(s1,s2,l) memcpy(s2,s1,l)
+#endif
+#ifndef HAS_BZERO
+#   define bzero(s,l) memset(s,0,l)
+#endif
+
+#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
+#define strchr index
+#define strrchr rindex
+#endif
+
+
+#ifdef I_TIME
+#   include <time.h>
+#endif
+
+#ifdef I_SYS_TIME
+#   ifdef I_SYS_TIME_KERNEL
+#	define KERNEL
+#   endif
+#   include <sys/time.h>
+#   ifdef I_SYS_TIME_KERNEL
+#	undef KERNEL
+#   endif
+#endif
+
+#ifndef MSDOS
+#  if defined(HAS_TIMES) && defined(I_SYS_TIMES)
+#    include <sys/times.h>
+#  endif
+#endif
+
+#ifdef DOSISH
+# if defined(OS2)
+#   include "../os2ish.h"
+# else
+#   include "../dosish.h"
+# endif
+#else
+# if defined(VMS)
+#   include "../vmsish.h"
+# endif
+#endif
+
+#ifndef STANDARD_C
+/* All of these are in stdlib.h or time.h for ANSI C */
+Time_t time();
+struct tm *gmtime(), *localtime();
+char *strchr(), *strrchr();
+char *strcpy(), *strcat();
+#endif /* ! STANDARD_C */
+
+#include "handy.h"
+#define Nullop 0
+
+#define OPROG		1
+#define OJUNK		2
+#define OHUNKS		3
+#define ORANGE		4
+#define OPAT		5
+#define OHUNK		6
+#define OPPAREN		7
+#define OPANDAND	8
+#define OPOROR		9
+#define OPNOT		10
+#define OCPAREN		11
+#define OCANDAND	12
+#define OCOROR		13
+#define OCNOT		14
+#define ORELOP		15
+#define ORPAREN		16
+#define OMATCHOP	17
+#define OMPAREN		18
+#define OCONCAT		19
+#define OASSIGN		20
+#define OADD		21
+#define OSUBTRACT	22
+#define OMULT		23
+#define ODIV		24
+#define OMOD		25
+#define OPOSTINCR	26
+#define OPOSTDECR	27
+#define OPREINCR	28
+#define OPREDECR	29
+#define OUMINUS		30
+#define OUPLUS		31
+#define OPAREN		32
+#define OGETLINE	33
+#define OSPRINTF	34
+#define OSUBSTR		35
+#define OSTRING		36
+#define OSPLIT		37
+#define OSNEWLINE	38
+#define OINDEX		39
+#define ONUM		40
+#define OSTR		41
+#define OVAR		42
+#define OFLD		43
+#define ONEWLINE	44
+#define OCOMMENT	45
+#define OCOMMA		46
+#define OSEMICOLON	47
+#define OSCOMMENT	48
+#define OSTATES		49
+#define OSTATE		50
+#define OPRINT		51
+#define OPRINTF		52
+#define OBREAK		53
+#define ONEXT		54
+#define OEXIT		55
+#define OCONTINUE	56
+#define OREDIR		57
+#define OIF		58
+#define OWHILE		59
+#define OFOR		60
+#define OFORIN		61
+#define OVFLD		62
+#define OBLOCK		63
+#define OREGEX		64
+#define OLENGTH		65
+#define OLOG		66
+#define OEXP		67
+#define OSQRT		68
+#define OINT		69
+#define ODO		70
+#define OPOW		71
+#define OSUB		72
+#define OGSUB		73
+#define OMATCH		74
+#define OUSERFUN	75
+#define OUSERDEF	76
+#define OCLOSE		77
+#define OATAN2		78
+#define OSIN		79
+#define OCOS		80
+#define ORAND		81
+#define OSRAND		82
+#define ODELETE		83
+#define OSYSTEM		84
+#define OCOND		85
+#define ORETURN		86
+#define ODEFINED	87
+#define OSTAR		88
+
+#ifdef DOINIT
+char *opname[] = {
+    "0",
+    "PROG",
+    "JUNK",
+    "HUNKS",
+    "RANGE",
+    "PAT",
+    "HUNK",
+    "PPAREN",
+    "PANDAND",
+    "POROR",
+    "PNOT",
+    "CPAREN",
+    "CANDAND",
+    "COROR",
+    "CNOT",
+    "RELOP",
+    "RPAREN",
+    "MATCHOP",
+    "MPAREN",
+    "CONCAT",
+    "ASSIGN",
+    "ADD",
+    "SUBTRACT",
+    "MULT",
+    "DIV",
+    "MOD",
+    "POSTINCR",
+    "POSTDECR",
+    "PREINCR",
+    "PREDECR",
+    "UMINUS",
+    "UPLUS",
+    "PAREN",
+    "GETLINE",
+    "SPRINTF",
+    "SUBSTR",
+    "STRING",
+    "SPLIT",
+    "SNEWLINE",
+    "INDEX",
+    "NUM",
+    "STR",
+    "VAR",
+    "FLD",
+    "NEWLINE",
+    "COMMENT",
+    "COMMA",
+    "SEMICOLON",
+    "SCOMMENT",
+    "STATES",
+    "STATE",
+    "PRINT",
+    "PRINTF",
+    "BREAK",
+    "NEXT",
+    "EXIT",
+    "CONTINUE",
+    "REDIR",
+    "IF",
+    "WHILE",
+    "FOR",
+    "FORIN",
+    "VFLD",
+    "BLOCK",
+    "REGEX",
+    "LENGTH",
+    "LOG",
+    "EXP",
+    "SQRT",
+    "INT",
+    "DO",
+    "POW",
+    "SUB",
+    "GSUB",
+    "MATCH",
+    "USERFUN",
+    "USERDEF",
+    "CLOSE",
+    "ATAN2",
+    "SIN",
+    "COS",
+    "RAND",
+    "SRAND",
+    "DELETE",
+    "SYSTEM",
+    "COND",
+    "RETURN",
+    "DEFINED",
+    "STAR",
+    "89"
+};
+#else
+extern char *opname[];
+#endif
+
+EXT int mop INIT(1);
+
+union u_ops {
+    int ival;
+    char *cval;
+};
+#if defined(iAPX286) || defined(M_I286) || defined(I80286) 	/* 80286 hack */
+#define OPSMAX (64000/sizeof(union u_ops))	/* approx. max segment size */
+#else
+#define OPSMAX 50000
+#endif						 	/* 80286 hack */
+EXT union u_ops ops[OPSMAX];
+
+typedef struct string STR;
+typedef struct htbl HASH;
+
+#include "str.h"
+#include "hash.h"
+
+
+/* A string is TRUE if not "" or "0". */
+#define True(val) (tmps = (val), (*tmps && !(*tmps == '0' && !tmps[1])))
+EXT char *Yes INIT("1");
+EXT char *No INIT("");
+
+#define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 )))
+
+#define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),buf) : "" )))
+#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
+#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str)))
+EXT STR *Str;
+
+#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
+
+/* Prototypes for things in a2p.c */
+int aryrefarg _(( int arg ));
+int bl _(( int arg, int maybe ));
+void dump _(( int branch ));
+int fixfargs _(( int name, int arg, int prevargs ));
+int fixrargs _(( char *name, int arg, int prevargs ));
+void fixup _(( STR *str ));
+int numary _(( int arg ));
+int oper0 _(( int type ));
+int oper1 _(( int type, int arg1 ));
+int oper2 _(( int type, int arg1, int arg2 ));
+int oper3 _(( int type, int arg1, int arg2, int arg3 ));
+int oper4 _(( int type, int arg1, int arg2, int arg3, int arg4 ));
+int oper5 _(( int type, int arg1, int arg2, int arg3, int arg4, int arg5 ));
+void putlines _(( STR *str ));
+void putone _(( void ));
+int rememberargs _(( int arg ));
+char * scannum _(( char *s ));
+char * scanpat _(( char *s ));
+int string _(( char *ptr, int len ));
+void yyerror _(( char *s ));
+int yylex _(( void ));
+
+EXT int line INIT(0);
+
+EXT FILE *rsfp;
+EXT char buf[2048];
+EXT char *bufptr INIT(buf);
+
+EXT STR *linestr INIT(Nullstr);
+
+EXT char tokenbuf[2048];
+EXT int expectterm INIT(TRUE);
+
+#ifdef DEBUGGING
+EXT int debug INIT(0);
+EXT int dlevel INIT(0);
+#define YYDEBUG 1
+extern int yydebug;
+#endif
+
+EXT STR *freestrroot INIT(Nullstr);
+
+EXT STR str_no;
+EXT STR str_yes;
+
+EXT bool do_split INIT(FALSE);
+EXT bool split_to_array INIT(FALSE);
+EXT bool set_array_base INIT(FALSE);
+EXT bool saw_RS INIT(FALSE);
+EXT bool saw_OFS INIT(FALSE);
+EXT bool saw_ORS INIT(FALSE);
+EXT bool saw_line_op INIT(FALSE);
+EXT bool in_begin INIT(TRUE);
+EXT bool do_opens INIT(FALSE);
+EXT bool do_fancy_opens INIT(FALSE);
+EXT bool lval_field INIT(FALSE);
+EXT bool do_chop INIT(FALSE);
+EXT bool need_entire INIT(FALSE);
+EXT bool absmaxfld INIT(FALSE);
+EXT bool saw_altinput INIT(FALSE);
+
+EXT bool nomemok INIT(FALSE);
+
+EXT char const_FS INIT(0);
+EXT char *namelist INIT(Nullch);
+EXT char fswitch INIT(0);
+
+EXT int saw_FS INIT(0);
+EXT int maxfld INIT(0);
+EXT int arymax INIT(0);
+EXT char *nameary[100];
+
+EXT STR *opens;
+
+EXT HASH *symtab;
+EXT HASH *curarghash;
+
+#define P_MIN		0
+#define P_LISTOP	5
+#define P_COMMA		10
+#define P_ASSIGN	15
+#define P_COND		20
+#define P_DOTDOT	25
+#define P_OROR		30
+#define P_ANDAND	35
+#define P_OR		40
+#define P_AND		45
+#define P_EQ		50
+#define P_REL		55
+#define P_UNI		60
+#define P_FILETEST	65
+#define P_SHIFT		70
+#define P_ADD		75
+#define P_MUL		80
+#define P_MATCH		85
+#define P_UNARY		90
+#define P_POW		95
+#define P_AUTO		100
+#define P_MAX		999
+
+EXT int an;
diff --git a/gnu/usr.bin/perl/x2p/a2p.man b/gnu/usr.bin/perl/x2p/a2p.man
new file mode 100644
index 00000000000..d885ff0157b
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.man
@@ -0,0 +1,187 @@
+.rn '' }`
+''' $RCSfile: a2p.man,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:34 $
+''' 
+''' $Log: a2p.man,v $
+''' Revision 1.1.1.1  1996/08/19 10:13:34  downsj
+''' Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+''' config.sh.OpenBSD are the only local changes.
+'''
+.de Sh
+.br
+.ne 5
+.PP
+\fB\\$1\fR
+.PP
+..
+.de Sp
+.if t .sp .5v
+.if n .sp
+..
+.de Ip
+.br
+.ie \\n.$>=3 .ne \\$3
+.el .ne 3
+.IP "\\$1" \\$2
+..
+'''
+'''     Set up \*(-- to give an unbreakable dash;
+'''     string Tr holds user defined translation string.
+'''     Bell System Logo is used as a dummy character.
+'''
+.tr \(*W-|\(bv\*(Tr
+.ie n \{\
+.ds -- \(*W-
+.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
+.ds L" ""
+.ds R" ""
+.ds L' '
+.ds R' '
+'br\}
+.el\{\
+.ds -- \(em\|
+.tr \*(Tr
+.ds L" ``
+.ds R" ''
+.ds L' `
+.ds R' '
+'br\}
+.TH A2P 1 LOCAL
+.SH NAME
+a2p - Awk to Perl translator
+.SH SYNOPSIS
+.B a2p [options] filename
+.SH DESCRIPTION
+.I A2p
+takes an awk script specified on the command line (or from standard input)
+and produces a comparable
+.I perl
+script on the standard output.
+.Sh "Options"
+Options include:
+.TP 5
+.B \-D<number>
+sets debugging flags.
+.TP 5
+.B \-F<character>
+tells a2p that this awk script is always invoked with this -F switch.
+.TP 5
+.B \-n<fieldlist>
+specifies the names of the input fields if input does not have to be split into
+an array.
+If you were translating an awk script that processes the password file, you
+might say:
+.sp
+	a2p -7 -nlogin.password.uid.gid.gcos.shell.home
+.sp
+Any delimiter can be used to separate the field names.
+.TP 5
+.B \-<number>
+causes a2p to assume that input will always have that many fields.
+.Sh "Considerations"
+A2p cannot do as good a job translating as a human would, but it usually
+does pretty well.
+There are some areas where you may want to examine the perl script produced
+and tweak it some.
+Here are some of them, in no particular order.
+.PP
+There is an awk idiom of putting int() around a string expression to force
+numeric interpretation, even though the argument is always integer anyway.
+This is generally unneeded in perl, but a2p can't tell if the argument
+is always going to be integer, so it leaves it in.
+You may wish to remove it.
+.PP
+Perl differentiates numeric comparison from string comparison.
+Awk has one operator for both that decides at run time which comparison
+to do.
+A2p does not try to do a complete job of awk emulation at this point.
+Instead it guesses which one you want.
+It's almost always right, but it can be spoofed.
+All such guesses are marked with the comment \*(L"#???\*(R".
+You should go through and check them.
+You might want to run at least once with the \-w switch to perl, which
+will warn you if you use == where you should have used eq.
+.PP
+Perl does not attempt to emulate the behavior of awk in which nonexistent
+array elements spring into existence simply by being referenced.
+If somehow you are relying on this mechanism to create null entries for
+a subsequent for...in, they won't be there in perl.
+.PP
+If a2p makes a split line that assigns to a list of variables that looks
+like (Fld1, Fld2, Fld3...) you may want
+to rerun a2p using the \-n option mentioned above.
+This will let you name the fields throughout the script.
+If it splits to an array instead, the script is probably referring to the number
+of fields somewhere.
+.PP
+The exit statement in awk doesn't necessarily exit; it goes to the END
+block if there is one.
+Awk scripts that do contortions within the END block to bypass the block under
+such circumstances can be simplified by removing the conditional
+in the END block and just exiting directly from the perl script.
+.PP
+Perl has two kinds of array, numerically-indexed and associative.
+Awk arrays are usually translated to associative arrays, but if you happen
+to know that the index is always going to be numeric you could change
+the {...} to [...].
+Iteration over an associative array is done using the keys() function, but
+iteration over a numeric array is NOT.
+You might need to modify any loop that is iterating over the array in question.
+.PP
+Awk starts by assuming OFMT has the value %.6g.
+Perl starts by assuming its equivalent, $#, to have the value %.20g.
+You'll want to set $# explicitly if you use the default value of OFMT.
+.PP
+Near the top of the line loop will be the split operation that is implicit in
+the awk script.
+There are times when you can move this down past some conditionals that
+test the entire record so that the split is not done as often.
+.PP
+For aesthetic reasons you may wish to change the array base $[ from 1 back
+to perl's default of 0, but remember to change all array subscripts AND
+all substr() and index() operations to match.
+.PP
+Cute comments that say "# Here is a workaround because awk is dumb" are passed
+through unmodified.
+.PP
+Awk scripts are often embedded in a shell script that pipes stuff into and
+out of awk.
+Often the shell script wrapper can be incorporated into the perl script, since
+perl can start up pipes into and out of itself, and can do other things that
+awk can't do by itself.
+.PP
+Scripts that refer to the special variables RSTART and RLENGTH can often
+be simplified by referring to the variables $`, $& and $', as long as they
+are within the scope of the pattern match that sets them.
+.PP
+The produced perl script may have subroutines defined to deal with awk's
+semantics regarding getline and print.
+Since a2p usually picks correctness over efficiency.
+it is almost always possible to rewrite such code to be more efficient by
+discarding the semantic sugar.
+.PP
+For efficiency, you may wish to remove the keyword from any return statement
+that is the last statement executed in a subroutine.
+A2p catches the most common case, but doesn't analyze embedded blocks for
+subtler cases.
+.PP
+ARGV[0] translates to $ARGV0, but ARGV[n] translates to $ARGV[$n].
+A loop that tries to iterate over ARGV[0] won't find it.
+.SH ENVIRONMENT
+A2p uses no environment variables.
+.SH AUTHOR
+Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
+.SH FILES
+.SH SEE ALSO
+perl	The perl compiler/interpreter
+.br
+s2p	sed to perl translator
+.SH DIAGNOSTICS
+.SH BUGS
+It would be possible to emulate awk's behavior in selecting string versus
+numeric operations at run time by inspection of the operands, but it would
+be gross and inefficient.
+Besides, a2p almost always guesses right.
+.PP
+Storage for the awk syntax tree is currently static, and can run out.
+.rn }` ''
diff --git a/gnu/usr.bin/perl/x2p/a2p.y b/gnu/usr.bin/perl/x2p/a2p.y
new file mode 100644
index 00000000000..961e2f280f0
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2p.y
@@ -0,0 +1,396 @@
+%{
+/* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	a2p.y,v $
+ */
+
+#include "INTERN.h"
+#include "a2p.h"
+
+int root;
+int begins = Nullop;
+int ends = Nullop;
+
+%}
+%token BEGIN END
+%token REGEX
+%token SEMINEW NEWLINE COMMENT
+%token FUN1 FUNN GRGR
+%token PRINT PRINTF SPRINTF SPLIT
+%token IF ELSE WHILE FOR IN
+%token EXIT NEXT BREAK CONTINUE RET
+%token GETLINE DO SUB GSUB MATCH
+%token FUNCTION USERFUN DELETE
+
+%right ASGNOP
+%right '?' ':'
+%left OROR
+%left ANDAND
+%left IN
+%left NUMBER VAR SUBSTR INDEX
+%left MATCHOP
+%left RELOP '<' '>'
+%left OR
+%left STRING
+%left '+' '-'
+%left '*' '/' '%'
+%right UMINUS
+%left NOT
+%right '^'
+%left INCR DECR
+%left FIELD VFIELD
+
+%%
+
+program	: junk hunks
+		{ root = oper4(OPROG,$1,begins,$2,ends); }
+	;
+
+begin	: BEGIN '{' maybe states '}' junk
+		{ begins = oper4(OJUNK,begins,$3,$4,$6); in_begin = FALSE;
+		    $$ = Nullop; }
+	;
+
+end	: END '{' maybe states '}'
+		{ ends = oper3(OJUNK,ends,$3,$4); $$ = Nullop; }
+	| end NEWLINE
+		{ $$ = $1; }
+	;
+
+hunks	: hunks hunk junk
+		{ $$ = oper3(OHUNKS,$1,$2,$3); }
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+hunk	: patpat
+		{ $$ = oper1(OHUNK,$1); need_entire = TRUE; }
+	| patpat '{' maybe states '}'
+		{ $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); }
+	| FUNCTION USERFUN '(' arg_list ')' maybe '{' maybe states '}'
+		{ fixfargs($2,$4,0); $$ = oper5(OUSERDEF,$2,$4,$6,$8,$9); }
+	| '{' maybe states '}'
+		{ $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); }
+	| begin
+	| end
+	;
+
+arg_list: expr_list
+		{ $$ = rememberargs($$); }
+	;
+
+patpat	: cond
+		{ $$ = oper1(OPAT,$1); }
+	| cond ',' cond
+		{ $$ = oper2(ORANGE,$1,$3); }
+	;
+
+cond	: expr
+	| match
+	| rel
+	| compound_cond
+	| cond '?' expr ':' expr
+		{ $$ = oper3(OCOND,$1,$3,$5); }
+	;
+
+compound_cond
+	: '(' compound_cond ')'
+		{ $$ = oper1(OCPAREN,$2); }
+	| cond ANDAND maybe cond
+		{ $$ = oper3(OCANDAND,$1,$3,$4); }
+	| cond OROR maybe cond
+		{ $$ = oper3(OCOROR,$1,$3,$4); }
+	| NOT cond
+		{ $$ = oper1(OCNOT,$2); }
+	;
+
+rel	: expr RELOP expr
+		{ $$ = oper3(ORELOP,$2,$1,$3); }
+	| expr '>' expr
+		{ $$ = oper3(ORELOP,string(">",1),$1,$3); }
+	| expr '<' expr
+		{ $$ = oper3(ORELOP,string("<",1),$1,$3); }
+	| '(' rel ')'
+		{ $$ = oper1(ORPAREN,$2); }
+	;
+
+match	: expr MATCHOP expr
+		{ $$ = oper3(OMATCHOP,$2,$1,$3); }
+	| expr MATCHOP REGEX
+		{ $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); }
+	| REGEX		%prec MATCHOP
+		{ $$ = oper1(OREGEX,$1); }
+	| '(' match ')'
+		{ $$ = oper1(OMPAREN,$2); }
+	;
+
+expr	: term
+		{ $$ = $1; }
+	| expr term
+		{ $$ = oper2(OCONCAT,$1,$2); }
+	| variable ASGNOP cond
+		{ $$ = oper3(OASSIGN,$2,$1,$3);
+			if ((ops[$1].ival & 255) == OFLD)
+			    lval_field = TRUE;
+			if ((ops[$1].ival & 255) == OVFLD)
+			    lval_field = TRUE;
+		}
+	;
+
+term	: variable
+		{ $$ = $1; }
+	| NUMBER
+		{ $$ = oper1(ONUM,$1); }
+	| STRING
+		{ $$ = oper1(OSTR,$1); }
+	| term '+' term
+		{ $$ = oper2(OADD,$1,$3); }
+	| term '-' term
+		{ $$ = oper2(OSUBTRACT,$1,$3); }
+	| term '*' term
+		{ $$ = oper2(OMULT,$1,$3); }
+	| term '/' term
+		{ $$ = oper2(ODIV,$1,$3); }
+	| term '%' term
+		{ $$ = oper2(OMOD,$1,$3); }
+	| term '^' term
+		{ $$ = oper2(OPOW,$1,$3); }
+	| term IN VAR
+		{ $$ = oper2(ODEFINED,aryrefarg($3),$1); }
+	| cond '?' expr ':' expr
+		{ $$ = oper3(OCOND,$1,$3,$5); }
+	| variable INCR
+		{ $$ = oper1(OPOSTINCR,$1); }
+	| variable DECR
+		{ $$ = oper1(OPOSTDECR,$1); }
+	| INCR variable
+		{ $$ = oper1(OPREINCR,$2); }
+	| DECR variable
+		{ $$ = oper1(OPREDECR,$2); }
+	| '-' term %prec UMINUS
+		{ $$ = oper1(OUMINUS,$2); }
+	| '+' term %prec UMINUS
+		{ $$ = oper1(OUPLUS,$2); }
+	| '(' cond ')'
+		{ $$ = oper1(OPAREN,$2); }
+	| GETLINE
+		{ $$ = oper0(OGETLINE); }
+	| GETLINE variable
+		{ $$ = oper1(OGETLINE,$2); }
+	| GETLINE '<' expr
+		{ $$ = oper3(OGETLINE,Nullop,string("<",1),$3);
+		    if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| GETLINE variable '<' expr
+		{ $$ = oper3(OGETLINE,$2,string("<",1),$4);
+		    if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| term 'p' GETLINE
+		{ $$ = oper3(OGETLINE,Nullop,string("|",1),$1);
+		    if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| term 'p' GETLINE variable
+		{ $$ = oper3(OGETLINE,$4,string("|",1),$1);
+		    if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| FUN1
+		{ $$ = oper0($1); need_entire = do_chop = TRUE; }
+	| FUN1 '(' ')'
+		{ $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; }
+	| FUN1 '(' expr ')'
+		{ $$ = oper1($1,$3); }
+	| FUNN '(' expr_list ')'
+		{ $$ = oper1($1,$3); }
+	| USERFUN '(' expr_list ')'
+		{ $$ = oper2(OUSERFUN,$1,$3); }
+	| SPRINTF expr_list
+		{ $$ = oper1(OSPRINTF,$2); }
+	| SUBSTR '(' expr ',' expr ',' expr ')'
+		{ $$ = oper3(OSUBSTR,$3,$5,$7); }
+	| SUBSTR '(' expr ',' expr ')'
+		{ $$ = oper2(OSUBSTR,$3,$5); }
+	| SPLIT '(' expr ',' VAR ',' expr ')'
+		{ $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
+	| SPLIT '(' expr ',' VAR ',' REGEX ')'
+		{ $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));}
+	| SPLIT '(' expr ',' VAR ')'
+		{ $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
+	| INDEX '(' expr ',' expr ')'
+		{ $$ = oper2(OINDEX,$3,$5); }
+	| MATCH '(' expr ',' REGEX ')'
+		{ $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); }
+	| MATCH '(' expr ',' expr ')'
+		{ $$ = oper2(OMATCH,$3,$5); }
+	| SUB '(' expr ',' expr ')'
+		{ $$ = oper2(OSUB,$3,$5); }
+	| SUB '(' REGEX ',' expr ')'
+		{ $$ = oper2(OSUB,oper1(OREGEX,$3),$5); }
+	| GSUB '(' expr ',' expr ')'
+		{ $$ = oper2(OGSUB,$3,$5); }
+	| GSUB '(' REGEX ',' expr ')'
+		{ $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); }
+	| SUB '(' expr ',' expr ',' expr ')'
+		{ $$ = oper3(OSUB,$3,$5,$7); }
+	| SUB '(' REGEX ',' expr ',' expr ')'
+		{ $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); }
+	| GSUB '(' expr ',' expr ',' expr ')'
+		{ $$ = oper3(OGSUB,$3,$5,$7); }
+	| GSUB '(' REGEX ',' expr ',' expr ')'
+		{ $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); }
+	;
+
+variable: VAR
+		{ $$ = oper1(OVAR,$1); }
+	| VAR '[' expr_list ']'
+		{ $$ = oper2(OVAR,aryrefarg($1),$3); }
+	| FIELD
+		{ $$ = oper1(OFLD,$1); }
+	| VFIELD term
+		{ $$ = oper1(OVFLD,$2); }
+	;
+
+expr_list
+	: expr
+	| clist
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+clist	: expr ',' maybe expr
+		{ $$ = oper3(OCOMMA,$1,$3,$4); }
+	| clist ',' maybe expr
+		{ $$ = oper3(OCOMMA,$1,$3,$4); }
+	| '(' clist ')'		/* these parens are invisible */
+		{ $$ = $2; }
+	;
+
+junk	: junk hunksep
+		{ $$ = oper2(OJUNK,$1,$2); }
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+hunksep : ';'
+		{ $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+	| SEMINEW
+		{ $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
+	| NEWLINE
+		{ $$ = oper0(ONEWLINE); }
+	| COMMENT
+		{ $$ = oper1(OCOMMENT,$1); }
+	;
+
+maybe	: maybe nlstuff
+		{ $$ = oper2(OJUNK,$1,$2); }
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+nlstuff : NEWLINE
+		{ $$ = oper0(ONEWLINE); }
+	| COMMENT
+		{ $$ = oper1(OCOMMENT,$1); }
+	;
+
+separator
+	: ';' maybe
+		{ $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); }
+	| SEMINEW maybe
+		{ $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
+	| NEWLINE maybe
+		{ $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
+	| COMMENT maybe
+		{ $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); }
+	;
+
+states	: states statement
+		{ $$ = oper2(OSTATES,$1,$2); }
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+statement
+	: simple separator maybe
+		{ $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); }
+	| ';' maybe
+		{ $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); }
+	| SEMINEW maybe
+		{ $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); }
+	| compound
+	;
+
+simpnull: simple
+	| /* NULL */
+		{ $$ = Nullop; }
+	;
+
+simple
+	: expr
+	| PRINT expr_list redir expr
+		{ $$ = oper3(OPRINT,$2,$3,$4);
+		    do_opens = TRUE;
+		    saw_ORS = saw_OFS = TRUE;
+		    if (!$2) need_entire = TRUE;
+		    if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| PRINT expr_list
+		{ $$ = oper1(OPRINT,$2);
+		    if (!$2) need_entire = TRUE;
+		    saw_ORS = saw_OFS = TRUE;
+		}
+	| PRINTF expr_list redir expr
+		{ $$ = oper3(OPRINTF,$2,$3,$4);
+		    do_opens = TRUE;
+		    if (!$2) need_entire = TRUE;
+		    if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
+	| PRINTF expr_list
+		{ $$ = oper1(OPRINTF,$2);
+		    if (!$2) need_entire = TRUE;
+		}
+	| BREAK
+		{ $$ = oper0(OBREAK); }
+	| NEXT
+		{ $$ = oper0(ONEXT); }
+	| EXIT
+		{ $$ = oper0(OEXIT); }
+	| EXIT expr
+		{ $$ = oper1(OEXIT,$2); }
+	| CONTINUE
+		{ $$ = oper0(OCONTINUE); }
+	| RET
+		{ $$ = oper0(ORETURN); }
+	| RET expr
+		{ $$ = oper1(ORETURN,$2); }
+	| DELETE VAR '[' expr_list ']'
+		{ $$ = oper2(ODELETE,aryrefarg($2),$4); }
+	;
+
+redir	: '>'	%prec FIELD
+		{ $$ = oper1(OREDIR,string(">",1)); }
+	| GRGR
+		{ $$ = oper1(OREDIR,string(">>",2)); }
+	| '|'
+		{ $$ = oper1(OREDIR,string("|",1)); }
+	;
+
+compound
+	: IF '(' cond ')' maybe statement
+		{ $$ = oper2(OIF,$3,bl($6,$5)); }
+	| IF '(' cond ')' maybe statement ELSE maybe statement
+		{ $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); }
+	| WHILE '(' cond ')' maybe statement
+		{ $$ = oper2(OWHILE,$3,bl($6,$5)); }
+	| DO maybe statement WHILE '(' cond ')'
+		{ $$ = oper2(ODO,bl($3,$2),$6); }
+	| FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement
+		{ $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); }
+	| FOR '(' simpnull ';'  ';' simpnull ')' maybe statement
+		{ $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); }
+	| FOR '(' expr ')' maybe statement
+		{ $$ = oper2(OFORIN,$3,bl($6,$5)); }
+	| '{' maybe states '}' maybe
+		{ $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); }
+	;
+
+%%
+#include "a2py.c"
diff --git a/gnu/usr.bin/perl/x2p/a2py.c b/gnu/usr.bin/perl/x2p/a2py.c
new file mode 100644
index 00000000000..454e2dc8601
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/a2py.c
@@ -0,0 +1,1308 @@
+/* $RCSfile: a2py.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:14 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	a2py.c,v $
+ */
+
+#ifdef OS2
+#include "../patchlevel.h"
+#endif
+#include "util.h"
+
+char *filename;
+char *myname;
+
+int checkers = 0;
+
+int oper0();
+int oper1();
+int oper2();
+int oper3();
+int oper4();
+int oper5();
+STR *walk();
+
+#ifdef OS2
+usage()
+{
+    printf("\nThis is the AWK to PERL translator, version 5.0, patchlevel %d\n", PATCHLEVEL);
+    printf("\nUsage: %s [-D<number>] [-F<char>] [-n<fieldlist>] [-<number>] filename\n", myname);
+    printf("\n  -D<number>      sets debugging flags."
+           "\n  -F<character>   the awk script to translate is always invoked with"
+           "\n                  this -F switch."
+           "\n  -n<fieldlist>   specifies the names of the input fields if input does"
+           "\n                  not have to be split into an array."
+           "\n  -<number>       causes a2p to assume that input will always have that"
+           "\n                  many fields.\n");
+    exit(1);
+}
+#endif
+main(argc,argv,env)
+register int argc;
+register char **argv;
+register char **env;
+{
+    register STR *str;
+    int i;
+    STR *tmpstr;
+
+    myname = argv[0];
+    linestr = str_new(80);
+    str = str_new(0);		/* first used for -I flags */
+    for (argc--,argv++; argc; argc--,argv++) {
+	if (argv[0][0] != '-' || !argv[0][1])
+	    break;
+      reswitch:
+	switch (argv[0][1]) {
+#ifdef DEBUGGING
+	case 'D':
+	    debug = atoi(argv[0]+2);
+#ifdef YYDEBUG
+	    yydebug = (debug & 1);
+#endif
+	    break;
+#endif
+	case '0': case '1': case '2': case '3': case '4':
+	case '5': case '6': case '7': case '8': case '9':
+	    maxfld = atoi(argv[0]+1);
+	    absmaxfld = TRUE;
+	    break;
+	case 'F':
+	    fswitch = argv[0][2];
+	    break;
+	case 'n':
+	    namelist = savestr(argv[0]+2);
+	    break;
+	case '-':
+	    argc--,argv++;
+	    goto switch_end;
+	case 0:
+	    break;
+	default:
+	    fatal("Unrecognized switch: %s\n",argv[0]);
+#ifdef OS2
+            usage();
+#endif
+	}
+    }
+  switch_end:
+
+    /* open script */
+
+    if (argv[0] == Nullch) {
+#ifdef OS2
+	if ( isatty(fileno(stdin)) )
+	    usage();
+#endif
+        argv[0] = "-";
+    }
+    filename = savestr(argv[0]);
+
+    filename = savestr(argv[0]);
+    if (strEQ(filename,"-"))
+	argv[0] = "";
+    if (!*argv[0])
+	rsfp = stdin;
+    else
+	rsfp = fopen(argv[0],"r");
+    if (rsfp == Nullfp)
+	fatal("Awk script \"%s\" doesn't seem to exist.\n",filename);
+
+    /* init tokener */
+
+    bufptr = str_get(linestr);
+    symtab = hnew();
+    curarghash = hnew();
+
+    /* now parse the report spec */
+
+    if (yyparse())
+	fatal("Translation aborted due to syntax errors.\n");
+
+#ifdef DEBUGGING
+    if (debug & 2) {
+	int type, len;
+
+	for (i=1; i<mop;) {
+	    type = ops[i].ival;
+	    len = type >> 8;
+	    type &= 255;
+	    printf("%d\t%d\t%d\t%-10s",i++,type,len,opname[type]);
+	    if (type == OSTRING)
+		printf("\t\"%s\"\n",ops[i].cval),i++;
+	    else {
+		while (len--) {
+		    printf("\t%d",ops[i].ival),i++;
+		}
+		putchar('\n');
+	    }
+	}
+    }
+    if (debug & 8)
+	dump(root);
+#endif
+
+    /* first pass to look for numeric variables */
+
+    prewalk(0,0,root,&i);
+
+    /* second pass to produce new program */
+
+    tmpstr = walk(0,0,root,&i,P_MIN);
+    str = str_make(STARTPERL);
+    str_cat(str, "\neval 'exec perl -S $0 \"$@\"'\n\
+    if $running_under_some_shell;\n\
+			# this emulates #! processing on NIH machines.\n\
+			# (remove #! line above if indigestible)\n\n");
+    str_cat(str,
+      "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;\n");
+    str_cat(str,
+      "			# process any FOO=bar switches\n\n");
+    if (do_opens && opens) {
+	str_scat(str,opens);
+	str_free(opens);
+	str_cat(str,"\n");
+    }
+    str_scat(str,tmpstr);
+    str_free(tmpstr);
+#ifdef DEBUGGING
+    if (!(debug & 16))
+#endif
+    fixup(str);
+    putlines(str);
+    if (checkers) {
+	fprintf(stderr,
+	  "Please check my work on the %d line%s I've marked with \"#???\".\n",
+		checkers, checkers == 1 ? "" : "s" );
+	fprintf(stderr,
+	  "The operation I've selected may be wrong for the operand types.\n");
+    }
+    exit(0);
+}
+
+#define RETURN(retval) return (bufptr = s,retval)
+#define XTERM(retval) return (expectterm = TRUE,bufptr = s,retval)
+#define XOP(retval) return (expectterm = FALSE,bufptr = s,retval)
+#define ID(x) return (yylval=string(x,0),expectterm = FALSE,bufptr = s,idtype)
+
+int idtype;
+
+int
+yylex()
+{
+    register char *s = bufptr;
+    register char *d;
+    register int tmp;
+
+  retry:
+#ifdef YYDEBUG
+    if (yydebug)
+	if (strchr(s,'\n'))
+	    fprintf(stderr,"Tokener at %s",s);
+	else
+	    fprintf(stderr,"Tokener at %s\n",s);
+#endif
+    switch (*s) {
+    default:
+	fprintf(stderr,
+	    "Unrecognized character %c in file %s line %d--ignoring.\n",
+	     *s++,filename,line);
+	goto retry;
+    case '\\':
+	s++;
+	if (*s && *s != '\n') {
+	    yyerror("Ignoring spurious backslash");
+	    goto retry;
+	}
+	/*FALLSTHROUGH*/
+    case 0:
+	s = str_get(linestr);
+	*s = '\0';
+	if (!rsfp)
+	    RETURN(0);
+	line++;
+	if ((s = str_gets(linestr, rsfp)) == Nullch) {
+	    if (rsfp != stdin)
+		fclose(rsfp);
+	    rsfp = Nullfp;
+	    s = str_get(linestr);
+	    RETURN(0);
+	}
+	goto retry;
+    case ' ': case '\t':
+	s++;
+	goto retry;
+    case '\n':
+	*s = '\0';
+	XTERM(NEWLINE);
+    case '#':
+	yylval = string(s,0);
+	*s = '\0';
+	XTERM(COMMENT);
+    case ';':
+	tmp = *s++;
+	if (*s == '\n') {
+	    s++;
+	    XTERM(SEMINEW);
+	}
+	XTERM(tmp);
+    case '(':
+	tmp = *s++;
+	XTERM(tmp);
+    case '{':
+    case '[':
+    case ')':
+    case ']':
+    case '?':
+    case ':':
+	tmp = *s++;
+	XOP(tmp);
+    case 127:
+	s++;
+	XTERM('}');
+    case '}':
+	for (d = s + 1; isspace(*d); d++) ;
+	if (!*d)
+	    s = d - 1;
+	*s = 127;
+	XTERM(';');
+    case ',':
+	tmp = *s++;
+	XTERM(tmp);
+    case '~':
+	s++;
+	yylval = string("~",1);
+	XTERM(MATCHOP);
+    case '+':
+    case '-':
+	if (s[1] == *s) {
+	    s++;
+	    if (*s++ == '+')
+		XTERM(INCR);
+	    else
+		XTERM(DECR);
+	}
+	/* FALL THROUGH */
+    case '*':
+    case '%':
+    case '^':
+	tmp = *s++;
+	if (*s == '=') {
+	    if (tmp == '^')
+		yylval = string("**=",3);
+	    else
+		yylval = string(s-1,2);
+	    s++;
+	    XTERM(ASGNOP);
+	}
+	XTERM(tmp);
+    case '&':
+	s++;
+	tmp = *s++;
+	if (tmp == '&')
+	    XTERM(ANDAND);
+	s--;
+	XTERM('&');
+    case '|':
+	s++;
+	tmp = *s++;
+	if (tmp == '|')
+	    XTERM(OROR);
+	s--;
+	while (*s == ' ' || *s == '\t')
+	    s++;
+	if (strnEQ(s,"getline",7))
+	    XTERM('p');
+	else
+	    XTERM('|');
+    case '=':
+	s++;
+	tmp = *s++;
+	if (tmp == '=') {
+	    yylval = string("==",2);
+	    XTERM(RELOP);
+	}
+	s--;
+	yylval = string("=",1);
+	XTERM(ASGNOP);
+    case '!':
+	s++;
+	tmp = *s++;
+	if (tmp == '=') {
+	    yylval = string("!=",2);
+	    XTERM(RELOP);
+	}
+	if (tmp == '~') {
+	    yylval = string("!~",2);
+	    XTERM(MATCHOP);
+	}
+	s--;
+	XTERM(NOT);
+    case '<':
+	s++;
+	tmp = *s++;
+	if (tmp == '=') {
+	    yylval = string("<=",2);
+	    XTERM(RELOP);
+	}
+	s--;
+	XTERM('<');
+    case '>':
+	s++;
+	tmp = *s++;
+	if (tmp == '>') {
+	    yylval = string(">>",2);
+	    XTERM(GRGR);
+	}
+	if (tmp == '=') {
+	    yylval = string(">=",2);
+	    XTERM(RELOP);
+	}
+	s--;
+	XTERM('>');
+
+#define SNARFWORD \
+	d = tokenbuf; \
+	while (isalpha(*s) || isdigit(*s) || *s == '_') \
+	    *d++ = *s++; \
+	*d = '\0'; \
+	d = tokenbuf; \
+	if (*s == '(') \
+	    idtype = USERFUN; \
+	else \
+	    idtype = VAR;
+
+    case '$':
+	s++;
+	if (*s == '0') {
+	    s++;
+	    do_chop = TRUE;
+	    need_entire = TRUE;
+	    idtype = VAR;
+	    ID("0");
+	}
+	do_split = TRUE;
+	if (isdigit(*s)) {
+	    for (d = s; isdigit(*s); s++) ;
+	    yylval = string(d,s-d);
+	    tmp = atoi(d);
+	    if (tmp > maxfld)
+		maxfld = tmp;
+	    XOP(FIELD);
+	}
+	split_to_array = set_array_base = TRUE;
+	XOP(VFIELD);
+
+    case '/':			/* may either be division or pattern */
+	if (expectterm) {
+	    s = scanpat(s);
+	    XTERM(REGEX);
+	}
+	tmp = *s++;
+	if (*s == '=') {
+	    yylval = string("/=",2);
+	    s++;
+	    XTERM(ASGNOP);
+	}
+	XTERM(tmp);
+
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9': case '.':
+	s = scannum(s);
+	XOP(NUMBER);
+    case '"':
+	s++;
+	s = cpy2(tokenbuf,s,s[-1]);
+	if (!*s)
+	    fatal("String not terminated:\n%s",str_get(linestr));
+	s++;
+	yylval = string(tokenbuf,0);
+	XOP(STRING);
+
+    case 'a': case 'A':
+	SNARFWORD;
+	if (strEQ(d,"ARGC"))
+	    set_array_base = TRUE;
+	if (strEQ(d,"ARGV")) {
+	    yylval=numary(string("ARGV",0));
+	    XOP(VAR);
+	}
+	if (strEQ(d,"atan2")) {
+	    yylval = OATAN2;
+	    XTERM(FUNN);
+	}
+	ID(d);
+    case 'b': case 'B':
+	SNARFWORD;
+	if (strEQ(d,"break"))
+	    XTERM(BREAK);
+	if (strEQ(d,"BEGIN"))
+	    XTERM(BEGIN);
+	ID(d);
+    case 'c': case 'C':
+	SNARFWORD;
+	if (strEQ(d,"continue"))
+	    XTERM(CONTINUE);
+	if (strEQ(d,"cos")) {
+	    yylval = OCOS;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"close")) {
+	    do_fancy_opens = 1;
+	    yylval = OCLOSE;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"chdir"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"crypt"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"chop"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"chmod"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"chown"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'd': case 'D':
+	SNARFWORD;
+	if (strEQ(d,"do"))
+	    XTERM(DO);
+	if (strEQ(d,"delete"))
+	    XTERM(DELETE);
+	if (strEQ(d,"die"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'e': case 'E':
+	SNARFWORD;
+	if (strEQ(d,"END"))
+	    XTERM(END);
+	if (strEQ(d,"else"))
+	    XTERM(ELSE);
+	if (strEQ(d,"exit")) {
+	    saw_line_op = TRUE;
+	    XTERM(EXIT);
+	}
+	if (strEQ(d,"exp")) {
+	    yylval = OEXP;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"elsif"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"eq"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"eval"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"eof"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"each"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"exec"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'f': case 'F':
+	SNARFWORD;
+	if (strEQ(d,"FS")) {
+	    saw_FS++;
+	    if (saw_FS == 1 && in_begin) {
+		for (d = s; *d && isspace(*d); d++) ;
+		if (*d == '=') {
+		    for (d++; *d && isspace(*d); d++) ;
+		    if (*d == '"' && d[2] == '"')
+			const_FS = d[1];
+		}
+	    }
+	    ID(tokenbuf);
+	}
+	if (strEQ(d,"for"))
+	    XTERM(FOR);
+	else if (strEQ(d,"function"))
+	    XTERM(FUNCTION);
+	if (strEQ(d,"FILENAME"))
+	    d = "ARGV";
+	if (strEQ(d,"foreach"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"format"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"fork"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"fh"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'g': case 'G':
+	SNARFWORD;
+	if (strEQ(d,"getline"))
+	    XTERM(GETLINE);
+	if (strEQ(d,"gsub"))
+	    XTERM(GSUB);
+	if (strEQ(d,"ge"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"gt"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"goto"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"gmtime"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'h': case 'H':
+	SNARFWORD;
+	if (strEQ(d,"hex"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'i': case 'I':
+	SNARFWORD;
+	if (strEQ(d,"if"))
+	    XTERM(IF);
+	if (strEQ(d,"in"))
+	    XTERM(IN);
+	if (strEQ(d,"index")) {
+	    set_array_base = TRUE;
+	    XTERM(INDEX);
+	}
+	if (strEQ(d,"int")) {
+	    yylval = OINT;
+	    XTERM(FUN1);
+	}
+	ID(d);
+    case 'j': case 'J':
+	SNARFWORD;
+	if (strEQ(d,"join"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'k': case 'K':
+	SNARFWORD;
+	if (strEQ(d,"keys"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"kill"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'l': case 'L':
+	SNARFWORD;
+	if (strEQ(d,"length")) {
+	    yylval = OLENGTH;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"log")) {
+	    yylval = OLOG;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"last"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"local"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"lt"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"le"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"locatime"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"link"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'm': case 'M':
+	SNARFWORD;
+	if (strEQ(d,"match")) {
+	    set_array_base = TRUE;
+	    XTERM(MATCH);
+	}
+	if (strEQ(d,"m"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'n': case 'N':
+	SNARFWORD;
+	if (strEQ(d,"NF"))
+	    do_chop = do_split = split_to_array = set_array_base = TRUE;
+	if (strEQ(d,"next")) {
+	    saw_line_op = TRUE;
+	    XTERM(NEXT);
+	}
+	if (strEQ(d,"ne"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'o': case 'O':
+	SNARFWORD;
+	if (strEQ(d,"ORS")) {
+	    saw_ORS = TRUE;
+	    d = "\\";
+	}
+	if (strEQ(d,"OFS")) {
+	    saw_OFS = TRUE;
+	    d = ",";
+	}
+	if (strEQ(d,"OFMT")) {
+	    d = "#";
+	}
+	if (strEQ(d,"open"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"ord"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"oct"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'p': case 'P':
+	SNARFWORD;
+	if (strEQ(d,"print")) {
+	    XTERM(PRINT);
+	}
+	if (strEQ(d,"printf")) {
+	    XTERM(PRINTF);
+	}
+	if (strEQ(d,"push"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"pop"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'q': case 'Q':
+	SNARFWORD;
+	ID(d);
+    case 'r': case 'R':
+	SNARFWORD;
+	if (strEQ(d,"RS")) {
+	    d = "/";
+	    saw_RS = TRUE;
+	}
+	if (strEQ(d,"rand")) {
+	    yylval = ORAND;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"return"))
+	    XTERM(RET);
+	if (strEQ(d,"reset"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"redo"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"rename"))
+	    *d = toupper(*d);
+	ID(d);
+    case 's': case 'S':
+	SNARFWORD;
+	if (strEQ(d,"split")) {
+	    set_array_base = TRUE;
+	    XOP(SPLIT);
+	}
+	if (strEQ(d,"substr")) {
+	    set_array_base = TRUE;
+	    XTERM(SUBSTR);
+	}
+	if (strEQ(d,"sub"))
+	    XTERM(SUB);
+	if (strEQ(d,"sprintf"))
+	    XTERM(SPRINTF);
+	if (strEQ(d,"sqrt")) {
+	    yylval = OSQRT;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"SUBSEP")) {
+	    d = ";";
+	}
+	if (strEQ(d,"sin")) {
+	    yylval = OSIN;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"srand")) {
+	    yylval = OSRAND;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"system")) {
+	    yylval = OSYSTEM;
+	    XTERM(FUN1);
+	}
+	if (strEQ(d,"s"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"shift"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"select"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"seek"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"stat"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"study"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"sleep"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"symlink"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"sort"))
+	    *d = toupper(*d);
+	ID(d);
+    case 't': case 'T':
+	SNARFWORD;
+	if (strEQ(d,"tr"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"tell"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"time"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"times"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'u': case 'U':
+	SNARFWORD;
+	if (strEQ(d,"until"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"unless"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"umask"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"unshift"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"unlink"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"utime"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'v': case 'V':
+	SNARFWORD;
+	if (strEQ(d,"values"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'w': case 'W':
+	SNARFWORD;
+	if (strEQ(d,"while"))
+	    XTERM(WHILE);
+	if (strEQ(d,"write"))
+	    *d = toupper(*d);
+	else if (strEQ(d,"wait"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'x': case 'X':
+	SNARFWORD;
+	if (strEQ(d,"x"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'y': case 'Y':
+	SNARFWORD;
+	if (strEQ(d,"y"))
+	    *d = toupper(*d);
+	ID(d);
+    case 'z': case 'Z':
+	SNARFWORD;
+	ID(d);
+    }
+}
+
+char *
+scanpat(s)
+register char *s;
+{
+    register char *d;
+
+    switch (*s++) {
+    case '/':
+	break;
+    default:
+	fatal("Search pattern not found:\n%s",str_get(linestr));
+    }
+
+    d = tokenbuf;
+    for (; *s; s++,d++) {
+	if (*s == '\\') {
+	    if (s[1] == '/')
+		*d++ = *s++;
+	    else if (s[1] == '\\')
+		*d++ = *s++;
+	    else if (s[1] == '[')
+		*d++ = *s++;
+	}
+	else if (*s == '[') {
+	    *d++ = *s++;
+	    do {
+		if (*s == '\\' && s[1])
+		    *d++ = *s++;
+		if (*s == '/' || (*s == '-' && s[1] == ']'))
+		    *d++ = '\\';
+		*d++ = *s++;
+	    } while (*s && *s != ']');
+	}
+	else if (*s == '/')
+	    break;
+	*d = *s;
+    }
+    *d = '\0';
+
+    if (!*s)
+	fatal("Search pattern not terminated:\n%s",str_get(linestr));
+    s++;
+    yylval = string(tokenbuf,0);
+    return s;
+}
+
+void
+yyerror(s)
+char *s;
+{
+    fprintf(stderr,"%s in file %s at line %d\n",
+      s,filename,line);
+}
+
+char *
+scannum(s)
+register char *s;
+{
+    register char *d;
+
+    switch (*s) {
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9': case '0' : case '.':
+	d = tokenbuf;
+	while (isdigit(*s)) {
+	    *d++ = *s++;
+	}
+	if (*s == '.') {
+	    if (isdigit(s[1])) {
+		*d++ = *s++;
+		while (isdigit(*s)) {
+		    *d++ = *s++;
+		}
+	    }
+	    else
+		s++;
+	}
+	if (strchr("eE",*s) && strchr("+-0123456789",s[1])) {
+	    *d++ = *s++;
+	    if (*s == '+' || *s == '-')
+		*d++ = *s++;
+	    while (isdigit(*s))
+		*d++ = *s++;
+	}
+	*d = '\0';
+	yylval = string(tokenbuf,0);
+	break;
+    }
+    return s;
+}
+
+int
+string(ptr,len)
+char *ptr;
+int len;
+{
+    int retval = mop;
+
+    ops[mop++].ival = OSTRING + (1<<8);
+    if (!len)
+	len = strlen(ptr);
+    ops[mop].cval = safemalloc(len+1);
+    strncpy(ops[mop].cval,ptr,len);
+    ops[mop++].cval[len] = '\0';
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper0(type)
+int type;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper1(type,arg1)
+int type;
+int arg1;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type + (1<<8);
+    ops[mop++].ival = arg1;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper2(type,arg1,arg2)
+int type;
+int arg1;
+int arg2;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type + (2<<8);
+    ops[mop++].ival = arg1;
+    ops[mop++].ival = arg2;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper3(type,arg1,arg2,arg3)
+int type;
+int arg1;
+int arg2;
+int arg3;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type + (3<<8);
+    ops[mop++].ival = arg1;
+    ops[mop++].ival = arg2;
+    ops[mop++].ival = arg3;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper4(type,arg1,arg2,arg3,arg4)
+int type;
+int arg1;
+int arg2;
+int arg3;
+int arg4;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type + (4<<8);
+    ops[mop++].ival = arg1;
+    ops[mop++].ival = arg2;
+    ops[mop++].ival = arg3;
+    ops[mop++].ival = arg4;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int
+oper5(type,arg1,arg2,arg3,arg4,arg5)
+int type;
+int arg1;
+int arg2;
+int arg3;
+int arg4;
+int arg5;
+{
+    int retval = mop;
+
+    if (type > 255)
+	fatal("type > 255 (%d)\n",type);
+    ops[mop++].ival = type + (5<<8);
+    ops[mop++].ival = arg1;
+    ops[mop++].ival = arg2;
+    ops[mop++].ival = arg3;
+    ops[mop++].ival = arg4;
+    ops[mop++].ival = arg5;
+    if (mop >= OPSMAX)
+	fatal("Recompile a2p with larger OPSMAX\n");
+    return retval;
+}
+
+int depth = 0;
+
+void
+dump(branch)
+int branch;
+{
+    register int type;
+    register int len;
+    register int i;
+
+    type = ops[branch].ival;
+    len = type >> 8;
+    type &= 255;
+    for (i=depth; i; i--)
+	printf(" ");
+    if (type == OSTRING) {
+	printf("%-5d\"%s\"\n",branch,ops[branch+1].cval);
+    }
+    else {
+	printf("(%-5d%s %d\n",branch,opname[type],len);
+	depth++;
+	for (i=1; i<=len; i++)
+	    dump(ops[branch+i].ival);
+	depth--;
+	for (i=depth; i; i--)
+	    printf(" ");
+	printf(")\n");
+    }
+}
+
+int
+bl(arg,maybe)
+int arg;
+int maybe;
+{
+    if (!arg)
+	return 0;
+    else if ((ops[arg].ival & 255) != OBLOCK)
+	return oper2(OBLOCK,arg,maybe);
+    else if ((ops[arg].ival >> 8) < 2)
+	return oper2(OBLOCK,ops[arg+1].ival,maybe);
+    else
+	return arg;
+}
+
+void
+fixup(str)
+STR *str;
+{
+    register char *s;
+    register char *t;
+
+    for (s = str->str_ptr; *s; s++) {
+	if (*s == ';' && s[1] == ' ' && s[2] == '\n') {
+	    strcpy(s+1,s+2);
+	    s++;
+	}
+	else if (*s == '\n') {
+	    for (t = s+1; isspace(*t & 127); t++) ;
+	    t--;
+	    while (isspace(*t & 127) && *t != '\n') t--;
+	    if (*t == '\n' && t-s > 1) {
+		if (s[-1] == '{')
+		    s--;
+		strcpy(s+1,t);
+	    }
+	    s++;
+	}
+    }
+}
+
+void
+putlines(str)
+STR *str;
+{
+    register char *d, *s, *t, *e;
+    register int pos, newpos;
+
+    d = tokenbuf;
+    pos = 0;
+    for (s = str->str_ptr; *s; s++) {
+	*d++ = *s;
+	pos++;
+	if (*s == '\n') {
+	    *d = '\0';
+	    d = tokenbuf;
+	    pos = 0;
+	    putone();
+	}
+	else if (*s == '\t')
+	    pos += 7;
+	if (pos > 78) {		/* split a long line? */
+	    *d-- = '\0';
+	    newpos = 0;
+	    for (t = tokenbuf; isspace(*t & 127); t++) {
+		if (*t == '\t')
+		    newpos += 8;
+		else
+		    newpos += 1;
+	    }
+	    e = d;
+	    while (d > tokenbuf && (*d != ' ' || d[-1] != ';'))
+		d--;
+	    if (d < t+10) {
+		d = e;
+		while (d > tokenbuf &&
+		  (*d != ' ' || d[-1] != '|' || d[-2] != '|') )
+		    d--;
+	    }
+	    if (d < t+10) {
+		d = e;
+		while (d > tokenbuf &&
+		  (*d != ' ' || d[-1] != '&' || d[-2] != '&') )
+		    d--;
+	    }
+	    if (d < t+10) {
+		d = e;
+		while (d > tokenbuf && (*d != ' ' || d[-1] != ','))
+		    d--;
+	    }
+	    if (d < t+10) {
+		d = e;
+		while (d > tokenbuf && *d != ' ')
+		    d--;
+	    }
+	    if (d > t+3) {
+                char save[2048];
+                strcpy(save, d);
+		*d = '\n';
+                d[1] = '\0';
+		putone();
+		putchar('\n');
+		if (d[-1] != ';' && !(newpos % 4)) {
+		    *t++ = ' ';
+		    *t++ = ' ';
+		    newpos += 2;
+		}
+		strcpy(t,save+1);
+		newpos += strlen(t);
+		d = t + strlen(t);
+		pos = newpos;
+	    }
+	    else
+		d = e + 1;
+	}
+    }
+}
+
+void
+putone()
+{
+    register char *t;
+
+    for (t = tokenbuf; *t; t++) {
+	*t &= 127;
+	if (*t == 127) {
+	    *t = ' ';
+	    strcpy(t+strlen(t)-1, "\t#???\n");
+	    checkers++;
+	}
+    }
+    t = tokenbuf;
+    if (*t == '#') {
+	if (strnEQ(t,"#!/bin/awk",10) || strnEQ(t,"#! /bin/awk",11))
+	    return;
+	if (strnEQ(t,"#!/usr/bin/awk",14) || strnEQ(t,"#! /usr/bin/awk",15))
+	    return;
+    }
+    fputs(tokenbuf,stdout);
+}
+
+int
+numary(arg)
+int arg;
+{
+    STR *key;
+    int dummy;
+
+    key = walk(0,0,arg,&dummy,P_MIN);
+    str_cat(key,"[]");
+    hstore(symtab,key->str_ptr,str_make("1"));
+    str_free(key);
+    set_array_base = TRUE;
+    return arg;
+}
+
+int
+rememberargs(arg)
+int arg;
+{
+    int type;
+    STR *str;
+
+    if (!arg)
+	return arg;
+    type = ops[arg].ival & 255;
+    if (type == OCOMMA) {
+	rememberargs(ops[arg+1].ival);
+	rememberargs(ops[arg+3].ival);
+    }
+    else if (type == OVAR) {
+	str = str_new(0);
+	hstore(curarghash,ops[ops[arg+1].ival+1].cval,str);
+    }
+    else
+	fatal("panic: unknown argument type %d, line %d\n",type,line);
+    return arg;
+}
+
+int
+aryrefarg(arg)
+int arg;
+{
+    int type = ops[arg].ival & 255;
+    STR *str;
+
+    if (type != OSTRING)
+	fatal("panic: aryrefarg %d, line %d\n",type,line);
+    str = hfetch(curarghash,ops[arg+1].cval);
+    if (str)
+	str_set(str,"*");
+    return arg;
+}
+
+int
+fixfargs(name,arg,prevargs)
+int name;
+int arg;
+int prevargs;
+{
+    int type;
+    STR *str;
+    int numargs;
+
+    if (!arg)
+	return prevargs;
+    type = ops[arg].ival & 255;
+    if (type == OCOMMA) {
+	numargs = fixfargs(name,ops[arg+1].ival,prevargs);
+	numargs = fixfargs(name,ops[arg+3].ival,numargs);
+    }
+    else if (type == OVAR) {
+	str = hfetch(curarghash,ops[ops[arg+1].ival+1].cval);
+	if (strEQ(str_get(str),"*")) {
+	    char tmpbuf[128];
+
+	    str_set(str,"");		/* in case another routine has this */
+	    ops[arg].ival &= ~255;
+	    ops[arg].ival |= OSTAR;
+	    sprintf(tmpbuf,"%s:%d",ops[name+1].cval,prevargs);
+	    fprintf(stderr,"Adding %s\n",tmpbuf);
+	    str = str_new(0);
+	    str_set(str,"*");
+	    hstore(curarghash,tmpbuf,str);
+	}
+	numargs = prevargs + 1;
+    }
+    else
+	fatal("panic: unknown argument type %d, arg %d, line %d\n",
+	  type,prevargs+1,line);
+    return numargs;
+}
+
+int
+fixrargs(name,arg,prevargs)
+char *name;
+int arg;
+int prevargs;
+{
+    int type;
+    STR *str;
+    int numargs;
+
+    if (!arg)
+	return prevargs;
+    type = ops[arg].ival & 255;
+    if (type == OCOMMA) {
+	numargs = fixrargs(name,ops[arg+1].ival,prevargs);
+	numargs = fixrargs(name,ops[arg+3].ival,numargs);
+    }
+    else {
+	char tmpbuf[128];
+
+	sprintf(tmpbuf,"%s:%d",name,prevargs);
+	str = hfetch(curarghash,tmpbuf);
+	if (str && strEQ(str->str_ptr,"*")) {
+	    if (type == OVAR || type == OSTAR) {
+		ops[arg].ival &= ~255;
+		ops[arg].ival |= OSTAR;
+	    }
+	    else
+		fatal("Can't pass expression by reference as arg %d of %s\n",
+		    prevargs+1, name);
+	}
+	numargs = prevargs + 1;
+    }
+    return numargs;
+}
diff --git a/gnu/usr.bin/perl/x2p/cflags.SH b/gnu/usr.bin/perl/x2p/cflags.SH
new file mode 100644
index 00000000000..531ef658053
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/cflags.SH
@@ -0,0 +1,87 @@
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting x2p/cflags (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front.  You may delete these comments.
+$spitshell >cflags <<!GROK!THIS!
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>cflags <<'!NO!SUBS!'
+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."; exit 1
+	fi
+	. $TOP/config.sh
+	;;
+esac
+
+also=': '
+case $# in
+1) also='echo 1>&2 "	  CCCMD = "'
+esac
+
+case $# in
+0) set *.c; echo "The current C flags are:" ;;
+esac
+
+set `echo "$* " | sed -e 's/\.[oc] / /g' -e 's/\.obj / /g'`
+
+for file do
+
+    case "$#" in
+    1) ;;
+    *) echo $n "    $file.c	$c" ;;
+    esac
+
+    : allow variables like str_cflags to be evaluated
+
+    eval 'eval ${'"${file}_cflags"'-""}'
+
+    : or customize here
+
+    case "$file" in
+    a2p) ;;
+    a2py) ;;
+    hash) ;;
+    str) ;;
+    util) ;;
+    walk) ;;
+    *) ;;
+    esac
+
+    ccflags="`echo $ccflags | sed -e 's/-DEMBED//'`"
+
+    echo "$cc -c $ccflags $optimize $large $split"
+    eval "$also "'"$cc -c $ccflags $optimize $large $split"'
+
+    . $TOP/config.sh
+
+done
+!NO!SUBS!
+chmod 755 cflags
+$eunicefix cflags
diff --git a/gnu/usr.bin/perl/x2p/find2perl.PL b/gnu/usr.bin/perl/x2p/find2perl.PL
new file mode 100644
index 00000000000..32f78fe23f3
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/find2perl.PL
@@ -0,0 +1,606 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+\$startperl = "$Config{startperl}";
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+# 
+# Modified September 26, 1993 to provide proper handling of years after 1999
+#   Tom Link <tml+@pitt.edu>
+#   University of Pittsburgh
+
+while ($ARGV[0] =~ /^[^-!(]/) {
+    push(@roots, shift);
+}
+@roots = ('.') unless @roots;
+for (@roots) { $_ = &quote($_); }
+$roots = join(',', @roots);
+
+$indent = 1;
+
+while (@ARGV) {
+    $_ = shift;
+    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
+    if ($_ eq '(') {
+	$out .= &tab . "(\n";
+	$indent++;
+	next;
+    }
+    elsif ($_ eq ')') {
+	$indent--;
+	$out .= &tab . ")";
+    }
+    elsif ($_ eq '!') {
+	$out .= &tab . "!";
+	next;
+    }
+    elsif ($_ eq 'name') {
+	$out .= &tab;
+	$pat = &fileglob_to_re(shift);
+	$out .= '/' . $pat . "/";
+    }
+    elsif ($_ eq 'perm') {
+	$onum = shift;
+	die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
+	if ($onum =~ s/^-//) {
+	    $onum = '0' . sprintf("%o", oct($onum) & 017777);	# s/b 07777 ?
+	    $out .= &tab . "((\$mode & $onum) == $onum)";
+	}
+	else {
+	    $onum = '0' . $onum unless $onum =~ /^0/;
+	    $out .= &tab . "((\$mode & 0777) == $onum)";
+	}
+    }
+    elsif ($_ eq 'type') {
+	($filetest = shift) =~ tr/s/S/;
+	$out .= &tab . "-$filetest _";
+    }
+    elsif ($_ eq 'print') {
+	$out .= &tab . 'print("$name\n")';
+    }
+    elsif ($_ eq 'print0') {
+	$out .= &tab . 'print("$name\0")';
+    }
+    elsif ($_ eq 'fstype') {
+	$out .= &tab;
+	$type = shift;
+	if ($type eq 'nfs')
+	    { $out .= '($dev < 0)'; }
+	else
+	    { $out .= '($dev >= 0)'; }
+    }
+    elsif ($_ eq 'user') {
+	$uname = shift;
+	$out .= &tab . "(\$uid == \$uid{'$uname'})";
+	$inituser++;
+    }
+    elsif ($_ eq 'group') {
+	$gname = shift;
+	$out .= &tab . "(\$gid == \$gid{'$gname'})";
+	$initgroup++;
+    }
+    elsif ($_ eq 'nouser') {
+	$out .= &tab . '!defined $uid{$uid}';
+	$inituser++;
+    }
+    elsif ($_ eq 'nogroup') {
+	$out .= &tab . '!defined $gid{$gid}';
+	$initgroup++;
+    }
+    elsif ($_ eq 'links') {
+	$out .= &tab . '($nlink ' . &n(shift);
+    }
+    elsif ($_ eq 'inum') {
+	$out .= &tab . '($ino ' . &n(shift);
+    }
+    elsif ($_ eq 'size') {
+	$out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
+    }
+    elsif ($_ eq 'atime') {
+	$out .= &tab . '(int(-A _) ' . &n(shift);
+    }
+    elsif ($_ eq 'mtime') {
+	$out .= &tab . '(int(-M _) ' . &n(shift);
+    }
+    elsif ($_ eq 'ctime') {
+	$out .= &tab . '(int(-C _) ' . &n(shift);
+    }
+    elsif ($_ eq 'exec') {
+	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
+	shift;
+	$_ = "@cmd";
+	if (m#^(/bin/)?rm -f {}$#) {
+	    if (!@ARGV) {
+		$out .= &tab . 'unlink($_)';
+	    }
+	    else {
+		$out .= &tab . '(unlink($_) || 1)';
+	    }
+	}
+	elsif (m#^(/bin/)?rm {}$#) {
+	    $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
+	}
+	else {
+	    for (@cmd) { s/'/\\'/g; }
+	    $" = "','";
+	    $out .= &tab . "&exec(0, '@cmd')";
+	    $" = ' ';
+	    $initexec++;
+	}
+    }
+    elsif ($_ eq 'ok') {
+	for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
+	shift;
+	for (@cmd) { s/'/\\'/g; }
+	$" = "','";
+	$out .= &tab . "&exec(1, '@cmd')";
+	$" = ' ';
+	$initexec++;
+    }
+    elsif ($_ eq 'prune') {
+	$out .= &tab . '($prune = 1)';
+    }
+    elsif ($_ eq 'xdev') {
+	$out .= &tab . '!($prune |= ($dev != $topdev))';
+    }
+    elsif ($_ eq 'newer') {
+	$out .= &tab;
+	$file = shift;
+	$newername = 'AGE_OF' . $file;
+	$newername =~ s/[^\w]/_/g;
+	$newername = '$' . $newername;
+	$out .= "(-M _ < $newername)";
+	$initnewer .= "$newername = -M " . &quote($file) . ";\n";
+    }
+    elsif ($_ eq 'eval') {
+	$prog = &quote(shift);
+	$out .= &tab . "eval $prog";
+    }
+    elsif ($_ eq 'depth') {
+	$depth++;
+	next;
+    }
+    elsif ($_ eq 'ls') {
+	$out .= &tab . "&ls";
+	$initls++;
+    }
+    elsif ($_ eq 'tar') {
+	$out .= &tab;
+	die "-tar must have a filename argument\n" unless @ARGV;
+	$file = shift;
+	$fh = 'FH' . $file;
+	$fh =~ s/[^\w]/_/g;
+	$out .= "&tar($fh)";
+	$file = '>' . $file;
+	$initfile .= "open($fh, " . &quote($file) .
+	  qq{) || die "Can't open $fh: \$!\\n";\n};
+	$inittar++;
+	$flushall = "\n&tflushall;\n";
+    }
+    elsif (/^n?cpio$/) {
+	$depth++;
+	$out .= &tab;
+	die "-$_ must have a filename argument\n" unless @ARGV;
+	$file = shift;
+	$fh = 'FH' . $file;
+	$fh =~ s/[^\w]/_/g;
+	$out .= "&cpio('" . substr($_,0,1) . "', $fh)";
+	$file = '>' . $file;
+	$initfile .= "open($fh, " . &quote($file) .
+	  qq{) || die "Can't open $fh: \$!\\n";\n};
+	$initcpio++;
+	$flushall = "\n&flushall;\n";
+    }
+    else {
+	die "Unrecognized switch: -$_\n";
+    }
+    if (@ARGV) {
+	if ($ARGV[0] eq '-o') {
+	    { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
+	    $statdone = 0 if $indent == 1 && $delayedstat;
+	    $saw_or++;
+	    shift;
+	}
+	else {
+	    $out .= " &&" unless $ARGV[0] eq ')';
+	    $out .= "\n";
+	    shift if $ARGV[0] eq '-a';
+	}
+    }
+}
+
+print <<"END";
+$startperl
+
+eval 'exec perl -S \$0 \${1+"\$@"}'
+	if \$running_under_some_shell;
+
+END
+
+if ($initls) {
+    print <<'END';
+@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
+@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
+
+END
+}
+
+if ($inituser || $initls) {
+    print 'while (($name, $pw, $uid) = getpwent) {', "\n";
+    print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
+    print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
+    print "}\n\n";
+}
+
+if ($initgroup || $initls) {
+    print 'while (($name, $pw, $gid) = getgrent) {', "\n";
+    print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
+    print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
+    print "}\n\n";
+}
+
+print $initnewer, "\n" if $initnewer;
+
+print $initfile, "\n" if $initfile;
+
+$find = $depth ? "finddepth" : "find";
+print <<"END";
+require "$find.pl";
+
+# Traverse desired filesystems
+
+&$find($roots);
+$flushall
+exit;
+
+sub wanted {
+$out;
+}
+
+END
+
+if ($initexec) {
+    print <<'END';
+sub exec {
+    local($ok, @cmd) = @_;
+    foreach $word (@cmd) {
+	$word =~ s#{}#$name#g;
+    }
+    if ($ok) {
+	local($old) = select(STDOUT);
+	$| = 1;
+	print "@cmd";
+	select($old);
+	return 0 unless <STDIN> =~ /^y/;
+    }
+    chdir $cwd;		# sigh
+    system @cmd;
+    chdir $dir;
+    return !$?;
+}
+
+END
+}
+
+if ($initls) {
+    print <<'END';
+sub ls {
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
+      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+
+    $pname = $name;
+
+    if (defined $blocks) {
+	$blocks = int(($blocks + 1) / 2);
+    }
+    else {
+	$blocks = int(($size + 1023) / 1024);
+    }
+
+    if    (-f _) { $perms = '-'; }
+    elsif (-d _) { $perms = 'd'; }
+    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
+    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
+    elsif (-p _) { $perms = 'p'; }
+    elsif (-S _) { $perms = 's'; }
+    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
+
+    $tmpmode = $mode;
+    $tmp = $rwx[$tmpmode & 7];
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    $tmpmode >>= 3;
+    $tmp = $rwx[$tmpmode & 7] . $tmp;
+    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
+    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
+    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
+    $perms .= $tmp;
+
+    $user = $user{$uid} || $uid;
+    $group = $group{$gid} || $gid;
+
+    ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
+    $moname = $moname[$mon];
+    if (-M _ > 365.25 / 2) {
+	$timeyear = $year + 1900;
+    }
+    else {
+	$timeyear = sprintf("%02d:%02d", $hour, $min);
+    }
+
+    printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
+	    $ino,
+		 $blocks,
+		      $perms,
+			    $nlink,
+				$user,
+				     $group,
+					  $sizemm,
+					      $moname,
+						 $mday,
+						     $timeyear,
+							 $pname;
+    1;
+}
+
+sub sizemm {
+    sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
+}
+
+END
+}
+
+if ($initcpio) {
+print <<'END';
+sub cpio {
+    local($nc,$fh) = @_;
+    local($text);
+
+    if ($name eq 'TRAILER!!!') {
+	$text = '';
+	$size = 0;
+    }
+    else {
+	($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+	  $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+	if (-f _) {
+	    open(IN, "./$_\0") || do {
+		warn "Couldn't open $name: $!\n";
+		return;
+	    };
+	}
+	else {
+	    $text = readlink($_);
+	    $size = 0 unless defined $text;
+	}
+    }
+
+    ($nm = $name) =~ s#^\./##;
+    $nc{$fh} = $nc;
+    if ($nc eq 'n') {
+	$cpout{$fh} .=
+	  sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
+	    070707,
+	    $dev & 0777777,
+	    $ino & 0777777,
+	    $mode & 0777777,
+	    $uid & 0777777,
+	    $gid & 0777777,
+	    $nlink & 0777777,
+	    $rdev & 0177777,
+	    $mtime,
+	    length($nm)+1,
+	    $size,
+	    $nm);
+    }
+    else {
+	$cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
+	$cpout{$fh} .= pack("SSSSSSSSLSLa*",
+	    070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
+	    length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
+    }
+    if ($text ne '') {
+	$cpout{$fh} .= $text;
+    }
+    elsif ($size) {
+	&flush($fh) while ($l = length($cpout{$fh})) >= 5120;
+	while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
+	    &flush($fh);
+	    $l = length($cpout{$fh});
+	}
+    }
+    close IN;
+}
+
+sub flush {
+    local($fh) = @_;
+
+    while (length($cpout{$fh}) >= 5120) {
+	syswrite($fh,$cpout{$fh},5120);
+	++$blocks{$fh};
+	substr($cpout{$fh}, 0, 5120) = '';
+    }
+}
+
+sub flushall {
+    $name = 'TRAILER!!!';
+    foreach $fh (keys %cpout) {
+	&cpio($nc{$fh},$fh);
+	$cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
+	&flush($fh);
+	print $blocks{$fh} * 10, " blocks\n";
+    }
+}
+
+END
+}
+
+if ($inittar) {
+print <<'END';
+sub tar {
+    local($fh) = @_;
+    local($linkname,$header,$l,$slop);
+    local($linkflag) = "\0";
+
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+      $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
+    $nm = $name;
+    if ($nlink > 1) {
+	if ($linkname = $linkseen{$fh,$dev,$ino}) {
+	    $linkflag = 1;
+	}
+	else {
+	    $linkseen{$fh,$dev,$ino} = $nm;
+	}
+    }
+    if (-f _) {
+	open(IN, "./$_\0") || do {
+	    warn "Couldn't open $name: $!\n";
+	    return;
+	};
+	$size = 0 if $linkflag ne "\0";
+    }
+    else {
+	$linkname = readlink($_);
+	$linkflag = 2 if defined $linkname;
+	$nm .= '/' if -d _;
+	$size = 0;
+    }
+
+    $header = pack("a100a8a8a8a12a12a8a1a100",
+	$nm,
+	sprintf("%6o ", $mode & 0777),
+	sprintf("%6o ", $uid & 0777777),
+	sprintf("%6o ", $gid & 0777777),
+	sprintf("%11o ", $size),
+	sprintf("%11o ", $mtime),
+	"        ",
+	$linkflag,
+	$linkname);
+    $l = length($header) % 512;
+    substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
+    substr($header, 154, 1) = "\0";  # blech
+    $tarout{$fh} .= $header;
+    $tarout{$fh} .= "\0" x (512 - $l) if $l;
+    if ($size) {
+	&tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
+	while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
+	    $slop = length($tarout{$fh}) % 512;
+	    $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
+	    &tflush($fh);
+	    $l = length($tarout{$fh});
+	}
+    }
+    close IN;
+}
+
+sub tflush {
+    local($fh) = @_;
+
+    while (length($tarout{$fh}) >= 10240) {
+	syswrite($fh,$tarout{$fh},10240);
+	++$blocks{$fh};
+	substr($tarout{$fh}, 0, 10240) = '';
+    }
+}
+
+sub tflushall {
+    local($len);
+
+    foreach $fh (keys %tarout) {
+	$len = 10240 - length($tarout{$fh});
+	$len += 10240 if $len < 1024;
+	$tarout{$fh} .= "\0" x $len;
+	&tflush($fh);
+    }
+}
+
+END
+}
+
+exit;
+
+############################################################################
+
+sub tab {
+    local($tabstring);
+
+    $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
+    if (!$statdone) {
+	if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
+	    $delayedstat++;
+	}
+	else {
+	    if ($saw_or) {
+		$tabstring .= <<'ENDOFSTAT' . $tabstring;
+($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
+ENDOFSTAT
+	    }
+	    else {
+		$tabstring .= <<'ENDOFSTAT' . $tabstring;
+(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
+ENDOFSTAT
+	    }
+	    $statdone = 1;
+	}
+    }
+    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
+    $tabstring;
+}
+
+sub fileglob_to_re {
+    local($tmp) = @_;
+
+    $tmp =~ s#([./^\$()])#\\$1#g;
+    $tmp =~ s/([?*])/.$1/g;
+    "^$tmp\$";
+}
+
+sub n {
+    local($n) = @_;
+
+    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
+    $n =~ s/ 0*(\d)/ $1/;
+    $n . ')';
+}
+
+sub quote {
+    local($string) = @_;
+    $string =~ s/'/\\'/;
+    "'$string'";
+}
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/x2p/handy.h b/gnu/usr.bin/perl/x2p/handy.h
new file mode 100644
index 00000000000..0049a1108b4
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/handy.h
@@ -0,0 +1,172 @@
+/*    handy.h
+ *
+ *    Copyright (c) 1991-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.
+ *
+ */
+
+#if !defined(__STDC__)
+#ifdef NULL
+#undef NULL
+#endif
+#ifndef I286
+#  define NULL 0
+#else
+#  define NULL 0L
+#endif
+#endif
+
+#define Null(type) ((type)NULL)
+#define Nullch Null(char*)
+#define Nullfp Null(FILE*)
+#define Nullsv Null(SV*)
+
+#ifdef UTS
+#define bool int
+#else
+#define bool char
+#endif
+
+#ifdef TRUE
+#undef TRUE
+#endif
+#ifdef FALSE
+#undef FALSE
+#endif
+#define TRUE (1)
+#define FALSE (0)
+
+typedef char		I8;
+typedef unsigned char	U8;
+
+typedef short		I16;
+typedef unsigned short	U16;
+
+#if BYTEORDER > 0x4321
+  typedef int		I32;
+  typedef unsigned int	U32;
+#else
+  typedef long		I32;
+  typedef unsigned long	U32;
+#endif
+
+#define Ctl(ch) (ch & 037)
+
+#define strNE(s1,s2) (strcmp(s1,s2))
+#define strEQ(s1,s2) (!strcmp(s1,s2))
+#define strLT(s1,s2) (strcmp(s1,s2) < 0)
+#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
+#define strGT(s1,s2) (strcmp(s1,s2) > 0)
+#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
+#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
+#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
+
+#ifdef HAS_SETLOCALE  /* XXX Is there a better test for this? */
+#  ifndef CTYPE256
+#    define CTYPE256
+#  endif
+#endif
+
+#ifdef USE_NEXT_CTYPE 
+#define isALNUM(c)   (NXIsAlpha((unsigned int)c) || NXIsDigit((unsigned int)c) || c == '_')
+#define isIDFIRST(c) (NXIsAlpha((unsigned int)c) || c == '_')
+#define isALPHA(c)   NXIsAlpha((unsigned int)c)
+#define isSPACE(c)   NXIsSpace((unsigned int)c)
+#define isDIGIT(c)   NXIsDigit((unsigned int)c)
+#define isUPPER(c)   NXIsUpper((unsigned int)c)
+#define isLOWER(c)   NXIsLower((unsigned int)c)
+#define toUPPER(c)   NXToUpper((unsigned int)c)
+#define toLOWER(c)   NXToLower((unsigned int)c)
+#else /* USE_NEXT_CTYPE */
+#if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII))
+#define isALNUM(c)   (isalpha((unsigned char)(c)) || isdigit((unsigned char)(c)) || c == '_')
+#define isIDFIRST(c) (isalpha((unsigned char)(c)) || (c) == '_')
+#define isALPHA(c)   isalpha((unsigned char)(c))
+#define isSPACE(c)   isspace((unsigned char)(c))
+#define isDIGIT(c)   isdigit((unsigned char)(c))
+#define isUPPER(c)   isupper((unsigned char)(c))
+#define isLOWER(c)   islower((unsigned char)(c))
+#define toUPPER(c)   toupper((unsigned char)(c))
+#define toLOWER(c)   tolower((unsigned char)(c))
+#else
+#define isALNUM(c)   (isascii(c) && (isalpha(c) || isdigit(c) || c == '_'))
+#define isIDFIRST(c) (isascii(c) && (isalpha(c) || (c) == '_'))
+#define isALPHA(c)   (isascii(c) && isalpha(c))
+#define isSPACE(c)   (isascii(c) && isspace(c))
+#define isDIGIT(c)   (isascii(c) && isdigit(c))
+#define isUPPER(c)   (isascii(c) && isupper(c))
+#define isLOWER(c)   (isascii(c) && islower(c))
+#define toUPPER(c)   toupper(c)
+#define toLOWER(c)   tolower(c)
+#endif
+#endif /* USE_NEXT_CTYPE */
+
+/* Line numbers are unsigned, 16 bits. */
+typedef U16 line_t;
+#ifdef lint
+#define NOLINE ((line_t)0)
+#else
+#define NOLINE ((line_t) 65535)
+#endif
+
+#ifndef lint
+#ifndef LEAKTEST
+#ifndef safemalloc
+Malloc_t safemalloc _((MEM_SIZE));
+Malloc_t saferealloc _((char *, MEM_SIZE));
+void safefree _((char *));
+#endif
+#ifndef MSDOS
+#define New(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#else
+#define New(x,v,n,t)  (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#endif /* MSDOS */
+#define Safefree(d) safefree((char*)d)
+#define NEWSV(x,len) newSV(len)
+#else /* LEAKTEST */
+char *safexmalloc();
+char *safexrealloc();
+void safexfree();
+#define New(x,v,n,t)  (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+#define Newc(x,v,n,t,c)  (v = (c*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safexmalloc(x,(MEM_SIZE)((n) * sizeof(t)))), \
+    memzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)safexrealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#define Safefree(d) safexfree((char*)d)
+#define NEWSV(x,len) newSV(x,len)
+#define MAXXCOUNT 1200
+long xcount[MAXXCOUNT];
+long lastxcount[MAXXCOUNT];
+#endif /* LEAKTEST */
+#define Move(s,d,n,t) (void)memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Copy(s,d,n,t) (void)memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#define Zero(d,n,t) (void)memzero((char*)(d), (n) * sizeof(t))
+#else /* lint */
+#define New(x,v,n,s) (v = Null(s *))
+#define Newc(x,v,n,s,c) (v = Null(s *))
+#define Newz(x,v,n,s) (v = Null(s *))
+#define Renew(v,n,s) (v = Null(s *))
+#define Move(s,d,n,t)
+#define Copy(s,d,n,t)
+#define Zero(d,n,t)
+#define Safefree(d) d = d
+#endif /* lint */
+
+#ifdef USE_STRUCT_COPY
+#define StructCopy(s,d,t) *((t*)(d)) = *((t*)(s))
+#else
+#define StructCopy(s,d,t) Copy(s,d,1,t)
+#endif
diff --git a/gnu/usr.bin/perl/x2p/hash.c b/gnu/usr.bin/perl/x2p/hash.c
new file mode 100644
index 00000000000..58236f49e42
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/hash.c
@@ -0,0 +1,242 @@
+/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:20 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	hash.c,v $
+ */
+
+#include <stdio.h>
+#include "EXTERN.h"
+#include "a2p.h"
+#include "util.h"
+
+STR *
+hfetch(tb,key)
+register HASH *tb;
+char *key;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+
+    if (!tb)
+	return Nullstr;
+    for (s=key,		i=0,	hash = 0;
+      /* while */ *s;
+	 s++,		i++,	hash *= 5) {
+	hash += *s * coeff[i];
+    }
+    entry = tb->tbl_array[hash & tb->tbl_max];
+    for (; entry; entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (strNE(entry->hent_key,key))	/* is this it? */
+	    continue;
+	return entry->hent_val;
+    }
+    return Nullstr;
+}
+
+bool
+hstore(tb,key,val)
+register HASH *tb;
+char *key;
+STR *val;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register HENT **oentry;
+
+    if (!tb)
+	return FALSE;
+    for (s=key,		i=0,	hash = 0;
+      /* while */ *s;
+	 s++,		i++,	hash *= 5) {
+	hash += *s * coeff[i];
+    }
+
+    oentry = &(tb->tbl_array[hash & tb->tbl_max]);
+    i = 1;
+
+    for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (strNE(entry->hent_key,key))	/* is this it? */
+	    continue;
+	/*NOSTRICT*/
+	Safefree(entry->hent_val);
+	entry->hent_val = val;
+	return TRUE;
+    }
+    /*NOSTRICT*/
+    entry = (HENT*) safemalloc(sizeof(HENT));
+
+    entry->hent_key = savestr(key);
+    entry->hent_val = val;
+    entry->hent_hash = hash;
+    entry->hent_next = *oentry;
+    *oentry = entry;
+
+    if (i) {				/* initial entry? */
+	tb->tbl_fill++;
+	if ((tb->tbl_fill * 100 / (tb->tbl_max + 1)) > FILLPCT)
+	    hsplit(tb);
+    }
+
+    return FALSE;
+}
+
+#ifdef NOTUSED
+bool
+hdelete(tb,key)
+register HASH *tb;
+char *key;
+{
+    register char *s;
+    register int i;
+    register int hash;
+    register HENT *entry;
+    register HENT **oentry;
+
+    if (!tb)
+	return FALSE;
+    for (s=key,		i=0,	hash = 0;
+      /* while */ *s;
+	 s++,		i++,	hash *= 5) {
+	hash += *s * coeff[i];
+    }
+
+    oentry = &(tb->tbl_array[hash & tb->tbl_max]);
+    entry = *oentry;
+    i = 1;
+    for (; entry; i=0, oentry = &entry->hent_next, entry = entry->hent_next) {
+	if (entry->hent_hash != hash)		/* strings can't be equal */
+	    continue;
+	if (strNE(entry->hent_key,key))	/* is this it? */
+	    continue;
+	safefree((char*)entry->hent_val);
+	safefree(entry->hent_key);
+	*oentry = entry->hent_next;
+	safefree((char*)entry);
+	if (i)
+	    tb->tbl_fill--;
+	return TRUE;
+    }
+    return FALSE;
+}
+#endif
+
+void
+hsplit(tb)
+HASH *tb;
+{
+    int oldsize = tb->tbl_max + 1;
+    register int newsize = oldsize * 2;
+    register int i;
+    register HENT **a;
+    register HENT **b;
+    register HENT *entry;
+    register HENT **oentry;
+
+    a = (HENT**) saferealloc((char*)tb->tbl_array, newsize * sizeof(HENT*));
+    bzero((char*)&a[oldsize], oldsize * sizeof(HENT*)); /* zero second half */
+    tb->tbl_max = --newsize;
+    tb->tbl_array = a;
+
+    for (i=0; i<oldsize; i++,a++) {
+	if (!*a)				/* non-existent */
+	    continue;
+	b = a+oldsize;
+	for (oentry = a, entry = *a; entry; entry = *oentry) {
+	    if ((entry->hent_hash & newsize) != i) {
+		*oentry = entry->hent_next;
+		entry->hent_next = *b;
+		if (!*b)
+		    tb->tbl_fill++;
+		*b = entry;
+		continue;
+	    }
+	    else
+		oentry = &entry->hent_next;
+	}
+	if (!*a)				/* everything moved */
+	    tb->tbl_fill--;
+    }
+}
+
+HASH *
+hnew()
+{
+    register HASH *tb = (HASH*)safemalloc(sizeof(HASH));
+
+    tb->tbl_array = (HENT**) safemalloc(8 * sizeof(HENT*));
+    tb->tbl_fill = 0;
+    tb->tbl_max = 7;
+    hiterinit(tb);	/* so each() will start off right */
+    bzero((char*)tb->tbl_array, 8 * sizeof(HENT*));
+    return tb;
+}
+
+#ifdef NOTUSED
+hshow(tb)
+register HASH *tb;
+{
+    fprintf(stderr,"%5d %4d (%2d%%)\n",
+	tb->tbl_max+1,
+	tb->tbl_fill,
+	tb->tbl_fill * 100 / (tb->tbl_max+1));
+}
+#endif
+
+int
+hiterinit(tb)
+register HASH *tb;
+{
+    tb->tbl_riter = -1;
+    tb->tbl_eiter = Null(HENT*);
+    return tb->tbl_fill;
+}
+
+HENT *
+hiternext(tb)
+register HASH *tb;
+{
+    register HENT *entry;
+
+    entry = tb->tbl_eiter;
+    do {
+	if (entry)
+	    entry = entry->hent_next;
+	if (!entry) {
+	    tb->tbl_riter++;
+	    if (tb->tbl_riter > tb->tbl_max) {
+		tb->tbl_riter = -1;
+		break;
+	    }
+	    entry = tb->tbl_array[tb->tbl_riter];
+	}
+    } while (!entry);
+
+    tb->tbl_eiter = entry;
+    return entry;
+}
+
+char *
+hiterkey(entry)
+register HENT *entry;
+{
+    return entry->hent_key;
+}
+
+STR *
+hiterval(entry)
+register HENT *entry;
+{
+    return entry->hent_val;
+}
diff --git a/gnu/usr.bin/perl/x2p/hash.h b/gnu/usr.bin/perl/x2p/hash.h
new file mode 100644
index 00000000000..f61a29f4e62
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/hash.h
@@ -0,0 +1,52 @@
+/* $RCSfile: hash.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:21 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	hash.h,v $
+ */
+
+#define FILLPCT 60		/* don't make greater than 99 */
+
+#ifdef DOINIT
+char coeff[] = {
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+		61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
+#else
+extern char coeff[];
+#endif
+
+typedef struct hentry HENT;
+
+struct hentry {
+    HENT	*hent_next;
+    char	*hent_key;
+    STR		*hent_val;
+    int		hent_hash;
+};
+
+struct htbl {
+    HENT	**tbl_array;
+    int		tbl_max;
+    int		tbl_fill;
+    int		tbl_riter;	/* current root of iterator */
+    HENT	*tbl_eiter;	/* current entry of iterator */
+};
+
+bool hdelete _((HASH *tb, char *key));
+STR * hfetch _(( HASH *tb, char *key ));
+int hiterinit _(( HASH *tb ));
+char * hiterkey _(( HENT *entry ));
+HENT * hiternext _(( HASH *tb ));
+STR * hiterval _(( HENT *entry ));
+HASH * hnew _(( void ));
+void hsplit _(( HASH *tb ));
+bool hstore _(( HASH *tb, char *key, STR *val ));
diff --git a/gnu/usr.bin/perl/x2p/s2p.PL b/gnu/usr.bin/perl/x2p/s2p.PL
new file mode 100644
index 00000000000..29864b418a6
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/s2p.PL
@@ -0,0 +1,781 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+	if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+    eval 'exec perl -S \$0 "\$@"'
+	if 0;
+\$startperl = "$Config{startperl}";
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+# $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
+#
+# $Log:	s2p.SH,v $
+
+$indent = 4;
+$shiftwidth = 4;
+$l = '{'; $r = '}';
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+  last if /^--/;
+    if (/^-D/) {
+	$debug++;
+	open(BODY,'>-');
+	next;
+    }
+    if (/^-n/) {
+	$assumen++;
+	next;
+    }
+    if (/^-p/) {
+	$assumep++;
+	next;
+    }
+    die "I don't recognize this switch: $_\n";
+}
+
+unless ($debug) {
+    open(BODY,">/tmp/sperl$$") ||
+      &Die("Can't open temp file: $!\n");
+}
+
+if (!$assumen && !$assumep) {
+    print BODY &q(<<'EOT');
+:	while ($ARGV[0] =~ /^-/) {
+:	    $_ = shift;
+:	  last if /^--/;
+:	    if (/^-n/) {
+:		$nflag++;
+:		next;
+:	    }
+:	    die "I don't recognize this switch: $_\\n";
+:	}
+:	
+EOT
+}
+
+print BODY &q(<<'EOT');
+:	#ifdef PRINTIT
+:	#ifdef ASSUMEP
+:	$printit++;
+:	#else
+:	$printit++ unless $nflag;
+:	#endif
+:	#endif
+:	<><>
+:	$\ = "\n";		# automatically add newline on print
+:	<><>
+:	#ifdef TOPLABEL
+:	LINE:
+:	while (chop($_ = <>)) {
+:	#else
+:	LINE:
+:	while (<>) {
+:	    chop;
+:	#endif
+EOT
+
+LINE:
+while (<>) {
+
+    # Wipe out surrounding whitespace.
+
+    s/[ \t]*(.*)\n$/$1/;
+
+    # Perhaps it's a label/comment.
+
+    if (/^:/) {
+	s/^:[ \t]*//;
+	$label = &make_label($_);
+	if ($. == 1) {
+	    $toplabel = $label;
+	    if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
+		$_ = <>;
+		redo LINE; # Never referenced, so delete it if not a comment.
+	    }
+	}
+	$_ = "$label:";
+	if ($lastlinewaslabel++) {
+	    $indent += 4;
+	    print BODY &tab, ";\n";
+	    $indent -= 4;
+	}
+	if ($indent >= 2) {
+	    $indent -= 2;
+	    $indmod = 2;
+	}
+	next;
+    } else {
+	$lastlinewaslabel = '';
+    }
+
+    # Look for one or two address clauses
+
+    $addr1 = '';
+    $addr2 = '';
+    if (s/^([0-9]+)//) {
+	$addr1 = "$1";
+	$addr1 = "\$. == $addr1" unless /^,/;
+    }
+    elsif (s/^\$//) {
+	$addr1 = 'eof()';
+    }
+    elsif (s|^/||) {
+	$addr1 = &fetchpat('/');
+    }
+    if (s/^,//) {
+	if (s/^([0-9]+)//) {
+	    $addr2 = "$1";
+	} elsif (s/^\$//) {
+	    $addr2 = "eof()";
+	} elsif (s|^/||) {
+	    $addr2 = &fetchpat('/');
+	} else {
+	    &Die("Invalid second address at line $.\n");
+	}
+	if ($addr2 =~ /^\d+$/) {
+	    $addr1 .= "..$addr2";
+	}
+	else {
+	    $addr1 .= "...$addr2";
+	}
+    }
+
+    # Now we check for metacommands {, }, and ! and worry
+    # about indentation.
+
+    s/^[ \t]+//;
+    # a { to keep vi happy
+    if ($_ eq '}') {
+	$indent -= 4;
+	next;
+    }
+    if (s/^!//) {
+	$if = 'unless';
+	$else = "$r else $l\n";
+    } else {
+	$if = 'if';
+	$else = '';
+    }
+    if (s/^{//) {	# a } to keep vi happy
+	$indmod = 4;
+	$redo = $_;
+	$_ = '';
+	$rmaybe = '';
+    } else {
+	$rmaybe = "\n$r";
+	if ($addr2 || $addr1) {
+	    $space = ' ' x $shiftwidth;
+	} else {
+	    $space = '';
+	}
+	$_ = &transmogrify();
+    }
+
+    # See if we can optimize to modifier form.
+
+    if ($addr1) {
+	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
+	  $_ !~ / if / && $_ !~ / unless /) {
+	    s/;$/ $if $addr1;/;
+	    $_ = substr($_,$shiftwidth,1000);
+	} else {
+	    $_ = "$if ($addr1) $l\n$change$_$rmaybe";
+	}
+	$change = '';
+	next LINE;
+    }
+} continue {
+    @lines = split(/\n/,$_);
+    for (@lines) {
+	unless (s/^ *<<--//) {
+	    print BODY &tab;
+	}
+	print BODY $_, "\n";
+    }
+    $indent += $indmod;
+    $indmod = 0;
+    if ($redo) {
+	$_ = $redo;
+	$redo = '';
+	redo LINE;
+    }
+}
+if ($lastlinewaslabel++) {
+    $indent += 4;
+    print BODY &tab, ";\n";
+    $indent -= 4;
+}
+
+if ($appendseen || $tseen || !$assumen) {
+    $printit++ if $dseen || (!$assumen && !$assumep);
+    print BODY &q(<<'EOT');
+:	#ifdef SAWNEXT
+:	}
+:	continue {
+:	#endif
+:	#ifdef PRINTIT
+:	#ifdef DSEEN
+:	#ifdef ASSUMEP
+:	    print if $printit++;
+:	#else
+:	    if ($printit)
+:		{ print; }
+:	    else
+:		{ $printit++ unless $nflag; }
+:	#endif
+:	#else
+:	    print if $printit;
+:	#endif
+:	#else
+:	    print;
+:	#endif
+:	#ifdef TSEEN
+:	    $tflag = 0;
+:	#endif
+:	#ifdef APPENDSEEN
+:	    if ($atext) { chop $atext; print $atext; $atext = ''; }
+:	#endif
+EOT
+
+print BODY &q(<<'EOT');
+:	}
+EOT
+}
+
+close BODY;
+
+unless ($debug) {
+    open(HEAD,">/tmp/sperl2$$.c")
+      || &Die("Can't open temp file 2: $!\n");
+    print HEAD "#define PRINTIT\n"	if $printit;
+    print HEAD "#define APPENDSEEN\n"	if $appendseen;
+    print HEAD "#define TSEEN\n"	if $tseen;
+    print HEAD "#define DSEEN\n"	if $dseen;
+    print HEAD "#define ASSUMEN\n"	if $assumen;
+    print HEAD "#define ASSUMEP\n"	if $assumep;
+    print HEAD "#define TOPLABEL\n"	if $toplabel;
+    print HEAD "#define SAWNEXT\n"	if $sawnext;
+    if ($opens) {print HEAD "$opens\n";}
+    open(BODY,"/tmp/sperl$$")
+      || &Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
+	print HEAD $_;
+    }
+    close HEAD;
+
+    print &q(<<"EOT");
+:	$startperl
+:	eval 'exec perl -S \$0 \${1+"\$@"}'
+:		if \$running_under_some_shell;
+:	
+EOT
+    open(BODY,"cc -E /tmp/sperl2$$.c |") ||
+	&Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
+	/^# [0-9]/ && next;
+	/^[ \t]*$/ && next;
+	s/^<><>//;
+	print;
+    }
+}
+
+&Cleanup;
+exit;
+
+sub Cleanup {
+    chdir "/tmp";
+    unlink "sperl$$", "sperl2$$", "sperl2$$.c";
+}
+sub Die {
+    &Cleanup;
+    die $_[0];
+}
+sub tab {
+    "\t" x ($indent / 8) . ' ' x ($indent % 8);
+}
+sub make_filehandle {
+    local($_) = $_[0];
+    local($fname) = $_;
+    if (!$seen{$fname}) {
+	$_ = "FH_" . $_ if /^\d/;
+	s/[^a-zA-Z0-9]/_/g;
+	s/^_*//;
+	$_ = "\U$_";
+	if ($fhseen{$_}) {
+	    for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
+	    $_ .= $tmp;
+	}
+	$fhseen{$_} = 1;
+	$opens .= &q(<<"EOT");
+:	open($_, '>$fname') || die "Can't create $fname: \$!";
+EOT
+	$seen{$fname} = $_;
+    }
+    $seen{$fname};
+}
+
+sub make_label {
+    local($label) = @_;
+    $label =~ s/[^a-zA-Z0-9]/_/g;
+    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
+    $label = substr($label,0,8);
+
+    # Could be a reserved word, so capitalize it.
+    substr($label,0,1) =~ y/a-z/A-Z/
+      if $label =~ /^[a-z]/;
+
+    $label;
+}
+
+sub transmogrify {
+    {	# case
+	if (/^d/) {
+	    $dseen++;
+	    chop($_ = &q(<<'EOT'));
+:	<<--#ifdef PRINTIT
+:	$printit = 0;
+:	<<--#endif
+:	next LINE;
+EOT
+	    $sawnext++;
+	    next;
+	}
+
+	if (/^n/) {
+	    chop($_ = &q(<<'EOT'));
+:	<<--#ifdef PRINTIT
+:	<<--#ifdef DSEEN
+:	<<--#ifdef ASSUMEP
+:	print if $printit++;
+:	<<--#else
+:	if ($printit)
+:	    { print; }
+:	else
+:	    { $printit++ unless $nflag; }
+:	<<--#endif
+:	<<--#else
+:	print if $printit;
+:	<<--#endif
+:	<<--#else
+:	print;
+:	<<--#endif
+:	<<--#ifdef APPENDSEEN
+:	if ($atext) {chop $atext; print $atext; $atext = '';}
+:	<<--#endif
+:	$_ = <>;
+:	chop;
+:	<<--#ifdef TSEEN
+:	$tflag = 0;
+:	<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^a/) {
+	    $appendseen++;
+	    $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
+	    $lastline = 0;
+	    while (<>) {
+		s/^[ \t]*//;
+		s/^[\\]//;
+		unless (s|\\$||) { $lastline = 1;}
+		s/^([ \t]*\n)/<><>$1/;
+		$command .= $_;
+		$command .= '<<--';
+		last if $lastline;
+	    }
+	    $_ = $command . "End_Of_Text";
+	    last;
+	}
+
+	if (/^[ic]/) {
+	    if (/^c/) { $change = 1; }
+	    $addr1 = 1 if $addr1 eq '';
+	    $addr1 = '$iter = (' . $addr1 . ')';
+	    $command = $space .
+	      "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
+	    $lastline = 0;
+	    while (<>) {
+		s/^[ \t]*//;
+		s/^[\\]//;
+		unless (s/\\$//) { $lastline = 1;}
+		s/'/\\'/g;
+		s/^([ \t]*\n)/<><>$1/;
+		$command .= $_;
+		$command .= '<<--';
+		last if $lastline;
+	    }
+	    $_ = $command . "End_Of_Text";
+	    if ($change) {
+		$dseen++;
+		$change = "$_\n";
+		chop($_ = &q(<<"EOT"));
+:	<<--#ifdef PRINTIT
+:	$space\$printit = 0;
+:	<<--#endif
+:	${space}next LINE;
+EOT
+		$sawnext++;
+	    }
+	    last;
+	}
+
+	if (/^s/) {
+	    $delim = substr($_,1,1);
+	    $len = length($_);
+	    $repl = $end = 0;
+	    $inbracket = 0;
+	    for ($i = 2; $i < $len; $i++) {
+		$c = substr($_,$i,1);
+		if ($c eq $delim) {
+		    if ($inbracket) {
+			substr($_, $i, 0) = '\\';
+			$i++;
+			$len++;
+		    }
+		    else {
+			if ($repl) {
+			    $end = $i;
+			    last;
+			} else {
+			    $repl = $i;
+			}
+		    }
+		}
+		elsif ($c eq '\\') {
+		    $i++;
+		    if ($i >= $len) {
+			$_ .= 'n';
+			$_ .= <>;
+			$len = length($_);
+			$_ = substr($_,0,--$len);
+		    }
+		    elsif (substr($_,$i,1) =~ /^[n]$/) {
+			;
+		    }
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[(){}\w]$/) {
+			$i--;
+			$len--;
+			substr($_, $i, 1) = '';
+		    }
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[<>]$/) {
+			substr($_,$i,1) = 'b';
+		    }
+		    elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
+			substr($_,$i-1,1) = '$';
+		    }
+		}
+		elsif ($c eq '&' && $repl) {
+		    substr($_, $i, 0) = '$';
+		    $i++;
+		    $len++;
+		}
+		elsif ($c eq '$' && $repl) {
+		    substr($_, $i, 0) = '\\';
+		    $i++;
+		    $len++;
+		}
+		elsif ($c eq '[' && !$repl) {
+		    $i++ if substr($_,$i,1) eq '^';
+		    $i++ if substr($_,$i,1) eq ']';
+		    $inbracket = 1;
+		}
+		elsif ($c eq ']') {
+		    $inbracket = 0;
+		}
+		elsif ($c eq "\t") {
+		    substr($_, $i, 1) = '\\t';
+		    $i++;
+		    $len++;
+		}
+		elsif (!$repl && index("()+",$c) >= 0) {
+		    substr($_, $i, 0) = '\\';
+		    $i++;
+		    $len++;
+		}
+	    }
+	    &Die("Malformed substitution at line $.\n")
+	      unless $end;
+	    $pat = substr($_, 0, $repl + 1);
+	    $repl = substr($_, $repl+1, $end-$repl-1);
+	    $end = substr($_, $end + 1, 1000);
+	    &simplify($pat);
+	    $dol = '$';
+	    $subst = "$pat$repl$delim";
+	    $cmd = '';
+	    while ($end) {
+		if ($end =~ s/^g//) {
+		    $subst .= 'g';
+		    next;
+		}
+		if ($end =~ s/^p//) {
+		    $cmd .= ' && (print)';
+		    next;
+		}
+		if ($end =~ s/^w[ \t]*//) {
+		    $fh = &make_filehandle($end);
+		    $cmd .= " && (print $fh \$_)";
+		    $end = '';
+		    next;
+		}
+		&Die("Unrecognized substitution command".
+		  "($end) at line $.\n");
+	    }
+	    chop ($_ = &q(<<"EOT"));
+:	<<--#ifdef TSEEN
+:	$subst && \$tflag++$cmd;
+:	<<--#else
+:	$subst$cmd;
+:	<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^p/) {
+	    $_ = 'print;';
+	    next;
+	}
+
+	if (/^w/) {
+	    s/^w[ \t]*//;
+	    $fh = &make_filehandle($_);
+	    $_ = "print $fh \$_;";
+	    next;
+	}
+
+	if (/^r/) {
+	    $appendseen++;
+	    s/^r[ \t]*//;
+	    $file = $_;
+	    $_ = "\$atext .= `cat $file 2>/dev/null`;";
+	    next;
+	}
+
+	if (/^P/) {
+	    $_ = 'print $1 if /^(.*)/;';
+	    next;
+	}
+
+	if (/^D/) {
+	    chop($_ = &q(<<'EOT'));
+:	s/^.*\n?//;
+:	redo LINE if $_;
+:	next LINE;
+EOT
+	    $sawnext++;
+	    next;
+	}
+
+	if (/^N/) {
+	    chop($_ = &q(<<'EOT'));
+:	$_ .= "\n";
+:	$len1 = length;
+:	$_ .= <>;
+:	chop if $len1 < length;
+:	<<--#ifdef TSEEN
+:	$tflag = 0;
+:	<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^h/) {
+	    $_ = '$hold = $_;';
+	    next;
+	}
+
+	if (/^H/) {
+	    $_ = '$hold .= "\n"; $hold .= $_;';
+	    next;
+	}
+
+	if (/^g/) {
+	    $_ = '$_ = $hold;';
+	    next;
+	}
+
+	if (/^G/) {
+	    $_ = '$_ .= "\n"; $_ .= $hold;';
+	    next;
+	}
+
+	if (/^x/) {
+	    $_ = '($_, $hold) = ($hold, $_);';
+	    next;
+	}
+
+	if (/^b$/) {
+	    $_ = 'next LINE;';
+	    $sawnext++;
+	    next;
+	}
+
+	if (/^b/) {
+	    s/^b[ \t]*//;
+	    $lab = &make_label($_);
+	    if ($lab eq $toplabel) {
+		$_ = 'redo LINE;';
+	    } else {
+		$_ = "goto $lab;";
+	    }
+	    next;
+	}
+
+	if (/^t$/) {
+	    $_ = 'next LINE if $tflag;';
+	    $sawnext++;
+	    $tseen++;
+	    next;
+	}
+
+	if (/^t/) {
+	    s/^t[ \t]*//;
+	    $lab = &make_label($_);
+	    $_ = q/if ($tflag) {$tflag = 0; /;
+	    if ($lab eq $toplabel) {
+		$_ .= 'redo LINE;}';
+	    } else {
+		$_ .= "goto $lab;}";
+	    }
+	    $tseen++;
+	    next;
+	}
+
+	if (/^y/) {
+	    s/abcdefghijklmnopqrstuvwxyz/a-z/g;
+	    s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
+	    s/abcdef/a-f/g;
+	    s/ABCDEF/A-F/g;
+	    s/0123456789/0-9/g;
+	    s/01234567/0-7/g;
+	    $_ .= ';';
+	}
+
+	if (/^=/) {
+	    $_ = 'print $.;';
+	    next;
+	}
+
+	if (/^q/) {
+	    chop($_ = &q(<<'EOT'));
+:	close(ARGV);
+:	@ARGV = ();
+:	next LINE;
+EOT
+	    $sawnext++;
+	    next;
+	}
+    } continue {
+	if ($space) {
+	    s/^/$space/;
+	    s/(\n)(.)/$1$space$2/g;
+	}
+	last;
+    }
+    $_;
+}
+
+sub fetchpat {
+    local($outer) = @_;
+    local($addr) = $outer;
+    local($inbracket);
+    local($prefix,$delim,$ch);
+
+    # Process pattern one potential delimiter at a time.
+
+    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
+	$prefix = $1;
+	$delim = $2;
+	if ($delim eq '\\') {
+	    s/(.)//;
+	    $ch = $1;
+	    $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
+	    $ch = 'b' if $ch =~ /^[<>]$/;
+	    $delim .= $ch;
+	}
+	elsif ($delim eq '[') {
+	    $inbracket = 1;
+	    s/^\^// && ($delim .= '^');
+	    s/^]// && ($delim .= ']');
+	}
+	elsif ($delim eq ']') {
+	    $inbracket = 0;
+	}
+	elsif ($inbracket || $delim ne $outer) {
+	    $delim = '\\' . $delim;
+	}
+	$addr .= $prefix;
+	$addr .= $delim;
+	if ($delim eq $outer && !$inbracket) {
+	    last DELIM;
+	}
+    }
+    $addr =~ s/\t/\\t/g;
+    &simplify($addr);
+    $addr;
+}
+
+sub q {
+    local($string) = @_;
+    local($*) = 1;
+    $string =~ s/^:\t?//g;
+    $string;
+}
+
+sub simplify {
+    $_[0] =~ s/_a-za-z0-9/\\w/ig;
+    $_[0] =~ s/a-z_a-z0-9/\\w/ig;
+    $_[0] =~ s/a-za-z_0-9/\\w/ig;
+    $_[0] =~ s/a-za-z0-9_/\\w/ig;
+    $_[0] =~ s/_0-9a-za-z/\\w/ig;
+    $_[0] =~ s/0-9_a-za-z/\\w/ig;
+    $_[0] =~ s/0-9a-z_a-z/\\w/ig;
+    $_[0] =~ s/0-9a-za-z_/\\w/ig;
+    $_[0] =~ s/\[\\w\]/\\w/g;
+    $_[0] =~ s/\[^\\w\]/\\W/g;
+    $_[0] =~ s/\[0-9\]/\\d/g;
+    $_[0] =~ s/\[^0-9\]/\\D/g;
+    $_[0] =~ s/\\d\\d\*/\\d+/g;
+    $_[0] =~ s/\\D\\D\*/\\D+/g;
+    $_[0] =~ s/\\w\\w\*/\\w+/g;
+    $_[0] =~ s/\\t\\t\*/\\t+/g;
+    $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
+    $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
+}
+
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/gnu/usr.bin/perl/x2p/s2p.man b/gnu/usr.bin/perl/x2p/s2p.man
new file mode 100644
index 00000000000..afe5ac8ba3a
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/s2p.man
@@ -0,0 +1,96 @@
+.rn '' }`
+''' $RCSfile: s2p.man,v $$Revision: 1.1.1.1 $$Date: 1996/08/19 10:13:36 $
+''' 
+''' $Log: s2p.man,v $
+''' Revision 1.1.1.1  1996/08/19 10:13:36  downsj
+''' Import of Perl 5.003 into the tree.  Makefile.bsd-wrapper and
+''' config.sh.OpenBSD are the only local changes.
+'''
+.de Sh
+.br
+.ne 5
+.PP
+\fB\\$1\fR
+.PP
+..
+.de Sp
+.if t .sp .5v
+.if n .sp
+..
+.de Ip
+.br
+.ie \\n.$>=3 .ne \\$3
+.el .ne 3
+.IP "\\$1" \\$2
+..
+'''
+'''     Set up \*(-- to give an unbreakable dash;
+'''     string Tr holds user defined translation string.
+'''     Bell System Logo is used as a dummy character.
+'''
+.tr \(*W-|\(bv\*(Tr
+.ie n \{\
+.ds -- \(*W-
+.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
+.ds L" ""
+.ds R" ""
+.ds L' '
+.ds R' '
+'br\}
+.el\{\
+.ds -- \(em\|
+.tr \*(Tr
+.ds L" ``
+.ds R" ''
+.ds L' `
+.ds R' '
+'br\}
+.TH S2P 1 NEW
+.SH NAME
+s2p - Sed to Perl translator
+.SH SYNOPSIS
+.B s2p [options] filename
+.SH DESCRIPTION
+.I S2p
+takes a sed script specified on the command line (or from standard input)
+and produces a comparable
+.I perl
+script on the standard output.
+.Sh "Options"
+Options include:
+.TP 5
+.B \-D<number>
+sets debugging flags.
+.TP 5
+.B \-n
+specifies that this sed script was always invoked with a sed -n.
+Otherwise a switch parser is prepended to the front of the script.
+.TP 5
+.B \-p
+specifies that this sed script was never invoked with a sed -n.
+Otherwise a switch parser is prepended to the front of the script.
+.Sh "Considerations"
+The perl script produced looks very sed-ish, and there may very well be
+better ways to express what you want to do in perl.
+For instance, s2p does not make any use of the split operator, but you might
+want to.
+.PP
+The perl script you end up with may be either faster or slower than the original
+sed script.
+If you're only interested in speed you'll just have to try it both ways.
+Of course, if you want to do something sed doesn't do, you have no choice.
+It's often possible to speed up the perl script by various methods, such
+as deleting all references to $\e and chop.
+.SH ENVIRONMENT
+S2p uses no environment variables.
+.SH AUTHOR
+Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
+.SH FILES
+.SH SEE ALSO
+perl	The perl compiler/interpreter
+.br
+a2p	awk to perl translator
+.SH DIAGNOSTICS
+.SH BUGS
+.rn }` ''
diff --git a/gnu/usr.bin/perl/x2p/str.c b/gnu/usr.bin/perl/x2p/str.c
new file mode 100644
index 00000000000..e9dd34400f0
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/str.c
@@ -0,0 +1,468 @@
+/* $RCSfile: str.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:26 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	str.c,v $
+ */
+
+#include "EXTERN.h"
+#include "a2p.h"
+#include "util.h"
+
+void
+str_numset(str,num)
+register STR *str;
+double num;
+{
+    str->str_nval = num;
+    str->str_pok = 0;		/* invalidate pointer */
+    str->str_nok = 1;		/* validate number */
+}
+
+char *
+str_2ptr(str)
+register STR *str;
+{
+    register char *s;
+
+    if (!str)
+	return "";
+    GROWSTR(&(str->str_ptr), &(str->str_len), 24);
+    s = str->str_ptr;
+    if (str->str_nok) {
+	sprintf(s,"%.20g",str->str_nval);
+	while (*s) s++;
+    }
+    *s = '\0';
+    str->str_cur = s - str->str_ptr;
+    str->str_pok = 1;
+#ifdef DEBUGGING
+    if (debug & 32)
+	fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
+#endif
+    return str->str_ptr;
+}
+
+double
+str_2num(str)
+register STR *str;
+{
+    if (!str)
+	return 0.0;
+    if (str->str_len && str->str_pok)
+	str->str_nval = atof(str->str_ptr);
+    else
+	str->str_nval = 0.0;
+    str->str_nok = 1;
+#ifdef DEBUGGING
+    if (debug & 32)
+	fprintf(stderr,"0x%lx num(%g)\n",str,str->str_nval);
+#endif
+    return str->str_nval;
+}
+
+void
+str_sset(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+    if (!sstr)
+	str_nset(dstr,No,0);
+    else if (sstr->str_nok)
+	str_numset(dstr,sstr->str_nval);
+    else if (sstr->str_pok)
+	str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+    else
+	str_nset(dstr,"",0);
+}
+
+void
+str_nset(str,ptr,len)
+register STR *str;
+register char *ptr;
+register int len;
+{
+    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
+    bcopy(ptr,str->str_ptr,len);
+    str->str_cur = len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+}
+
+void
+str_set(str,ptr)
+register STR *str;
+register char *ptr;
+{
+    register int len;
+
+    if (!ptr)
+	ptr = "";
+    len = strlen(ptr);
+    GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
+    bcopy(ptr,str->str_ptr,len+1);
+    str->str_cur = len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+}
+
+void
+str_chop(str,ptr)	/* like set but assuming ptr is in str */
+register STR *str;
+register char *ptr;
+{
+    if (!(str->str_pok))
+	str_2ptr(str);
+    str->str_cur -= (ptr - str->str_ptr);
+    bcopy(ptr,str->str_ptr, str->str_cur + 1);
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+}
+
+void
+str_ncat(str,ptr,len)
+register STR *str;
+register char *ptr;
+register int len;
+{
+    if (!(str->str_pok))
+	str_2ptr(str);
+    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
+    bcopy(ptr,str->str_ptr+str->str_cur,len);
+    str->str_cur += len;
+    *(str->str_ptr+str->str_cur) = '\0';
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+}
+
+void
+str_scat(dstr,sstr)
+STR *dstr;
+register STR *sstr;
+{
+    if (!(sstr->str_pok))
+	str_2ptr(sstr);
+    if (sstr)
+	str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
+}
+
+void
+str_cat(str,ptr)
+register STR *str;
+register char *ptr;
+{
+    register int len;
+
+    if (!ptr)
+	return;
+    if (!(str->str_pok))
+	str_2ptr(str);
+    len = strlen(ptr);
+    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
+    bcopy(ptr,str->str_ptr+str->str_cur,len+1);
+    str->str_cur += len;
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+}
+
+char *
+str_append_till(str,from,delim,keeplist)
+register STR *str;
+register char *from;
+register int delim;
+char *keeplist;
+{
+    register char *to;
+    register int len;
+
+    if (!from)
+	return Nullch;
+    len = strlen(from);
+    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + len + 1);
+    str->str_nok = 0;		/* invalidate number */
+    str->str_pok = 1;		/* validate pointer */
+    to = str->str_ptr+str->str_cur;
+    for (; *from; from++,to++) {
+	if (*from == '\\' && from[1] && delim != '\\') {
+	    if (!keeplist) {
+		if (from[1] == delim || from[1] == '\\')
+		    from++;
+		else
+		    *to++ = *from++;
+	    }
+	    else if (strchr(keeplist,from[1]))
+		*to++ = *from++;
+	    else
+		from++;
+	}
+	else if (*from == delim)
+	    break;
+	*to = *from;
+    }
+    *to = '\0';
+    str->str_cur = to - str->str_ptr;
+    return from;
+}
+
+STR *
+str_new(len)
+int len;
+{
+    register STR *str;
+    
+    if (freestrroot) {
+	str = freestrroot;
+	freestrroot = str->str_link.str_next;
+    }
+    else {
+	str = (STR *) safemalloc(sizeof(STR));
+	bzero((char*)str,sizeof(STR));
+    }
+    if (len)
+	GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
+    return str;
+}
+
+void
+str_grow(str,len)
+register STR *str;
+int len;
+{
+    if (len && str)
+	GROWSTR(&(str->str_ptr), &(str->str_len), len + 1);
+}
+
+/* make str point to what nstr did */
+
+void
+str_replace(str,nstr)
+register STR *str;
+register STR *nstr;
+{
+    Safefree(str->str_ptr);
+    str->str_ptr = nstr->str_ptr;
+    str->str_len = nstr->str_len;
+    str->str_cur = nstr->str_cur;
+    str->str_pok = nstr->str_pok;
+    if (str->str_nok = nstr->str_nok)
+	str->str_nval = nstr->str_nval;
+    safefree((char*)nstr);
+}
+
+void
+str_free(str)
+register STR *str;
+{
+    if (!str)
+	return;
+    if (str->str_len)
+	str->str_ptr[0] = '\0';
+    str->str_cur = 0;
+    str->str_nok = 0;
+    str->str_pok = 0;
+    str->str_link.str_next = freestrroot;
+    freestrroot = str;
+}
+
+int
+str_len(str)
+register STR *str;
+{
+    if (!str)
+	return 0;
+    if (!(str->str_pok))
+	str_2ptr(str);
+    if (str->str_len)
+	return str->str_cur;
+    else
+	return 0;
+}
+
+char *
+str_gets(str,fp)
+register STR *str;
+register FILE *fp;
+{
+#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
+    /* Here is some breathtakingly efficient cheating */
+
+    register char *bp;		/* we're going to steal some values */
+    register int cnt;		/*  from the stdio struct and put EVERYTHING */
+    register STDCHAR *ptr;	/*   in the innermost loop into registers */
+    register char newline = '\n';	/* (assuming at least 6 registers) */
+    int i;
+    int bpx;
+
+    cnt = FILE_cnt(fp);			/* get count into register */
+    str->str_nok = 0;			/* invalidate number */
+    str->str_pok = 1;			/* validate pointer */
+    if (str->str_len <= cnt)		/* make sure we have the room */
+	GROWSTR(&(str->str_ptr), &(str->str_len), cnt+1);
+    bp = str->str_ptr;			/* move these two too to registers */
+    ptr = FILE_ptr(fp);
+    for (;;) {
+	while (--cnt >= 0) {
+	    if ((*bp++ = *ptr++) == newline)
+		if (bp <= str->str_ptr || bp[-2] != '\\')
+		    goto thats_all_folks;
+		else {
+		    line++;
+		    bp -= 2;
+		}
+	}
+	
+	FILE_cnt(fp) = cnt;		/* deregisterize cnt and ptr */
+	FILE_ptr(fp) = ptr;
+	i = _filbuf(fp);		/* get more characters */
+	cnt = FILE_cnt(fp);
+	ptr = FILE_ptr(fp);		/* reregisterize cnt and ptr */
+
+	bpx = bp - str->str_ptr;	/* prepare for possible relocation */
+	GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + cnt + 1);
+	bp = str->str_ptr + bpx;	/* reconstitute our pointer */
+
+	if (i == newline) {		/* all done for now? */
+	    *bp++ = i;
+	    goto thats_all_folks;
+	}
+	else if (i == EOF)		/* all done for ever? */
+	    goto thats_all_folks;
+	*bp++ = i;			/* now go back to screaming loop */
+    }
+
+thats_all_folks:
+    FILE_cnt(fp) = cnt;			/* put these back or we're in trouble */
+    FILE_ptr(fp) = ptr;
+    *bp = '\0';
+    str->str_cur = bp - str->str_ptr;	/* set length */
+
+#else /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+    /* The big, slow, and stupid way */
+
+    static char buf[4192];
+
+    if (fgets(buf, sizeof buf, fp) != Nullch)
+	str_set(str, buf);
+    else
+	str_set(str, No);
+
+#endif /* USE_STDIO_PTR && STDIO_PTR_LVALUE && STDIO_CNT_LVALUE */
+
+    return str->str_cur ? str->str_ptr : Nullch;
+}
+
+void
+str_inc(str)
+register STR *str;
+{
+    register char *d;
+
+    if (!str)
+	return;
+    if (str->str_nok) {
+	str->str_nval += 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok) {
+	str->str_nval = 1.0;
+	str->str_nok = 1;
+	return;
+    }
+    for (d = str->str_ptr; *d && *d != '.'; d++) ;
+    d--;
+    if (!isdigit(*str->str_ptr) || !isdigit(*d) ) {
+        str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
+	return;
+    }
+    while (d >= str->str_ptr) {
+	if (++*d <= '9')
+	    return;
+	*(d--) = '0';
+    }
+    /* oh,oh, the number grew */
+    GROWSTR(&(str->str_ptr), &(str->str_len), str->str_cur + 2);
+    str->str_cur++;
+    for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
+	*d = d[-1];
+    *d = '1';
+}
+
+void
+str_dec(str)
+register STR *str;
+{
+    register char *d;
+
+    if (!str)
+	return;
+    if (str->str_nok) {
+	str->str_nval -= 1.0;
+	str->str_pok = 0;
+	return;
+    }
+    if (!str->str_pok) {
+	str->str_nval = -1.0;
+	str->str_nok = 1;
+	return;
+    }
+    for (d = str->str_ptr; *d && *d != '.'; d++) ;
+    d--;
+    if (!isdigit(*str->str_ptr) || !isdigit(*d) || (*d == '0' && d == str->str_ptr)) {
+        str_numset(str,atof(str->str_ptr) - 1.0);  /* punt */
+	return;
+    }
+    while (d >= str->str_ptr) {
+	if (--*d >= '0')
+	    return;
+	*(d--) = '9';
+    }
+}
+
+/* make a string that will exist for the duration of the expression eval */
+
+STR *
+str_mortal(oldstr)
+STR *oldstr;
+{
+    register STR *str = str_new(0);
+    static long tmps_size = -1;
+
+    str_sset(str,oldstr);
+    if (++tmps_max > tmps_size) {
+	tmps_size = tmps_max;
+	if (!(tmps_size & 127)) {
+	    if (tmps_size)
+		tmps_list = (STR**)saferealloc((char*)tmps_list,
+		    (tmps_size + 128) * sizeof(STR*) );
+	    else
+		tmps_list = (STR**)safemalloc(128 * sizeof(char*));
+	}
+    }
+    tmps_list[tmps_max] = str;
+    return str;
+}
+
+STR *
+str_make(s)
+char *s;
+{
+    register STR *str = str_new(0);
+
+    str_set(str,s);
+    return str;
+}
+
+STR *
+str_nmake(n)
+double n;
+{
+    register STR *str = str_new(0);
+
+    str_numset(str,n);
+    return str;
+}
diff --git a/gnu/usr.bin/perl/x2p/str.h b/gnu/usr.bin/perl/x2p/str.h
new file mode 100644
index 00000000000..9d495ab0bad
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/str.h
@@ -0,0 +1,53 @@
+/* $RCSfile: str.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:27 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	str.h,v $
+ */
+
+struct string {
+    char *	str_ptr;	/* pointer to malloced string */
+    double	str_nval;	/* numeric value, if any */
+    int		str_len;	/* allocated size */
+    int		str_cur;	/* length of str_ptr as a C string */
+    union {
+	STR *str_next;		/* while free, link to next free str */
+    } str_link;
+    char	str_pok;	/* state of str_ptr */
+    char	str_nok;	/* state of str_nval */
+};
+
+#define Nullstr Null(STR*)
+
+/* the following macro updates any magic values this str is associated with */
+
+#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
+
+EXT STR **tmps_list;
+EXT long tmps_max INIT(-1);
+
+double str_2num _(( STR *str ));
+char * str_2ptr _(( STR *str ));
+char * str_append_till _(( STR *str, char *from, int delim, char *keeplist ));
+void str_cat _(( STR *str, char *ptr ));
+void str_chop _(( STR *str, char *ptr ));
+void str_dec _(( STR *str ));
+void str_free _(( STR *str ));
+char * str_gets _(( STR *str, FILE *fp ));
+void str_grow _(( STR *str, int len ));
+void str_inc _(( STR *str ));
+int str_len _(( STR *str ));
+STR * str_make _(( char *s ));
+STR * str_mortal _(( STR *oldstr ));
+void str_ncat _(( STR *str, char *ptr, int len ));
+STR * str_new _(( int len ));
+STR * str_nmake _(( double n ));
+void str_nset _(( STR *str, char *ptr, int len ));
+void str_numset _(( STR *str, double num ));
+void str_replace _(( STR *str, STR *nstr ));
+void str_scat _(( STR *dstr, STR *sstr ));
+void str_set _(( STR *str, char *ptr ));
+void str_sset _(( STR *dstr, STR *sstr ));
diff --git a/gnu/usr.bin/perl/x2p/util.c b/gnu/usr.bin/perl/x2p/util.c
new file mode 100644
index 00000000000..5c3554b7e3e
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/util.c
@@ -0,0 +1,220 @@
+/* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:29 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	util.c,v $
+ */
+
+#include "EXTERN.h"
+#include "a2p.h"
+#include "INTERN.h"
+#include "util.h"
+
+#define FLUSH
+
+static char nomem[] = "Out of memory!\n";
+
+/* paranoid version of malloc */
+
+
+Malloc_t
+safemalloc(size)
+MEM_SIZE size;
+{
+    char *ptr;
+    Malloc_t malloc();
+
+    ptr = (char *) malloc(size?size:1);	/* malloc(0) is NASTY on our system */
+#ifdef DEBUGGING
+    if (debug & 128)
+	fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
+#endif
+    if (ptr != Nullch)
+	return ptr;
+    else {
+	fputs(nomem,stdout) FLUSH;
+	exit(1);
+    }
+    /*NOTREACHED*/
+}
+
+/* paranoid version of realloc */
+
+Malloc_t
+saferealloc(where,size)
+char *where;
+MEM_SIZE size;
+{
+    char *ptr;
+    Malloc_t realloc();
+
+    ptr = (char *)
+		realloc(where,size?size:1);	/* realloc(0) is NASTY on our system */
+#ifdef DEBUGGING
+    if (debug & 128) {
+	fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
+	fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
+    }
+#endif
+    if (ptr != Nullch)
+	return ptr;
+    else {
+	fputs(nomem,stdout) FLUSH;
+	exit(1);
+    }
+    /*NOTREACHED*/
+}
+
+/* safe version of free */
+
+void
+safefree(where)
+char *where;
+{
+#ifdef DEBUGGING
+    if (debug & 128)
+	fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
+#endif
+    free(where);
+}
+
+/* safe version of string copy */
+
+char *
+safecpy(to,from,len)
+char *to;
+register char *from;
+register int len;
+{
+    register char *dest = to;
+
+    if (from != Nullch) 
+	for (len--; len && (*dest++ = *from++); len--) ;
+    *dest = '\0';
+    return to;
+}
+
+/* copy a string up to some (non-backslashed) delimiter, if any */
+
+char *
+cpytill(to,from,delim)
+register char *to, *from;
+register int delim;
+{
+    for (; *from; from++,to++) {
+	if (*from == '\\') {
+	    if (from[1] == delim)
+		from++;
+	    else if (from[1] == '\\')
+		*to++ = *from++;
+	}
+	else if (*from == delim)
+	    break;
+	*to = *from;
+    }
+    *to = '\0';
+    return from;
+}
+
+
+char *
+cpy2(to,from,delim)
+register char *to, *from;
+register int delim;
+{
+    for (; *from; from++,to++) {
+	if (*from == '\\')
+	    *to++ = *from++;
+	else if (*from == '$')
+	    *to++ = '\\';
+	else if (*from == delim)
+	    break;
+	*to = *from;
+    }
+    *to = '\0';
+    return from;
+}
+
+/* return ptr to little string in big string, NULL if not found */
+
+char *
+instr(big, little)
+char *big, *little;
+
+{
+    register char *t, *s, *x;
+
+    for (t = big; *t; t++) {
+	for (x=t,s=little; *s; x++,s++) {
+	    if (!*x)
+		return Nullch;
+	    if (*s != *x)
+		break;
+	}
+	if (!*s)
+	    return t;
+    }
+    return Nullch;
+}
+
+/* copy a string to a safe spot */
+
+char *
+savestr(str)
+char *str;
+{
+    register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
+
+    (void)strcpy(newaddr,str);
+    return newaddr;
+}
+
+/* grow a static string to at least a certain length */
+
+void
+growstr(strptr,curlen,newlen)
+char **strptr;
+int *curlen;
+int newlen;
+{
+    if (newlen > *curlen) {		/* need more room? */
+	if (*curlen)
+	    *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
+	else
+	    *strptr = safemalloc((MEM_SIZE)newlen);
+	*curlen = newlen;
+    }
+}
+
+/*VARARGS1*/
+void
+croak(pat,a1,a2,a3,a4)
+char *pat;
+int a1,a2,a3,a4;
+{
+    fprintf(stderr,pat,a1,a2,a3,a4);
+    exit(1);
+}
+
+/*VARARGS1*/
+void
+fatal(pat,a1,a2,a3,a4)
+char *pat;
+int a1,a2,a3,a4;
+{
+    fprintf(stderr,pat,a1,a2,a3,a4);
+    exit(1);
+}
+
+/*VARARGS1*/
+void
+warn(pat,a1,a2,a3,a4)
+char *pat;
+int a1,a2,a3,a4;
+{
+    fprintf(stderr,pat,a1,a2,a3,a4);
+}
+
diff --git a/gnu/usr.bin/perl/x2p/util.h b/gnu/usr.bin/perl/x2p/util.h
new file mode 100644
index 00000000000..35f796121c1
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/util.h
@@ -0,0 +1,33 @@
+/* $RCSfile: util.h,v $$Revision: 4.1 $$Date: 92/08/07 18:29:30 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	util.h,v $
+ */
+
+/* is the string for makedir a directory name or a filename? */
+
+#define fatal Myfatal
+
+#define MD_DIR 0
+#define MD_FILE 1
+
+#ifdef SETUIDGID
+    int		eaccess();
+#endif
+
+char	*getwd();
+int	makedir();
+
+char * cpy2 _(( char *to, char *from, int delim ));
+char * cpytill _(( char *to, char *from, int delim ));
+void croak _(( char *pat, int a1, int a2, int a3, int a4 ));
+void growstr _(( char **strptr, int *curlen, int newlen ));
+char * instr _(( char *big, char *little ));
+void Myfatal ();
+char * safecpy _(( char *to, char *from, int len ));
+char * savestr _(( char *str ));
+void warn ();
diff --git a/gnu/usr.bin/perl/x2p/walk.c b/gnu/usr.bin/perl/x2p/walk.c
new file mode 100644
index 00000000000..403d686e391
--- /dev/null
+++ b/gnu/usr.bin/perl/x2p/walk.c
@@ -0,0 +1,2078 @@
+/* $RCSfile: walk.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:31 $
+ *
+ *    Copyright (c) 1991, 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.
+ *
+ * $Log:	walk.c,v $
+ */
+
+#include "EXTERN.h"
+#include "a2p.h"
+#include "util.h"
+
+bool exitval = FALSE;
+bool realexit = FALSE;
+bool saw_getline = FALSE;
+bool subretnum = FALSE;
+bool saw_FNR = FALSE;
+bool saw_argv0 = FALSE;
+bool saw_fh = FALSE;
+int maxtmp = 0;
+char *lparen;
+char *rparen;
+char *limit;
+STR *subs;
+STR *curargs = Nullstr;
+
+static void addsemi _(( STR *str ));
+static void emit_split _(( STR *str, int level ));
+static void fixtab _(( STR *str, int lvl ));
+static void numericize _(( int node ));
+static void tab _(( STR *str, int lvl ));
+
+int prewalk _(( int numit, int level, int node, int *numericptr ));
+STR * walk _(( int useval, int level, int node, int *numericptr, int minprec ));
+
+
+STR *
+walk(useval,level,node,numericptr,minprec)
+int useval;
+int level;
+register int node;
+int *numericptr;
+int minprec;			/* minimum precedence without parens */
+{
+    register int len;
+    register STR *str;
+    register int type;
+    register int i;
+    register STR *tmpstr;
+    STR *tmp2str;
+    STR *tmp3str;
+    char *t;
+    char *d, *s;
+    int numarg;
+    int numeric = FALSE;
+    STR *fstr;
+    int prec = P_MAX;		/* assume no parens needed */
+
+    if (!node) {
+	*numericptr = 0;
+	return str_make("");
+    }
+    type = ops[node].ival;
+    len = type >> 8;
+    type &= 255;
+    switch (type) {
+    case OPROG:
+	arymax = 0;
+	if (namelist) {
+	    while (isalpha(*namelist)) {
+		for (d = tokenbuf,s=namelist;
+		  isalpha(*s) || isdigit(*s) || *s == '_';
+		  *d++ = *s++) ;
+		*d = '\0';
+		while (*s && !isalpha(*s)) s++;
+		namelist = s;
+		nameary[++arymax] = savestr(tokenbuf);
+	    }
+	}
+	if (maxfld < arymax)
+	    maxfld = arymax;
+	opens = str_new(0);
+	subs = str_new(0);
+	str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	if (do_split && need_entire && !absmaxfld)
+	    split_to_array = TRUE;
+	if (do_split && split_to_array)
+	    set_array_base = TRUE;
+	if (set_array_base) {
+	    str_cat(str,"$[ = 1;\t\t\t# set array base to 1\n");
+	}
+	if (fswitch && !const_FS)
+	    const_FS = fswitch;
+	if (saw_FS > 1 || saw_RS)
+	    const_FS = 0;
+	if (saw_ORS && need_entire)
+	    do_chop = TRUE;
+	if (fswitch) {
+	    str_cat(str,"$FS = '");
+	    if (strchr("*+?.[]()|^$\\",fswitch))
+		str_cat(str,"\\");
+	    sprintf(tokenbuf,"%c",fswitch);
+	    str_cat(str,tokenbuf);
+	    str_cat(str,"';\t\t# field separator from -F switch\n");
+	}
+	else if (saw_FS && !const_FS) {
+	    str_cat(str,"$FS = ' ';\t\t# set field separator\n");
+	}
+	if (saw_OFS) {
+	    str_cat(str,"$, = ' ';\t\t# set output field separator\n");
+	}
+	if (saw_ORS) {
+	    str_cat(str,"$\\ = \"\\n\";\t\t# set output record separator\n");
+	}
+	if (saw_argv0) {
+	    str_cat(str,"$ARGV0 = $0;\t\t# remember what we ran as\n");
+	}
+	if (str->str_cur > 20)
+	    str_cat(str,"\n");
+	if (ops[node+2].ival) {
+	    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    str_cat(str,"\n\n");
+	}
+	fstr = walk(0,level+1,ops[node+3].ival,&numarg,P_MIN);
+	if (*fstr->str_ptr) {
+	    if (saw_line_op)
+		str_cat(str,"line: ");
+	    str_cat(str,"while (<>) {\n");
+	    tab(str,++level);
+	    if (saw_FS && !const_FS)
+		do_chop = TRUE;
+	    if (do_chop) {
+		str_cat(str,"chop;\t# strip record separator\n");
+		tab(str,level);
+	    }
+	    if (do_split)
+		emit_split(str,level);
+	    str_scat(str,fstr);
+	    str_free(fstr);
+	    fixtab(str,--level);
+	    str_cat(str,"}\n");
+	    if (saw_FNR)
+		str_cat(str,"continue {\n    $FNRbase = $. if eof;\n}\n");
+	}
+	else
+	    str_cat(str,"while (<>) { }		# (no line actions)\n");
+	if (ops[node+4].ival) {
+	    realexit = TRUE;
+	    str_cat(str,"\n");
+	    tab(str,level);
+	    str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    str_cat(str,"\n");
+	}
+	if (exitval)
+	    str_cat(str,"exit $ExitValue;\n");
+	if (subs->str_ptr) {
+	    str_cat(str,"\n");
+	    str_scat(str,subs);
+	}
+	if (saw_getline) {
+	    for (len = 0; len < 4; len++) {
+		if (saw_getline & (1 << len)) {
+		    sprintf(tokenbuf,"\nsub Getline%d {\n",len);
+		    str_cat(str, tokenbuf);
+		    if (len & 2) {
+			if (do_fancy_opens)
+			    str_cat(str,"    &Pick('',@_);\n");
+			else
+			    str_cat(str,"    ($fh) = @_;\n");
+		    }
+		    else {
+			if (saw_FNR)
+			    str_cat(str,"    $FNRbase = $. if eof;\n");
+		    }
+		    if (len & 1)
+			str_cat(str,"    local($_);\n");
+		    if (len & 2)
+			str_cat(str,
+			  "    if ($getline_ok = (($_ = <$fh>) ne ''))");
+		    else
+			str_cat(str,
+			  "    if ($getline_ok = (($_ = <>) ne ''))");
+		    str_cat(str, " {\n");
+		    level += 2;
+		    tab(str,level);
+		    i = 0;
+		    if (do_chop) {
+			i++;
+			str_cat(str,"chop;\t# strip record separator\n");
+			tab(str,level);
+		    }
+		    if (do_split && !(len & 1)) {
+			i++;
+			emit_split(str,level);
+		    }
+		    if (!i)
+			str_cat(str,";\n");
+		    fixtab(str,--level);
+		    str_cat(str,"}\n    $_;\n}\n");
+		    --level;
+		}
+	    }
+	}
+	if (do_fancy_opens) {
+	    str_cat(str,"\n\
+sub Pick {\n\
+    local($mode,$name,$pipe) = @_;\n\
+    $fh = $name;\n\
+    open($name,$mode.$name.$pipe) unless $opened{$name}++;\n\
+}\n\
+");
+	}
+	break;
+    case OHUNKS:
+	str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	if (len == 3) {
+	    str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	}
+	else {
+	}
+	break;
+    case ORANGE:
+	prec = P_DOTDOT;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec+1);
+	str_cat(str," .. ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OPAT:
+	goto def;
+    case OREGEX:
+	str = str_new(0);
+	str_set(str,"/");
+	tmpstr=walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	/* translate \nnn to [\nnn] */
+	for (s = tmpstr->str_ptr, d = tokenbuf; *s; s++, d++) {
+	    if (*s == '\\' && isdigit(s[1]) && isdigit(s[2]) && isdigit(s[3])){
+		*d++ = '[';
+		*d++ = *s++;
+		*d++ = *s++;
+		*d++ = *s++;
+		*d++ = *s;
+		*d = ']';
+	    }
+	    else
+		*d = *s;
+	}
+	*d = '\0';
+	for (d=tokenbuf; *d; d++)
+	    *d += 128;
+	str_cat(str,tokenbuf);
+	str_free(tmpstr);
+	str_cat(str,"/");
+	break;
+    case OHUNK:
+	if (len == 1) {
+	    str = str_new(0);
+	    str = walk(0,level,oper1(OPRINT,0),&numarg,P_MIN);
+	    str_cat(str," if ");
+	    str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    str_cat(str,";");
+	}
+	else {
+	    tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	    if (*tmpstr->str_ptr) {
+		str = str_new(0);
+		str_set(str,"if (");
+		str_scat(str,tmpstr);
+		str_cat(str,") {\n");
+		tab(str,++level);
+		str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+		str_free(fstr);
+		fixtab(str,--level);
+		str_cat(str,"}\n");
+		tab(str,level);
+	    }
+	    else {
+		str = walk(0,level,ops[node+2].ival,&numarg,P_MIN);
+	    }
+	}
+	break;
+    case OPPAREN:
+	str = str_new(0);
+	str_set(str,"(");
+	str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,")");
+	break;
+    case OPANDAND:
+	prec = P_ANDAND;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," && ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OPOROR:
+	prec = P_OROR;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," || ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OPNOT:
+	prec = P_UNARY;
+	str = str_new(0);
+	str_set(str,"!");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec));
+	str_free(fstr);
+	break;
+    case OCOND:
+	prec = P_COND;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," ? ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	str_cat(str," : ");
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OCPAREN:
+	str = str_new(0);
+	str_set(str,"(");
+	str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	numeric |= numarg;
+	str_cat(str,")");
+	break;
+    case OCANDAND:
+	prec = P_ANDAND;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	numeric = 1;
+	str_cat(str," && ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OCOROR:
+	prec = P_OROR;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	numeric = 1;
+	str_cat(str," || ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OCNOT:
+	prec = P_UNARY;
+	str = str_new(0);
+	str_set(str,"!");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case ORELOP:
+	prec = P_REL;
+	str = walk(1,level,ops[node+2].ival,&numarg,prec+1);
+	numeric |= numarg;
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	tmp2str = walk(1,level,ops[node+3].ival,&numarg,prec+1);
+	numeric |= numarg;
+	if (!numeric ||
+	 (!numarg && (*tmp2str->str_ptr == '"' || *tmp2str->str_ptr == '\''))) {
+	    t = tmpstr->str_ptr;
+	    if (strEQ(t,"=="))
+		str_set(tmpstr,"eq");
+	    else if (strEQ(t,"!="))
+		str_set(tmpstr,"ne");
+	    else if (strEQ(t,"<"))
+		str_set(tmpstr,"lt");
+	    else if (strEQ(t,"<="))
+		str_set(tmpstr,"le");
+	    else if (strEQ(t,">"))
+		str_set(tmpstr,"gt");
+	    else if (strEQ(t,">="))
+		str_set(tmpstr,"ge");
+	    if (!strchr(tmpstr->str_ptr,'\'') && !strchr(tmpstr->str_ptr,'"') &&
+	      !strchr(tmp2str->str_ptr,'\'') && !strchr(tmp2str->str_ptr,'"') )
+		numeric |= 2;
+	}
+	if (numeric & 2) {
+	    if (numeric & 1)		/* numeric is very good guess */
+		str_cat(str," ");
+	    else
+		str_cat(str,"\377");
+	    numeric = 1;
+	}
+	else
+	    str_cat(str," ");
+	str_scat(str,tmpstr);
+	str_free(tmpstr);
+	str_cat(str," ");
+	str_scat(str,tmp2str);
+	str_free(tmp2str);
+	numeric = 1;
+	break;
+    case ORPAREN:
+	str = str_new(0);
+	str_set(str,"(");
+	str_scat(str,fstr=walk(useval != 0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	numeric |= numarg;
+	str_cat(str,")");
+	break;
+    case OMATCHOP:
+	prec = P_MATCH;
+	str = walk(1,level,ops[node+2].ival,&numarg,prec+1);
+	str_cat(str," ");
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	if (strEQ(tmpstr->str_ptr,"~"))
+	    str_cat(str,"=~");
+	else {
+	    str_scat(str,tmpstr);
+	    str_free(tmpstr);
+	}
+	str_cat(str," ");
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OMPAREN:
+	str = str_new(0);
+	str_set(str,"(");
+	str_scat(str,
+	  fstr=walk(useval != 0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	numeric |= numarg;
+	str_cat(str,")");
+	break;
+    case OCONCAT:
+	prec = P_ADD;
+	type = ops[ops[node+1].ival].ival & 255;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec+(type != OCONCAT));
+	str_cat(str," . ");
+	type = ops[ops[node+2].ival].ival & 255;
+	str_scat(str,
+	  fstr=walk(1,level,ops[node+2].ival,&numarg,prec+(type != OCONCAT)));
+	str_free(fstr);
+	break;
+    case OASSIGN:
+	prec = P_ASSIGN;
+	str = walk(0,level,ops[node+2].ival,&numarg,prec+1);
+	str_cat(str," ");
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	str_scat(str,tmpstr);
+	if (str_len(tmpstr) > 1)
+	    numeric = 1;
+	str_free(tmpstr);
+	str_cat(str," ");
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec));
+	str_free(fstr);
+	numeric |= numarg;
+	if (strEQ(str->str_ptr,"$/ = ''"))
+	    str_set(str, "$/ = \"\\n\\n\"");
+	break;
+    case OADD:
+	prec = P_ADD;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," + ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OSUBTRACT:
+	prec = P_ADD;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," - ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OMULT:
+	prec = P_MUL;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," * ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case ODIV:
+	prec = P_MUL;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," / ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OPOW:
+	prec = P_POW;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec+1);
+	str_cat(str," ** ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OMOD:
+	prec = P_MUL;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str," % ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OPOSTINCR:
+	prec = P_AUTO;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec+1);
+	str_cat(str,"++");
+	numeric = 1;
+	break;
+    case OPOSTDECR:
+	prec = P_AUTO;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec+1);
+	str_cat(str,"--");
+	numeric = 1;
+	break;
+    case OPREINCR:
+	prec = P_AUTO;
+	str = str_new(0);
+	str_set(str,"++");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OPREDECR:
+	prec = P_AUTO;
+	str = str_new(0);
+	str_set(str,"--");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec+1));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OUMINUS:
+	prec = P_UNARY;
+	str = str_new(0);
+	str_set(str,"-");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec));
+	str_free(fstr);
+	numeric = 1;
+	break;
+    case OUPLUS:
+	numeric = 1;
+	goto def;
+    case OPAREN:
+	str = str_new(0);
+	str_set(str,"(");
+	str_scat(str,
+	  fstr=walk(useval != 0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,")");
+	numeric |= numarg;
+	break;
+    case OGETLINE:
+	str = str_new(0);
+	if (useval)
+	    str_cat(str,"(");
+	if (len > 0) {
+	    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	    if (!*fstr->str_ptr) {
+		str_cat(str,"$_");
+		len = 2;		/* a legal fiction */
+	    }
+	    str_free(fstr);
+	}
+	else
+	    str_cat(str,"$_");
+	if (len > 1) {
+	    tmpstr=walk(1,level,ops[node+3].ival,&numarg,P_MIN);
+	    fstr=walk(1,level,ops[node+2].ival,&numarg,P_MIN);
+	    if (!do_fancy_opens) {
+		t = tmpstr->str_ptr;
+		if (*t == '"' || *t == '\'')
+		    t = cpytill(tokenbuf,t+1,*t);
+		else
+		    fatal("Internal error: OGETLINE %s", t);
+		d = savestr(t);
+		s = savestr(tokenbuf);
+		for (t = tokenbuf; *t; t++) {
+		    *t &= 127;
+		    if (islower(*t))
+			*t = toupper(*t);
+		    if (!isalpha(*t) && !isdigit(*t))
+			*t = '_';
+		}
+		if (!strchr(tokenbuf,'_'))
+		    strcpy(t,"_FH");
+		tmp3str = hfetch(symtab,tokenbuf);
+		if (!tmp3str) {
+		    do_opens = TRUE;
+		    str_cat(opens,"open(");
+		    str_cat(opens,tokenbuf);
+		    str_cat(opens,", ");
+		    d[1] = '\0';
+		    str_cat(opens,d);
+		    str_cat(opens,tmpstr->str_ptr+1);
+		    opens->str_cur--;
+		    if (*fstr->str_ptr == '|')
+			str_cat(opens,"|");
+		    str_cat(opens,d);
+		    if (*fstr->str_ptr == '|')
+			str_cat(opens,") || die 'Cannot pipe from \"");
+		    else
+			str_cat(opens,") || die 'Cannot open file \"");
+		    if (*d == '"')
+			str_cat(opens,"'.\"");
+		    str_cat(opens,s);
+		    if (*d == '"')
+			str_cat(opens,"\".'");
+		    str_cat(opens,"\".';\n");
+		    hstore(symtab,tokenbuf,str_make("x"));
+		}
+		safefree(s);
+		safefree(d);
+		str_set(tmpstr,"'");
+		str_cat(tmpstr,tokenbuf);
+		str_cat(tmpstr,"'");
+	    }
+	    if (*fstr->str_ptr == '|')
+		str_cat(tmpstr,", '|'");
+	    str_free(fstr);
+	}
+	else
+	    tmpstr = str_make("");
+	sprintf(tokenbuf," = &Getline%d(%s)",len,tmpstr->str_ptr);
+	str_cat(str,tokenbuf); 
+	str_free(tmpstr);
+	if (useval)
+	    str_cat(str,",$getline_ok)");
+	saw_getline |= 1 << len;
+	break;
+    case OSPRINTF:
+	str = str_new(0);
+	str_set(str,"sprintf(");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,")");
+	break;
+    case OSUBSTR:
+	str = str_new(0);
+	str_set(str,"substr(");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
+	str_free(fstr);
+	str_cat(str,", ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_COMMA+1));
+	str_free(fstr);
+	str_cat(str,", ");
+	if (len == 3) {
+	    str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,P_COMMA+1));
+	    str_free(fstr);
+	}
+	else
+	    str_cat(str,"999999");
+	str_cat(str,")");
+	break;
+    case OSTRING:
+	str = str_new(0);
+	str_set(str,ops[node+1].cval);
+	break;
+    case OSPLIT:
+	str = str_new(0);
+	limit = ", 9999)";
+	numeric = 1;
+	tmpstr = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
+	if (useval)
+	    str_set(str,"(@");
+	else
+	    str_set(str,"@");
+	str_scat(str,tmpstr);
+	str_cat(str," = split(");
+	if (len == 3) {
+	    fstr = walk(1,level,ops[node+3].ival,&numarg,P_COMMA+1);
+	    if (str_len(fstr) == 3 && *fstr->str_ptr == '\'') {
+		i = fstr->str_ptr[1] & 127;
+		if (strchr("*+?.[]()|^$\\",i))
+		    sprintf(tokenbuf,"/\\%c/",i);
+		else if (i == ' ')
+		    sprintf(tokenbuf,"' '");
+		else
+		    sprintf(tokenbuf,"/%c/",i);
+		str_cat(str,tokenbuf);
+	    }
+	    else
+		str_scat(str,fstr);
+	    str_free(fstr);
+	}
+	else if (const_FS) {
+	    sprintf(tokenbuf,"/[%c\\n]/",const_FS);
+	    str_cat(str,tokenbuf);
+	}
+	else if (saw_FS)
+	    str_cat(str,"$FS");
+	else {
+	    str_cat(str,"' '");
+	    limit = ")";
+	}
+	str_cat(str,", ");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
+	str_free(fstr);
+	str_cat(str,limit);
+	if (useval) {
+	    str_cat(str,")");
+	}
+	str_free(tmpstr);
+	break;
+    case OINDEX:
+	str = str_new(0);
+	str_set(str,"index(");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
+	str_free(fstr);
+	str_cat(str,", ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_COMMA+1));
+	str_free(fstr);
+	str_cat(str,")");
+	numeric = 1;
+	break;
+    case OMATCH:
+	str = str_new(0);
+	prec = P_ANDAND;
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MATCH+1));
+	str_free(fstr);
+	str_cat(str," =~ ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_MATCH+1));
+	str_free(fstr);
+	str_cat(str," && ($RLENGTH = length($&), $RSTART = length($`)+1)");
+	numeric = 1;
+	break;
+    case OUSERDEF:
+	str = str_new(0);
+	subretnum = FALSE;
+	fstr=walk(1,level-1,ops[node+2].ival,&numarg,P_MIN);
+	curargs = str_new(0);
+	str_sset(curargs,fstr);
+	str_cat(curargs,",");
+	tmp2str=walk(1,level,ops[node+5].ival,&numarg,P_MIN);
+	str_free(curargs);
+	curargs = Nullstr;
+	level--;
+	subretnum |= numarg;
+	s = Nullch;
+	t = tmp2str->str_ptr;
+	while (t = instr(t,"return "))
+	    s = t++;
+	if (s) {
+	    i = 0;
+	    for (t = s+7; *t; t++) {
+		if (*t == ';' || *t == '}')
+		    i++;
+	    }
+	    if (i == 1) {
+		strcpy(s,s+7);
+		tmp2str->str_cur -= 7;
+	    }
+	}
+	str_set(str,"\n");
+	tab(str,level);
+	str_cat(str,"sub ");
+	str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_cat(str," {\n");
+	tab(str,++level);
+	if (fstr->str_cur) {
+	    str_cat(str,"local(");
+	    str_scat(str,fstr);
+	    str_cat(str,") = @_;");
+	}
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,P_MIN));
+	str_free(fstr);
+	fixtab(str,level);
+	str_scat(str,fstr=walk(1,level,ops[node+4].ival,&numarg,P_MIN));
+	str_free(fstr);
+	fixtab(str,level);
+	str_scat(str,tmp2str);
+	str_free(tmp2str);
+	fixtab(str,--level);
+	str_cat(str,"}\n");
+	tab(str,level);
+	str_scat(subs,str);
+	str_set(str,"");
+	str_cat(tmpstr,"(");
+	tmp2str = str_new(0);
+	if (subretnum)
+	    str_set(tmp2str,"1");
+	hstore(symtab,tmpstr->str_ptr,tmp2str);
+	str_free(tmpstr);
+	level++;
+	break;
+    case ORETURN:
+	str = str_new(0);
+	if (len > 0) {
+	    str_cat(str,"return ");
+	    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_UNI+1));
+	    str_free(fstr);
+	    if (numarg)
+		subretnum = TRUE;
+	}
+	else
+	    str_cat(str,"return");
+	break;
+    case OUSERFUN:
+	str = str_new(0);
+	str_set(str,"&");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,"(");
+	tmpstr = hfetch(symtab,str->str_ptr+3);
+	if (tmpstr && tmpstr->str_ptr)
+	    numeric |= atoi(tmpstr->str_ptr);
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,")");
+	break;
+    case OGSUB:
+    case OSUB:
+	if (type == OGSUB)
+	    s = "g";
+	else
+	    s = "";
+	str = str_new(0);
+	tmpstr = str_new(0);
+	i = 0;
+	if (len == 3) {
+	    tmpstr = walk(1,level,ops[node+3].ival,&numarg,P_MATCH+1);
+	    if (strNE(tmpstr->str_ptr,"$_")) {
+		str_cat(tmpstr, " =~ s");
+		i++;
+	    }
+	    else
+		str_set(tmpstr, "s");
+	}
+	else
+	    str_set(tmpstr, "s");
+	type = ops[ops[node+2].ival].ival;
+	len = type >> 8;
+	type &= 255;
+	tmp3str = str_new(0);
+	if (type == OSTR) {
+	    tmp2str=walk(1,level,ops[ops[node+2].ival+1].ival,&numarg,P_MIN);
+	    for (t = tmp2str->str_ptr, d=tokenbuf; *t; d++,t++) {
+		if (*t == '&')
+		    *d++ = '$' + 128;
+		else if (*t == '$')
+		    *d++ = '\\' + 128;
+		*d = *t + 128;
+	    }
+	    *d = '\0';
+	    str_set(tmp2str,tokenbuf);
+	}
+	else {
+	    tmp2str=walk(1,level,ops[node+2].ival,&numarg,P_MIN);
+	    str_set(tmp3str,"($s_ = '\"'.(");
+	    str_scat(tmp3str,tmp2str);
+	    str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, ");
+	    str_set(tmp2str,"eval $s_");
+	    s = (*s == 'g' ? "ge" : "e");
+	    i++;
+	}
+	type = ops[ops[node+1].ival].ival;
+	len = type >> 8;
+	type &= 255;
+	fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN);
+	if (type == OREGEX) {
+	    if (useval && i)
+		str_cat(str,"(");
+	    str_scat(str,tmp3str);
+	    str_scat(str,tmpstr);
+	    str_scat(str,fstr);
+	    str_scat(str,tmp2str);
+	    str_cat(str,"/");
+	    str_cat(str,s);
+	}
+	else if ((type == OFLD && !split_to_array) || (type == OVAR && len == 1)) {
+	    if (useval && i)
+		str_cat(str,"(");
+	    str_scat(str,tmp3str);
+	    str_scat(str,tmpstr);
+	    str_cat(str,"/");
+	    str_scat(str,fstr);
+	    str_cat(str,"/");
+	    str_scat(str,tmp2str);
+	    str_cat(str,"/");
+	    str_cat(str,s);
+	}
+	else {
+	    i++;
+	    if (useval)
+		str_cat(str,"(");
+	    str_cat(str,"$s = ");
+	    str_scat(str,fstr);
+	    str_cat(str,", ");
+	    str_scat(str,tmp3str);
+	    str_scat(str,tmpstr);
+	    str_cat(str,"/$s/");
+	    str_scat(str,tmp2str);
+	    str_cat(str,"/");
+	    str_cat(str,s);
+	}
+	if (useval && i)
+	    str_cat(str,")");
+	str_free(fstr);
+	str_free(tmpstr);
+	str_free(tmp2str);
+	str_free(tmp3str);
+	numeric = 1;
+	break;
+    case ONUM:
+	str = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
+	numeric = 1;
+	break;
+    case OSTR:
+	tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
+	s = "'";
+	for (t = tmpstr->str_ptr, d=tokenbuf; *t; d++,t++) {
+	    if (*t == '\'')
+		s = "\"";
+	    else if (*t == '\\') {
+		s = "\"";
+		*d++ = *t++ + 128;
+		switch (*t) {
+		case '\\': case '"': case 'n': case 't': case '$':
+		    break;
+		default:	/* hide this from perl */
+		    *d++ = '\\' + 128;
+		}
+	    }
+	    *d = *t + 128;
+	}
+	*d = '\0';
+	str = str_new(0);
+	str_set(str,s);
+	str_cat(str,tokenbuf);
+	str_free(tmpstr);
+	str_cat(str,s);
+	break;
+    case ODEFINED:
+	prec = P_UNI;
+	str = str_new(0);
+	str_set(str,"defined $");
+	goto addvar;
+    case ODELETE:
+	str = str_new(0);
+	str_set(str,"delete $");
+	goto addvar;
+    case OSTAR:
+	str = str_new(0);
+	str_set(str,"*");
+	goto addvar;
+    case OVAR:
+	str = str_new(0);
+	str_set(str,"$");
+      addvar:
+	str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	if (len == 1) {
+	    tmp2str = hfetch(symtab,tmpstr->str_ptr);
+	    if (tmp2str && atoi(tmp2str->str_ptr))
+		numeric = 2;
+	    if (strEQ(str->str_ptr,"$FNR")) {
+		numeric = 1;
+		saw_FNR++;
+		str_set(str,"($.-$FNRbase)");
+	    }
+	    else if (strEQ(str->str_ptr,"$NR")) {
+		numeric = 1;
+		str_set(str,"$.");
+	    }
+	    else if (strEQ(str->str_ptr,"$NF")) {
+		numeric = 1;
+		str_set(str,"$#Fld");
+	    }
+	    else if (strEQ(str->str_ptr,"$0"))
+		str_set(str,"$_");
+	    else if (strEQ(str->str_ptr,"$ARGC"))
+		str_set(str,"($#ARGV+1)");
+	}
+	else {
+#ifdef NOTDEF
+	    if (curargs) {
+		sprintf(tokenbuf,"$%s,",tmpstr->str_ptr);
+	???	if (instr(curargs->str_ptr,tokenbuf))
+		    str_cat(str,"\377");	/* can't translate yet */
+	    }
+#endif
+	    str_cat(tmpstr,"[]");
+	    tmp2str = hfetch(symtab,tmpstr->str_ptr);
+	    if (tmp2str && atoi(tmp2str->str_ptr))
+		str_cat(str,"[");
+	    else
+		str_cat(str,"{");
+	    str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    if (strEQ(str->str_ptr,"$ARGV[0")) {
+		str_set(str,"$ARGV0");
+		saw_argv0++;
+	    }
+	    else {
+		if (tmp2str && atoi(tmp2str->str_ptr))
+		    strcpy(tokenbuf,"]");
+		else
+		    strcpy(tokenbuf,"}");
+		*tokenbuf += 128;
+		str_cat(str,tokenbuf);
+	    }
+	}
+	str_free(tmpstr);
+	break;
+    case OFLD:
+	str = str_new(0);
+	if (split_to_array) {
+	    str_set(str,"$Fld");
+	    str_cat(str,"[");
+	    str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    str_cat(str,"]");
+	}
+	else {
+	    i = atoi(walk(1,level,ops[node+1].ival,&numarg,P_MIN)->str_ptr);
+	    if (i <= arymax)
+		sprintf(tokenbuf,"$%s",nameary[i]);
+	    else
+		sprintf(tokenbuf,"$Fld%d",i);
+	    str_set(str,tokenbuf);
+	}
+	break;
+    case OVFLD:
+	str = str_new(0);
+	str_set(str,"$Fld[");
+	i = ops[node+1].ival;
+	if ((ops[i].ival & 255) == OPAREN)
+	    i = ops[i+1].ival;
+	tmpstr=walk(1,level,i,&numarg,P_MIN);
+	str_scat(str,tmpstr);
+	str_free(tmpstr);
+	str_cat(str,"]");
+	break;
+    case OJUNK:
+	goto def;
+    case OSNEWLINE:
+	str = str_new(2);
+	str_set(str,";\n");
+	tab(str,level);
+	break;
+    case ONEWLINE:
+	str = str_new(1);
+	str_set(str,"\n");
+	tab(str,level);
+	break;
+    case OSCOMMENT:
+	str = str_new(0);
+	str_set(str,";");
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
+	    *s += 128;
+	str_scat(str,tmpstr);
+	str_free(tmpstr);
+	tab(str,level);
+	break;
+    case OCOMMENT:
+	str = str_new(0);
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	for (s = tmpstr->str_ptr; *s && *s != '\n'; s++)
+	    *s += 128;
+	str_scat(str,tmpstr);
+	str_free(tmpstr);
+	tab(str,level);
+	break;
+    case OCOMMA:
+	prec = P_COMMA;
+	str = walk(1,level,ops[node+1].ival,&numarg,prec);
+	str_cat(str,", ");
+	str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+	str_free(fstr);
+	break;
+    case OSEMICOLON:
+	str = str_new(1);
+	str_set(str,";\n");
+	tab(str,level);
+	break;
+    case OSTATES:
+	str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	break;
+    case OSTATE:
+	str = str_new(0);
+	if (len >= 1) {
+	    str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	    if (len >= 2) {
+		tmpstr = walk(0,level,ops[node+2].ival,&numarg,P_MIN);
+		if (*tmpstr->str_ptr == ';') {
+		    addsemi(str);
+		    str_cat(str,tmpstr->str_ptr+1);
+		}
+		str_free(tmpstr);
+	    }
+	}
+	break;
+    case OCLOSE:
+	str = str_make("close(");
+	tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
+	if (!do_fancy_opens) {
+	    t = tmpstr->str_ptr;
+	    if (*t == '"' || *t == '\'')
+		t = cpytill(tokenbuf,t+1,*t);
+	    else
+		fatal("Internal error: OCLOSE %s",t);
+	    s = savestr(tokenbuf);
+	    for (t = tokenbuf; *t; t++) {
+		*t &= 127;
+		if (islower(*t))
+		    *t = toupper(*t);
+		if (!isalpha(*t) && !isdigit(*t))
+		    *t = '_';
+	    }
+	    if (!strchr(tokenbuf,'_'))
+		strcpy(t,"_FH");
+	    str_free(tmpstr);
+	    safefree(s);
+	    str_set(str,"close ");
+	    str_cat(str,tokenbuf);
+	}
+	else {
+	    sprintf(tokenbuf,"delete $opened{%s} && close(%s)",
+	       tmpstr->str_ptr, tmpstr->str_ptr);
+	    str_free(tmpstr);
+	    str_set(str,tokenbuf);
+	}
+	break;
+    case OPRINTF:
+    case OPRINT:
+	lparen = "";	/* set to parens if necessary */
+	rparen = "";
+	str = str_new(0);
+	if (len == 3) {		/* output redirection */
+	    tmpstr = walk(1,level,ops[node+3].ival,&numarg,P_MIN);
+	    tmp2str = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
+	    if (!do_fancy_opens) {
+		t = tmpstr->str_ptr;
+		if (*t == '"' || *t == '\'')
+		    t = cpytill(tokenbuf,t+1,*t);
+		else
+		    fatal("Internal error: OPRINT");
+		d = savestr(t);
+		s = savestr(tokenbuf);
+		for (t = tokenbuf; *t; t++) {
+		    *t &= 127;
+		    if (islower(*t))
+			*t = toupper(*t);
+		    if (!isalpha(*t) && !isdigit(*t))
+			*t = '_';
+		}
+		if (!strchr(tokenbuf,'_'))
+		    strcpy(t,"_FH");
+		tmp3str = hfetch(symtab,tokenbuf);
+		if (!tmp3str) {
+		    str_cat(opens,"open(");
+		    str_cat(opens,tokenbuf);
+		    str_cat(opens,", ");
+		    d[1] = '\0';
+		    str_cat(opens,d);
+		    str_scat(opens,tmp2str);
+		    str_cat(opens,tmpstr->str_ptr+1);
+		    if (*tmp2str->str_ptr == '|')
+			str_cat(opens,") || die 'Cannot pipe to \"");
+		    else
+			str_cat(opens,") || die 'Cannot create file \"");
+		    if (*d == '"')
+			str_cat(opens,"'.\"");
+		    str_cat(opens,s);
+		    if (*d == '"')
+			str_cat(opens,"\".'");
+		    str_cat(opens,"\".';\n");
+		    hstore(symtab,tokenbuf,str_make("x"));
+		}
+		str_free(tmpstr);
+		str_free(tmp2str);
+		safefree(s);
+		safefree(d);
+	    }
+	    else {
+		sprintf(tokenbuf,"&Pick('%s', %s) &&\n",
+		   tmp2str->str_ptr, tmpstr->str_ptr);
+		str_cat(str,tokenbuf);
+		tab(str,level+1);
+		strcpy(tokenbuf,"$fh");
+		str_free(tmpstr);
+		str_free(tmp2str);
+		lparen = "(";
+		rparen = ")";
+	    }
+	}
+	else
+	    strcpy(tokenbuf,"");
+	str_cat(str,lparen);	/* may be null */
+	if (type == OPRINTF)
+	    str_cat(str,"printf");
+	else
+	    str_cat(str,"print");
+	saw_fh = 0;
+	if (len == 3 || do_fancy_opens) {
+	    if (*tokenbuf) {
+		str_cat(str," ");
+		saw_fh = 1;
+	    }
+	    str_cat(str,tokenbuf);
+	}
+	tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
+	if (!*tmpstr->str_ptr && lval_field) {
+	    t = saw_OFS ? "$," : "' '";
+	    if (split_to_array) {
+		sprintf(tokenbuf,"join(%s,@Fld)",t);
+		str_cat(tmpstr,tokenbuf);
+	    }
+	    else {
+		for (i = 1; i < maxfld; i++) {
+		    if (i <= arymax)
+			sprintf(tokenbuf,"$%s, ",nameary[i]);
+		    else
+			sprintf(tokenbuf,"$Fld%d, ",i);
+		    str_cat(tmpstr,tokenbuf);
+		}
+		if (maxfld <= arymax)
+		    sprintf(tokenbuf,"$%s",nameary[maxfld]);
+		else
+		    sprintf(tokenbuf,"$Fld%d",maxfld);
+		str_cat(tmpstr,tokenbuf);
+	    }
+	}
+	if (*tmpstr->str_ptr) {
+	    str_cat(str," ");
+	    if (!saw_fh && *tmpstr->str_ptr == '(') {
+		str_cat(str,"(");
+		str_scat(str,tmpstr);
+		str_cat(str,")");
+	    }
+	    else
+		str_scat(str,tmpstr);
+	}
+	else {
+	    str_cat(str," $_");
+	}
+	str_cat(str,rparen);	/* may be null */
+	str_free(tmpstr);
+	break;
+    case ORAND:
+	str = str_make("rand(1)");
+	break;
+    case OSRAND:
+	str = str_make("srand(");
+	goto maybe0;
+    case OATAN2:
+	str = str_make("atan2(");
+	goto maybe0;
+    case OSIN:
+	str = str_make("sin(");
+	goto maybe0;
+    case OCOS:
+	str = str_make("cos(");
+	goto maybe0;
+    case OSYSTEM:
+	str = str_make("system(");
+	goto maybe0;
+    case OLENGTH:
+	str = str_make("length(");
+	goto maybe0;
+    case OLOG:
+	str = str_make("log(");
+	goto maybe0;
+    case OEXP:
+	str = str_make("exp(");
+	goto maybe0;
+    case OSQRT:
+	str = str_make("sqrt(");
+	goto maybe0;
+    case OINT:
+	str = str_make("int(");
+      maybe0:
+	numeric = 1;
+	if (len > 0)
+	    tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
+	else
+	    tmpstr = str_new(0);;
+	if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
+	    if (lval_field) {
+		t = saw_OFS ? "$," : "' '";
+		if (split_to_array) {
+		    sprintf(tokenbuf,"join(%s,@Fld)",t);
+		    str_cat(tmpstr,tokenbuf);
+		}
+		else {
+		    sprintf(tokenbuf,"join(%s, ",t);
+		    str_cat(tmpstr,tokenbuf);
+		    for (i = 1; i < maxfld; i++) {
+			if (i <= arymax)
+			    sprintf(tokenbuf,"$%s,",nameary[i]);
+			else
+			    sprintf(tokenbuf,"$Fld%d,",i);
+			str_cat(tmpstr,tokenbuf);
+		    }
+		    if (maxfld <= arymax)
+			sprintf(tokenbuf,"$%s)",nameary[maxfld]);
+		    else
+			sprintf(tokenbuf,"$Fld%d)",maxfld);
+		    str_cat(tmpstr,tokenbuf);
+		}
+	    }
+	    else
+		str_cat(tmpstr,"$_");
+	}
+	if (strEQ(tmpstr->str_ptr,"$_")) {
+	    if (type == OLENGTH && !do_chop) {
+		str = str_make("(length(");
+		str_cat(tmpstr,") - 1");
+	    }
+	}
+	str_scat(str,tmpstr);
+	str_free(tmpstr);
+	str_cat(str,")");
+	break;
+    case OBREAK:
+	str = str_new(0);
+	str_set(str,"last");
+	break;
+    case ONEXT:
+	str = str_new(0);
+	str_set(str,"next line");
+	break;
+    case OEXIT:
+	str = str_new(0);
+	if (realexit) {
+	    prec = P_UNI;
+	    str_set(str,"exit");
+	    if (len == 1) {
+		str_cat(str," ");
+		exitval = TRUE;
+		str_scat(str,
+		  fstr=walk(1,level,ops[node+1].ival,&numarg,prec+1));
+		str_free(fstr);
+	    }
+	}
+	else {
+	    if (len == 1) {
+		str_set(str,"$ExitValue = ");
+		exitval = TRUE;
+		str_scat(str,
+		  fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN));
+		str_free(fstr);
+		str_cat(str,"; ");
+	    }
+	    str_cat(str,"last line");
+	}
+	break;
+    case OCONTINUE:
+	str = str_new(0);
+	str_set(str,"next");
+	break;
+    case OREDIR:
+	goto def;
+    case OIF:
+	str = str_new(0);
+	str_set(str,"if (");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,") ");
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	if (len == 3) {
+	    i = ops[node+3].ival;
+	    if (i) {
+		if ((ops[i].ival & 255) == OBLOCK) {
+		    i = ops[i+1].ival;
+		    if (i) {
+			if ((ops[i].ival & 255) != OIF)
+			    i = 0;
+		    }
+		}
+		else
+		    i = 0;
+	    }
+	    if (i) {
+		str_cat(str,"els");
+		str_scat(str,fstr=walk(0,level,i,&numarg,P_MIN));
+		str_free(fstr);
+	    }
+	    else {
+		str_cat(str,"else ");
+		str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg,P_MIN));
+		str_free(fstr);
+	    }
+	}
+	break;
+    case OWHILE:
+	str = str_new(0);
+	str_set(str,"while (");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,") ");
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	break;
+    case ODO:
+	str = str_new(0);
+	str_set(str,"do ");
+	str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	if (str->str_ptr[str->str_cur - 1] == '\n')
+	    --str->str_cur;;
+	str_cat(str," while (");
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,");");
+	break;
+    case OFOR:
+	str = str_new(0);
+	str_set(str,"for (");
+	str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	i = numarg;
+	if (i) {
+	    t = s = tmpstr->str_ptr;
+	    while (isalpha(*t) || isdigit(*t) || *t == '$' || *t == '_')
+		t++;
+	    i = t - s;
+	    if (i < 2)
+		i = 0;
+	}
+	str_cat(str,"; ");
+	fstr=walk(1,level,ops[node+2].ival,&numarg,P_MIN);
+	if (i && (t = strchr(fstr->str_ptr,0377))) {
+	    if (strnEQ(fstr->str_ptr,s,i))
+		*t = ' ';
+	}
+	str_scat(str,fstr);
+	str_free(fstr);
+	str_free(tmpstr);
+	str_cat(str,"; ");
+	str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_cat(str,") ");
+	str_scat(str,fstr=walk(0,level,ops[node+4].ival,&numarg,P_MIN));
+	str_free(fstr);
+	break;
+    case OFORIN:
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	d = strchr(tmpstr->str_ptr,'$');
+	if (!d)
+	    fatal("Illegal for loop: %s",tmpstr->str_ptr);
+	s = strchr(d,'{');
+	if (!s)
+	    s = strchr(d,'[');
+	if (!s)
+	    fatal("Illegal for loop: %s",d);
+	*s++ = '\0';
+	for (t = s; i = *t; t++) {
+	    i &= 127;
+	    if (i == '}' || i == ']')
+		break;
+	}
+	if (*t)
+	    *t = '\0';
+	str = str_new(0);
+	str_set(str,d+1);
+	str_cat(str,"[]");
+	tmp2str = hfetch(symtab,str->str_ptr);
+	if (tmp2str && atoi(tmp2str->str_ptr)) {
+	    sprintf(tokenbuf,
+	      "foreach %s ($[ .. $#%s) ",
+	      s,
+	      d+1);
+	}
+	else {
+	    sprintf(tokenbuf,
+	      "foreach %s (keys %%%s) ",
+	      s,
+	      d+1);
+	}
+	str_set(str,tokenbuf);
+	str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	str_free(fstr);
+	str_free(tmpstr);
+	break;
+    case OBLOCK:
+	str = str_new(0);
+	str_set(str,"{");
+	if (len >= 2 && ops[node+2].ival) {
+	    str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	}
+	fixtab(str,++level);
+	str_scat(str,fstr=walk(0,level,ops[node+1].ival,&numarg,P_MIN));
+	str_free(fstr);
+	addsemi(str);
+	fixtab(str,--level);
+	str_cat(str,"}\n");
+	tab(str,level);
+	if (len >= 3) {
+	    str_scat(str,fstr=walk(0,level,ops[node+3].ival,&numarg,P_MIN));
+	    str_free(fstr);
+	}
+	break;
+    default:
+      def:
+	if (len) {
+	    if (len > 5)
+		fatal("Garbage length in walk");
+	    str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	    for (i = 2; i<= len; i++) {
+		str_scat(str,fstr=walk(0,level,ops[node+i].ival,&numarg,P_MIN));
+		str_free(fstr);
+	    }
+	}
+	else {
+	    str = Nullstr;
+	}
+	break;
+    }
+    if (!str)
+	str = str_new(0);
+
+    if (useval && prec < minprec) {		/* need parens? */
+	fstr = str_new(str->str_cur+2);
+	str_nset(fstr,"(",1);
+	str_scat(fstr,str);
+	str_ncat(fstr,")",1);
+	str_free(str);
+	str = fstr;
+    }
+
+    *numericptr = numeric;
+#ifdef DEBUGGING
+    if (debug & 4) {
+	printf("%3d %5d %15s %d %4d ",level,node,opname[type],len,str->str_cur);
+	for (t = str->str_ptr; *t && t - str->str_ptr < 40; t++)
+	    if (*t == '\n')
+		printf("\\n");
+	    else if (*t == '\t')
+		printf("\\t");
+	    else
+		putchar(*t);
+	putchar('\n');
+    }
+#endif
+    return str;
+}
+
+static void
+tab(str,lvl)
+register STR *str;
+register int lvl;
+{
+    while (lvl > 1) {
+	str_cat(str,"\t");
+	lvl -= 2;
+    }
+    if (lvl)
+	str_cat(str,"    ");
+}
+
+static void
+fixtab(str,lvl)
+register STR *str;
+register int lvl;
+{
+    register char *s;
+
+    /* strip trailing white space */
+
+    s = str->str_ptr+str->str_cur - 1;
+    while (s >= str->str_ptr && (*s == ' ' || *s == '\t' || *s == '\n'))
+	s--;
+    s[1] = '\0';
+    str->str_cur = s + 1 - str->str_ptr;
+    if (s >= str->str_ptr && *s != '\n')
+	str_cat(str,"\n");
+
+    tab(str,lvl);
+}
+
+static void
+addsemi(str)
+register STR *str;
+{
+    register char *s;
+
+    s = str->str_ptr+str->str_cur - 1;
+    while (s >= str->str_ptr && (*s == ' ' || *s == '\t' || *s == '\n'))
+	s--;
+    if (s >= str->str_ptr && *s != ';' && *s != '}')
+	str_cat(str,";");
+}
+
+static void
+emit_split(str,level)
+register STR *str;
+int level;
+{
+    register int i;
+
+    if (split_to_array)
+	str_cat(str,"@Fld");
+    else {
+	str_cat(str,"(");
+	for (i = 1; i < maxfld; i++) {
+	    if (i <= arymax)
+		sprintf(tokenbuf,"$%s,",nameary[i]);
+	    else
+		sprintf(tokenbuf,"$Fld%d,",i);
+	    str_cat(str,tokenbuf);
+	}
+	if (maxfld <= arymax)
+	    sprintf(tokenbuf,"$%s)",nameary[maxfld]);
+	else
+	    sprintf(tokenbuf,"$Fld%d)",maxfld);
+	str_cat(str,tokenbuf);
+    }
+    if (const_FS) {
+	sprintf(tokenbuf," = split(/[%c\\n]/, $_, 9999);\n",const_FS);
+	str_cat(str,tokenbuf);
+    }
+    else if (saw_FS)
+	str_cat(str," = split($FS, $_, 9999);\n");
+    else
+	str_cat(str," = split(' ', $_, 9999);\n");
+    tab(str,level);
+}
+
+int
+prewalk(numit,level,node,numericptr)
+int numit;
+int level;
+register int node;
+int *numericptr;
+{
+    register int len;
+    register int type;
+    register int i;
+    int numarg;
+    int numeric = FALSE;
+    STR *tmpstr;
+    STR *tmp2str;
+
+    if (!node) {
+	*numericptr = 0;
+	return 0;
+    }
+    type = ops[node].ival;
+    len = type >> 8;
+    type &= 255;
+    switch (type) {
+    case OPROG:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	if (ops[node+2].ival) {
+	    prewalk(0,level,ops[node+2].ival,&numarg);
+	}
+	++level;
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	--level;
+	if (ops[node+3].ival) {
+	    prewalk(0,level,ops[node+4].ival,&numarg);
+	}
+	break;
+    case OHUNKS:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	if (len == 3) {
+	    prewalk(0,level,ops[node+3].ival,&numarg);
+	}
+	break;
+    case ORANGE:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	break;
+    case OPAT:
+	goto def;
+    case OREGEX:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OHUNK:
+	if (len == 1) {
+	    prewalk(0,level,ops[node+1].ival,&numarg);
+	}
+	else {
+	    i = prewalk(0,level,ops[node+1].ival,&numarg);
+	    if (i) {
+		++level;
+		prewalk(0,level,ops[node+2].ival,&numarg);
+		--level;
+	    }
+	    else {
+		prewalk(0,level,ops[node+2].ival,&numarg);
+	    }
+	}
+	break;
+    case OPPAREN:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OPANDAND:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OPOROR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OPNOT:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OCPAREN:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric |= numarg;
+	break;
+    case OCANDAND:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OCOROR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OCNOT:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case ORELOP:
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	numeric |= numarg;
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	numeric |= numarg;
+	numeric = 1;
+	break;
+    case ORPAREN:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric |= numarg;
+	break;
+    case OMATCHOP:
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	numeric = 1;
+	break;
+    case OMPAREN:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric |= numarg;
+	break;
+    case OCONCAT:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OASSIGN:
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	if (numarg || strlen(ops[ops[node+1].ival+1].cval) > (Size_t)1) {
+	    numericize(ops[node+2].ival);
+	    if (!numarg)
+		numericize(ops[node+3].ival);
+	}
+	numeric |= numarg;
+	break;
+    case OADD:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OSUBTRACT:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OMULT:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case ODIV:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPOW:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OMOD:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPOSTINCR:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPOSTDECR:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPREINCR:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPREDECR:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OUMINUS:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OUPLUS:
+	prewalk(1,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OPAREN:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric |= numarg;
+	break;
+    case OGETLINE:
+	break;
+    case OSPRINTF:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OSUBSTR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(1,level,ops[node+2].ival,&numarg);
+	if (len == 3) {
+	    prewalk(1,level,ops[node+3].ival,&numarg);
+	}
+	break;
+    case OSTRING:
+	break;
+    case OSPLIT:
+	numeric = 1;
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	if (len == 3)
+	    prewalk(0,level,ops[node+3].ival,&numarg);
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OINDEX:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OMATCH:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	numeric = 1;
+	break;
+    case OUSERDEF:
+	subretnum = FALSE;
+	--level;
+	tmpstr = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
+	++level;
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+4].ival,&numarg);
+	prewalk(0,level,ops[node+5].ival,&numarg);
+	--level;
+	str_cat(tmpstr,"(");
+	tmp2str = str_new(0);
+	if (subretnum || numarg)
+	    str_set(tmp2str,"1");
+	hstore(symtab,tmpstr->str_ptr,tmp2str);
+	str_free(tmpstr);
+	level++;
+	break;
+    case ORETURN:
+	if (len > 0) {
+	    prewalk(0,level,ops[node+1].ival,&numarg);
+	    if (numarg)
+		subretnum = TRUE;
+	}
+	break;
+    case OUSERFUN:
+	tmp2str = str_new(0);
+	str_scat(tmp2str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+	fixrargs(tmpstr->str_ptr,ops[node+2].ival,0);
+	str_free(tmpstr);
+	str_cat(tmp2str,"(");
+	tmpstr = hfetch(symtab,tmp2str->str_ptr);
+	if (tmpstr && tmpstr->str_ptr)
+	    numeric |= atoi(tmpstr->str_ptr);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	str_free(tmp2str);
+	break;
+    case OGSUB:
+    case OSUB:
+	if (len >= 3)
+	    prewalk(0,level,ops[node+3].ival,&numarg);
+	prewalk(0,level,ops[ops[node+2].ival+1].ival,&numarg);
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case ONUM:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	numeric = 1;
+	break;
+    case OSTR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case ODEFINED:
+    case ODELETE:
+    case OSTAR:
+    case OVAR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	if (len == 1) {
+	    if (numit)
+		numericize(node);
+	}
+	else {
+	    prewalk(0,level,ops[node+2].ival,&numarg);
+	}
+	break;
+    case OFLD:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OVFLD:
+	i = ops[node+1].ival;
+	prewalk(0,level,i,&numarg);
+	break;
+    case OJUNK:
+	goto def;
+    case OSNEWLINE:
+	break;
+    case ONEWLINE:
+	break;
+    case OSCOMMENT:
+	break;
+    case OCOMMENT:
+	break;
+    case OCOMMA:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	break;
+    case OSEMICOLON:
+	break;
+    case OSTATES:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OSTATE:
+	if (len >= 1) {
+	    prewalk(0,level,ops[node+1].ival,&numarg);
+	    if (len >= 2) {
+		prewalk(0,level,ops[node+2].ival,&numarg);
+	    }
+	}
+	break;
+    case OCLOSE:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OPRINTF:
+    case OPRINT:
+	if (len == 3) {		/* output redirection */
+	    prewalk(0,level,ops[node+3].ival,&numarg);
+	    prewalk(0,level,ops[node+2].ival,&numarg);
+	}
+	prewalk(0+(type==OPRINT),level,ops[node+1].ival,&numarg);
+	break;
+    case ORAND:
+	break;
+    case OSRAND:
+	goto maybe0;
+    case OATAN2:
+	goto maybe0;
+    case OSIN:
+	goto maybe0;
+    case OCOS:
+	goto maybe0;
+    case OSYSTEM:
+	goto maybe0;
+    case OLENGTH:
+	goto maybe0;
+    case OLOG:
+	goto maybe0;
+    case OEXP:
+	goto maybe0;
+    case OSQRT:
+	goto maybe0;
+    case OINT:
+      maybe0:
+	numeric = 1;
+	if (len > 0)
+	    prewalk(type != OLENGTH && type != OSYSTEM,
+	      level,ops[node+1].ival,&numarg);
+	break;
+    case OBREAK:
+	break;
+    case ONEXT:
+	break;
+    case OEXIT:
+	if (len == 1) {
+	    prewalk(1,level,ops[node+1].ival,&numarg);
+	}
+	break;
+    case OCONTINUE:
+	break;
+    case OREDIR:
+	goto def;
+    case OIF:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	if (len == 3) {
+	    prewalk(0,level,ops[node+3].ival,&numarg);
+	}
+	break;
+    case OWHILE:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	break;
+    case OFOR:
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+3].ival,&numarg);
+	prewalk(0,level,ops[node+4].ival,&numarg);
+	break;
+    case OFORIN:
+	prewalk(0,level,ops[node+2].ival,&numarg);
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	break;
+    case OBLOCK:
+	if (len == 2) {
+	    prewalk(0,level,ops[node+2].ival,&numarg);
+	}
+	++level;
+	prewalk(0,level,ops[node+1].ival,&numarg);
+	--level;
+	break;
+    default:
+      def:
+	if (len) {
+	    if (len > 5)
+		fatal("Garbage length in prewalk");
+	    prewalk(0,level,ops[node+1].ival,&numarg);
+	    for (i = 2; i<= len; i++) {
+		prewalk(0,level,ops[node+i].ival,&numarg);
+	    }
+	}
+	break;
+    }
+    *numericptr = numeric;
+    return 1;
+}
+
+static void
+numericize(node)
+register int node;
+{
+    register int len;
+    register int type;
+    STR *tmpstr;
+    STR *tmp2str;
+    int numarg;
+
+    type = ops[node].ival;
+    len = type >> 8;
+    type &= 255;
+    if (type == OVAR && len == 1) {
+	tmpstr=walk(0,0,ops[node+1].ival,&numarg,P_MIN);
+	tmp2str = str_make("1");
+	hstore(symtab,tmpstr->str_ptr,tmp2str);
+    }
+}